{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
module StripeAPI.Operations.PostPaymentIntents where
import qualified Control.Monad.Fail
import qualified Control.Monad.Trans.Reader
import qualified Data.Aeson
import qualified Data.Aeson as Data.Aeson.Encoding.Internal
import qualified Data.Aeson as Data.Aeson.Types
import qualified Data.Aeson as Data.Aeson.Types.FromJSON
import qualified Data.Aeson as Data.Aeson.Types.Internal
import qualified Data.Aeson as Data.Aeson.Types.ToJSON
import qualified Data.ByteString.Char8
import qualified Data.ByteString.Char8 as Data.ByteString.Internal
import qualified Data.Either
import qualified Data.Functor
import qualified Data.Scientific
import qualified Data.Text
import qualified Data.Text.Internal
import qualified Data.Time.Calendar as Data.Time.Calendar.Days
import qualified Data.Time.LocalTime as Data.Time.LocalTime.Internal.ZonedTime
import qualified Data.Vector
import qualified GHC.Base
import qualified GHC.Classes
import qualified GHC.Int
import qualified GHC.Show
import qualified GHC.Types
import qualified Network.HTTP.Client
import qualified Network.HTTP.Client as Network.HTTP.Client.Request
import qualified Network.HTTP.Client as Network.HTTP.Client.Types
import qualified Network.HTTP.Simple
import qualified Network.HTTP.Types
import qualified Network.HTTP.Types as Network.HTTP.Types.Status
import qualified Network.HTTP.Types as Network.HTTP.Types.URI
import qualified StripeAPI.Common
import StripeAPI.Types
import qualified Prelude as GHC.Integer.Type
import qualified Prelude as GHC.Maybe
postPaymentIntents ::
forall m.
StripeAPI.Common.MonadHTTP m =>
PostPaymentIntentsRequestBody ->
StripeAPI.Common.StripeT m (Network.HTTP.Client.Types.Response PostPaymentIntentsResponse)
postPaymentIntents :: PostPaymentIntentsRequestBody
-> StripeT m (Response PostPaymentIntentsResponse)
postPaymentIntents PostPaymentIntentsRequestBody
body =
(Response ByteString -> Response PostPaymentIntentsResponse)
-> StripeT m (Response ByteString)
-> StripeT m (Response PostPaymentIntentsResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
( \Response ByteString
response_0 ->
(ByteString -> PostPaymentIntentsResponse)
-> Response ByteString -> Response PostPaymentIntentsResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
( (String -> PostPaymentIntentsResponse)
-> (PostPaymentIntentsResponse -> PostPaymentIntentsResponse)
-> Either String PostPaymentIntentsResponse
-> PostPaymentIntentsResponse
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Data.Either.either String -> PostPaymentIntentsResponse
PostPaymentIntentsResponseError PostPaymentIntentsResponse -> PostPaymentIntentsResponse
forall a. a -> a
GHC.Base.id
(Either String PostPaymentIntentsResponse
-> PostPaymentIntentsResponse)
-> (ByteString -> Either String PostPaymentIntentsResponse)
-> ByteString
-> PostPaymentIntentsResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. ( \Response ByteString
response ByteString
body ->
if
| (\Status
status_1 -> Status -> Int
Network.HTTP.Types.Status.statusCode Status
status_1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Int
200) (Response ByteString -> Status
forall body. Response body -> Status
Network.HTTP.Client.Types.responseStatus Response ByteString
response) ->
PaymentIntent -> PostPaymentIntentsResponse
PostPaymentIntentsResponse200
(PaymentIntent -> PostPaymentIntentsResponse)
-> Either String PaymentIntent
-> Either String PostPaymentIntentsResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> ( ByteString -> Either String PaymentIntent
forall a. FromJSON a => ByteString -> Either String a
Data.Aeson.eitherDecodeStrict ByteString
body ::
Data.Either.Either
GHC.Base.String
PaymentIntent
)
| Bool -> Status -> Bool
forall a b. a -> b -> a
GHC.Base.const Bool
GHC.Types.True (Response ByteString -> Status
forall body. Response body -> Status
Network.HTTP.Client.Types.responseStatus Response ByteString
response) ->
Error -> PostPaymentIntentsResponse
PostPaymentIntentsResponseDefault
(Error -> PostPaymentIntentsResponse)
-> Either String Error -> Either String PostPaymentIntentsResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> ( ByteString -> Either String Error
forall a. FromJSON a => ByteString -> Either String a
Data.Aeson.eitherDecodeStrict ByteString
body ::
Data.Either.Either
GHC.Base.String
Error
)
| Bool
GHC.Base.otherwise -> String -> Either String PostPaymentIntentsResponse
forall a b. a -> Either a b
Data.Either.Left String
"Missing default response type"
)
Response ByteString
response_0
)
Response ByteString
response_0
)
(Text
-> Text
-> [QueryParameter]
-> Maybe PostPaymentIntentsRequestBody
-> RequestBodyEncoding
-> StripeT m (Response ByteString)
forall (m :: * -> *) body.
(MonadHTTP m, ToJSON body) =>
Text
-> Text
-> [QueryParameter]
-> Maybe body
-> RequestBodyEncoding
-> StripeT m (Response ByteString)
StripeAPI.Common.doBodyCallWithConfigurationM (Text -> Text
Data.Text.toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
GHC.Base.$ String -> Text
Data.Text.pack String
"POST") (String -> Text
Data.Text.pack String
"/v1/payment_intents") [QueryParameter]
forall a. Monoid a => a
GHC.Base.mempty (PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBody
forall a. a -> Maybe a
GHC.Maybe.Just PostPaymentIntentsRequestBody
body) RequestBodyEncoding
StripeAPI.Common.RequestBodyEncodingFormData)
data PostPaymentIntentsRequestBody = PostPaymentIntentsRequestBody
{
PostPaymentIntentsRequestBody -> Int
postPaymentIntentsRequestBodyAmount :: GHC.Types.Int,
PostPaymentIntentsRequestBody -> Maybe Int
postPaymentIntentsRequestBodyApplicationFeeAmount :: (GHC.Maybe.Maybe GHC.Types.Int),
PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBodyCaptureMethod'
postPaymentIntentsRequestBodyCaptureMethod :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyCaptureMethod'),
PostPaymentIntentsRequestBody -> Maybe Bool
postPaymentIntentsRequestBodyConfirm :: (GHC.Maybe.Maybe GHC.Types.Bool),
PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBodyConfirmationMethod'
postPaymentIntentsRequestBodyConfirmationMethod :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyConfirmationMethod'),
PostPaymentIntentsRequestBody -> Text
postPaymentIntentsRequestBodyCurrency :: Data.Text.Internal.Text,
PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyCustomer :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyDescription :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
PostPaymentIntentsRequestBody -> Maybe Bool
postPaymentIntentsRequestBodyErrorOnRequiresAction :: (GHC.Maybe.Maybe GHC.Types.Bool),
PostPaymentIntentsRequestBody -> Maybe [Text]
postPaymentIntentsRequestBodyExpand :: (GHC.Maybe.Maybe ([Data.Text.Internal.Text])),
PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyMandate :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBodyMandateData'
postPaymentIntentsRequestBodyMandateData :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyMandateData'),
PostPaymentIntentsRequestBody -> Maybe Object
postPaymentIntentsRequestBodyMetadata :: (GHC.Maybe.Maybe Data.Aeson.Types.Internal.Object),
PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
postPaymentIntentsRequestBodyOffSession :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyOffSession'Variants),
PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyOnBehalfOf :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyPaymentMethod :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
postPaymentIntentsRequestBodyPaymentMethodData :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodData'),
PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
postPaymentIntentsRequestBodyPaymentMethodOptions :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'),
PostPaymentIntentsRequestBody -> Maybe [Text]
postPaymentIntentsRequestBodyPaymentMethodTypes :: (GHC.Maybe.Maybe ([Data.Text.Internal.Text])),
PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyReceiptEmail :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyReturnUrl :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
postPaymentIntentsRequestBodySetupFutureUsage :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodySetupFutureUsage'),
PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBodyShipping'
postPaymentIntentsRequestBodyShipping :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyShipping'),
PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyStatementDescriptor :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyStatementDescriptorSuffix :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBodyTransferData'
postPaymentIntentsRequestBodyTransferData :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyTransferData'),
PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyTransferGroup :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
PostPaymentIntentsRequestBody -> Maybe Bool
postPaymentIntentsRequestBodyUseStripeSdk :: (GHC.Maybe.Maybe GHC.Types.Bool)
}
deriving
( Int -> PostPaymentIntentsRequestBody -> ShowS
[PostPaymentIntentsRequestBody] -> ShowS
PostPaymentIntentsRequestBody -> String
(Int -> PostPaymentIntentsRequestBody -> ShowS)
-> (PostPaymentIntentsRequestBody -> String)
-> ([PostPaymentIntentsRequestBody] -> ShowS)
-> Show PostPaymentIntentsRequestBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBody] -> ShowS
$cshowList :: [PostPaymentIntentsRequestBody] -> ShowS
show :: PostPaymentIntentsRequestBody -> String
$cshow :: PostPaymentIntentsRequestBody -> String
showsPrec :: Int -> PostPaymentIntentsRequestBody -> ShowS
$cshowsPrec :: Int -> PostPaymentIntentsRequestBody -> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBody
-> PostPaymentIntentsRequestBody -> Bool
(PostPaymentIntentsRequestBody
-> PostPaymentIntentsRequestBody -> Bool)
-> (PostPaymentIntentsRequestBody
-> PostPaymentIntentsRequestBody -> Bool)
-> Eq PostPaymentIntentsRequestBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBody
-> PostPaymentIntentsRequestBody -> Bool
$c/= :: PostPaymentIntentsRequestBody
-> PostPaymentIntentsRequestBody -> Bool
== :: PostPaymentIntentsRequestBody
-> PostPaymentIntentsRequestBody -> Bool
$c== :: PostPaymentIntentsRequestBody
-> PostPaymentIntentsRequestBody -> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBody where
toJSON :: PostPaymentIntentsRequestBody -> Value
toJSON PostPaymentIntentsRequestBody
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"amount" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Int
postPaymentIntentsRequestBodyAmount PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"application_fee_amount" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Int
postPaymentIntentsRequestBodyApplicationFeeAmount PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"capture_method" Text -> Maybe PostPaymentIntentsRequestBodyCaptureMethod' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBodyCaptureMethod'
postPaymentIntentsRequestBodyCaptureMethod PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"confirm" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Bool
postPaymentIntentsRequestBodyConfirm PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"confirmation_method" Text
-> Maybe PostPaymentIntentsRequestBodyConfirmationMethod' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBodyConfirmationMethod'
postPaymentIntentsRequestBodyConfirmationMethod PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"currency" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Text
postPaymentIntentsRequestBodyCurrency PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"customer" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyCustomer PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"description" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyDescription PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"error_on_requires_action" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Bool
postPaymentIntentsRequestBodyErrorOnRequiresAction PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"expand" Text -> Maybe [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe [Text]
postPaymentIntentsRequestBodyExpand PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"mandate" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyMandate PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"mandate_data" Text -> Maybe PostPaymentIntentsRequestBodyMandateData' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBodyMandateData'
postPaymentIntentsRequestBodyMandateData PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"metadata" Text -> Maybe Object -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Object
postPaymentIntentsRequestBodyMetadata PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"off_session" Text
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
postPaymentIntentsRequestBodyOffSession PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"on_behalf_of" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyOnBehalfOf PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"payment_method" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyPaymentMethod PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"payment_method_data" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
postPaymentIntentsRequestBodyPaymentMethodData PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"payment_method_options" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
postPaymentIntentsRequestBodyPaymentMethodOptions PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"payment_method_types" Text -> Maybe [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe [Text]
postPaymentIntentsRequestBodyPaymentMethodTypes PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"receipt_email" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyReceiptEmail PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"return_url" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyReturnUrl PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"setup_future_usage" Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
postPaymentIntentsRequestBodySetupFutureUsage PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"shipping" Text -> Maybe PostPaymentIntentsRequestBodyShipping' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBodyShipping'
postPaymentIntentsRequestBodyShipping PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"statement_descriptor" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyStatementDescriptor PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"statement_descriptor_suffix" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyStatementDescriptorSuffix PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"transfer_data" Text -> Maybe PostPaymentIntentsRequestBodyTransferData' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBodyTransferData'
postPaymentIntentsRequestBodyTransferData PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"transfer_group" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyTransferGroup PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"use_stripe_sdk" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Bool
postPaymentIntentsRequestBodyUseStripeSdk PostPaymentIntentsRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBody -> Encoding
toEncoding PostPaymentIntentsRequestBody
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"amount" Text -> Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Int
postPaymentIntentsRequestBodyAmount PostPaymentIntentsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"application_fee_amount" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Int
postPaymentIntentsRequestBodyApplicationFeeAmount PostPaymentIntentsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"capture_method" Text -> Maybe PostPaymentIntentsRequestBodyCaptureMethod' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBodyCaptureMethod'
postPaymentIntentsRequestBodyCaptureMethod PostPaymentIntentsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"confirm" Text -> Maybe Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Bool
postPaymentIntentsRequestBodyConfirm PostPaymentIntentsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"confirmation_method" Text
-> Maybe PostPaymentIntentsRequestBodyConfirmationMethod' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBodyConfirmationMethod'
postPaymentIntentsRequestBodyConfirmationMethod PostPaymentIntentsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"currency" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Text
postPaymentIntentsRequestBodyCurrency PostPaymentIntentsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"customer" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyCustomer PostPaymentIntentsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"description" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyDescription PostPaymentIntentsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"error_on_requires_action" Text -> Maybe Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Bool
postPaymentIntentsRequestBodyErrorOnRequiresAction PostPaymentIntentsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"expand" Text -> Maybe [Text] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe [Text]
postPaymentIntentsRequestBodyExpand PostPaymentIntentsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"mandate" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyMandate PostPaymentIntentsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"mandate_data" Text -> Maybe PostPaymentIntentsRequestBodyMandateData' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBodyMandateData'
postPaymentIntentsRequestBodyMandateData PostPaymentIntentsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"metadata" Text -> Maybe Object -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Object
postPaymentIntentsRequestBodyMetadata PostPaymentIntentsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"off_session" Text
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
postPaymentIntentsRequestBodyOffSession PostPaymentIntentsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"on_behalf_of" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyOnBehalfOf PostPaymentIntentsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"payment_method" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyPaymentMethod PostPaymentIntentsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"payment_method_data" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
postPaymentIntentsRequestBodyPaymentMethodData PostPaymentIntentsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"payment_method_options" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
postPaymentIntentsRequestBodyPaymentMethodOptions PostPaymentIntentsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"payment_method_types" Text -> Maybe [Text] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe [Text]
postPaymentIntentsRequestBodyPaymentMethodTypes PostPaymentIntentsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"receipt_email" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyReceiptEmail PostPaymentIntentsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"return_url" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyReturnUrl PostPaymentIntentsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"setup_future_usage" Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
postPaymentIntentsRequestBodySetupFutureUsage PostPaymentIntentsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"shipping" Text -> Maybe PostPaymentIntentsRequestBodyShipping' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBodyShipping'
postPaymentIntentsRequestBodyShipping PostPaymentIntentsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"statement_descriptor" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyStatementDescriptor PostPaymentIntentsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"statement_descriptor_suffix" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyStatementDescriptorSuffix PostPaymentIntentsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"transfer_data" Text -> Maybe PostPaymentIntentsRequestBodyTransferData' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody
-> Maybe PostPaymentIntentsRequestBodyTransferData'
postPaymentIntentsRequestBodyTransferData PostPaymentIntentsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"transfer_group" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Text
postPaymentIntentsRequestBodyTransferGroup PostPaymentIntentsRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"use_stripe_sdk" Text -> Maybe Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBody -> Maybe Bool
postPaymentIntentsRequestBodyUseStripeSdk PostPaymentIntentsRequestBody
obj))))))))))))))))))))))))))))
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBody where
parseJSON :: Value -> Parser PostPaymentIntentsRequestBody
parseJSON = String
-> (Object -> Parser PostPaymentIntentsRequestBody)
-> Value
-> Parser PostPaymentIntentsRequestBody
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBody" (\Object
obj -> ((((((((((((((((((((((((((((Int
-> Maybe Int
-> Maybe PostPaymentIntentsRequestBodyCaptureMethod'
-> Maybe Bool
-> Maybe PostPaymentIntentsRequestBodyConfirmationMethod'
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyMandateData'
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
-> Parser
(Int
-> Maybe Int
-> Maybe PostPaymentIntentsRequestBodyCaptureMethod'
-> Maybe Bool
-> Maybe PostPaymentIntentsRequestBodyConfirmationMethod'
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyMandateData'
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Int
-> Maybe Int
-> Maybe PostPaymentIntentsRequestBodyCaptureMethod'
-> Maybe Bool
-> Maybe PostPaymentIntentsRequestBodyConfirmationMethod'
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyMandateData'
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody
PostPaymentIntentsRequestBody Parser
(Int
-> Maybe Int
-> Maybe PostPaymentIntentsRequestBodyCaptureMethod'
-> Maybe Bool
-> Maybe PostPaymentIntentsRequestBodyConfirmationMethod'
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyMandateData'
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
-> Parser Int
-> Parser
(Maybe Int
-> Maybe PostPaymentIntentsRequestBodyCaptureMethod'
-> Maybe Bool
-> Maybe PostPaymentIntentsRequestBodyConfirmationMethod'
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyMandateData'
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"amount")) Parser
(Maybe Int
-> Maybe PostPaymentIntentsRequestBodyCaptureMethod'
-> Maybe Bool
-> Maybe PostPaymentIntentsRequestBodyConfirmationMethod'
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyMandateData'
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
-> Parser (Maybe Int)
-> Parser
(Maybe PostPaymentIntentsRequestBodyCaptureMethod'
-> Maybe Bool
-> Maybe PostPaymentIntentsRequestBodyConfirmationMethod'
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyMandateData'
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"application_fee_amount")) Parser
(Maybe PostPaymentIntentsRequestBodyCaptureMethod'
-> Maybe Bool
-> Maybe PostPaymentIntentsRequestBodyConfirmationMethod'
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyMandateData'
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
-> Parser (Maybe PostPaymentIntentsRequestBodyCaptureMethod')
-> Parser
(Maybe Bool
-> Maybe PostPaymentIntentsRequestBodyConfirmationMethod'
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyMandateData'
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostPaymentIntentsRequestBodyCaptureMethod')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"capture_method")) Parser
(Maybe Bool
-> Maybe PostPaymentIntentsRequestBodyConfirmationMethod'
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyMandateData'
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
-> Parser (Maybe Bool)
-> Parser
(Maybe PostPaymentIntentsRequestBodyConfirmationMethod'
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyMandateData'
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"confirm")) Parser
(Maybe PostPaymentIntentsRequestBodyConfirmationMethod'
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyMandateData'
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
-> Parser (Maybe PostPaymentIntentsRequestBodyConfirmationMethod')
-> Parser
(Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyMandateData'
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostPaymentIntentsRequestBodyConfirmationMethod')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"confirmation_method")) Parser
(Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyMandateData'
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
-> Parser Text
-> Parser
(Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyMandateData'
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"currency")) Parser
(Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyMandateData'
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
-> Parser (Maybe Text)
-> Parser
(Maybe Text
-> Maybe Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyMandateData'
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"customer")) Parser
(Maybe Text
-> Maybe Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyMandateData'
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
-> Parser (Maybe Text)
-> Parser
(Maybe Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyMandateData'
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"description")) Parser
(Maybe Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyMandateData'
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
-> Parser (Maybe Bool)
-> Parser
(Maybe [Text]
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyMandateData'
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"error_on_requires_action")) Parser
(Maybe [Text]
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyMandateData'
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
-> Parser (Maybe [Text])
-> Parser
(Maybe Text
-> Maybe PostPaymentIntentsRequestBodyMandateData'
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"expand")) Parser
(Maybe Text
-> Maybe PostPaymentIntentsRequestBodyMandateData'
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
-> Parser (Maybe Text)
-> Parser
(Maybe PostPaymentIntentsRequestBodyMandateData'
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"mandate")) Parser
(Maybe PostPaymentIntentsRequestBodyMandateData'
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
-> Parser (Maybe PostPaymentIntentsRequestBodyMandateData')
-> Parser
(Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe PostPaymentIntentsRequestBodyMandateData')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"mandate_data")) Parser
(Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
-> Parser (Maybe Object)
-> Parser
(Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"metadata")) Parser
(Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
-> Parser (Maybe PostPaymentIntentsRequestBodyOffSession'Variants)
-> Parser
(Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostPaymentIntentsRequestBodyOffSession'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"off_session")) Parser
(Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
-> Parser (Maybe Text)
-> Parser
(Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"on_behalf_of")) Parser
(Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
-> Parser (Maybe Text)
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"payment_method")) Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
-> Parser (Maybe PostPaymentIntentsRequestBodyPaymentMethodData')
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostPaymentIntentsRequestBodyPaymentMethodData')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"payment_method_data")) Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions')
-> Parser
(Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"payment_method_options")) Parser
(Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
-> Parser (Maybe [Text])
-> Parser
(Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"payment_method_types")) Parser
(Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
-> Parser (Maybe Text)
-> Parser
(Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"receipt_email")) Parser
(Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
-> Parser (Maybe Text)
-> Parser
(Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"return_url")) Parser
(Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
-> Parser (Maybe PostPaymentIntentsRequestBodySetupFutureUsage')
-> Parser
(Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostPaymentIntentsRequestBodySetupFutureUsage')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"setup_future_usage")) Parser
(Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
-> Parser (Maybe PostPaymentIntentsRequestBodyShipping')
-> Parser
(Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe PostPaymentIntentsRequestBodyShipping')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"shipping")) Parser
(Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
-> Parser (Maybe Text)
-> Parser
(Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"statement_descriptor")) Parser
(Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody)
-> Parser (Maybe Text)
-> Parser
(Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text -> Maybe Bool -> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"statement_descriptor_suffix")) Parser
(Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text -> Maybe Bool -> PostPaymentIntentsRequestBody)
-> Parser (Maybe PostPaymentIntentsRequestBodyTransferData')
-> Parser
(Maybe Text -> Maybe Bool -> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostPaymentIntentsRequestBodyTransferData')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"transfer_data")) Parser (Maybe Text -> Maybe Bool -> PostPaymentIntentsRequestBody)
-> Parser (Maybe Text)
-> Parser (Maybe Bool -> PostPaymentIntentsRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"transfer_group")) Parser (Maybe Bool -> PostPaymentIntentsRequestBody)
-> Parser (Maybe Bool) -> Parser PostPaymentIntentsRequestBody
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"use_stripe_sdk"))
mkPostPaymentIntentsRequestBody ::
GHC.Types.Int ->
Data.Text.Internal.Text ->
PostPaymentIntentsRequestBody
mkPostPaymentIntentsRequestBody :: Int -> Text -> PostPaymentIntentsRequestBody
mkPostPaymentIntentsRequestBody Int
postPaymentIntentsRequestBodyAmount Text
postPaymentIntentsRequestBodyCurrency =
PostPaymentIntentsRequestBody :: Int
-> Maybe Int
-> Maybe PostPaymentIntentsRequestBodyCaptureMethod'
-> Maybe Bool
-> Maybe PostPaymentIntentsRequestBodyConfirmationMethod'
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyMandateData'
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyOffSession'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsRequestBodyShipping'
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsRequestBodyTransferData'
-> Maybe Text
-> Maybe Bool
-> PostPaymentIntentsRequestBody
PostPaymentIntentsRequestBody
{ postPaymentIntentsRequestBodyAmount :: Int
postPaymentIntentsRequestBodyAmount = Int
postPaymentIntentsRequestBodyAmount,
postPaymentIntentsRequestBodyApplicationFeeAmount :: Maybe Int
postPaymentIntentsRequestBodyApplicationFeeAmount = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyCaptureMethod :: Maybe PostPaymentIntentsRequestBodyCaptureMethod'
postPaymentIntentsRequestBodyCaptureMethod = Maybe PostPaymentIntentsRequestBodyCaptureMethod'
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyConfirm :: Maybe Bool
postPaymentIntentsRequestBodyConfirm = Maybe Bool
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyConfirmationMethod :: Maybe PostPaymentIntentsRequestBodyConfirmationMethod'
postPaymentIntentsRequestBodyConfirmationMethod = Maybe PostPaymentIntentsRequestBodyConfirmationMethod'
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyCurrency :: Text
postPaymentIntentsRequestBodyCurrency = Text
postPaymentIntentsRequestBodyCurrency,
postPaymentIntentsRequestBodyCustomer :: Maybe Text
postPaymentIntentsRequestBodyCustomer = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyDescription :: Maybe Text
postPaymentIntentsRequestBodyDescription = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyErrorOnRequiresAction :: Maybe Bool
postPaymentIntentsRequestBodyErrorOnRequiresAction = Maybe Bool
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyExpand :: Maybe [Text]
postPaymentIntentsRequestBodyExpand = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyMandate :: Maybe Text
postPaymentIntentsRequestBodyMandate = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyMandateData :: Maybe PostPaymentIntentsRequestBodyMandateData'
postPaymentIntentsRequestBodyMandateData = Maybe PostPaymentIntentsRequestBodyMandateData'
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyMetadata :: Maybe Object
postPaymentIntentsRequestBodyMetadata = Maybe Object
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyOffSession :: Maybe PostPaymentIntentsRequestBodyOffSession'Variants
postPaymentIntentsRequestBodyOffSession = Maybe PostPaymentIntentsRequestBodyOffSession'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyOnBehalfOf :: Maybe Text
postPaymentIntentsRequestBodyOnBehalfOf = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethod :: Maybe Text
postPaymentIntentsRequestBodyPaymentMethod = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData :: Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
postPaymentIntentsRequestBodyPaymentMethodData = Maybe PostPaymentIntentsRequestBodyPaymentMethodData'
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodOptions :: Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
postPaymentIntentsRequestBodyPaymentMethodOptions = Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodTypes :: Maybe [Text]
postPaymentIntentsRequestBodyPaymentMethodTypes = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyReceiptEmail :: Maybe Text
postPaymentIntentsRequestBodyReceiptEmail = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyReturnUrl :: Maybe Text
postPaymentIntentsRequestBodyReturnUrl = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodySetupFutureUsage :: Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
postPaymentIntentsRequestBodySetupFutureUsage = Maybe PostPaymentIntentsRequestBodySetupFutureUsage'
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyShipping :: Maybe PostPaymentIntentsRequestBodyShipping'
postPaymentIntentsRequestBodyShipping = Maybe PostPaymentIntentsRequestBodyShipping'
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyStatementDescriptor :: Maybe Text
postPaymentIntentsRequestBodyStatementDescriptor = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyStatementDescriptorSuffix :: Maybe Text
postPaymentIntentsRequestBodyStatementDescriptorSuffix = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyTransferData :: Maybe PostPaymentIntentsRequestBodyTransferData'
postPaymentIntentsRequestBodyTransferData = Maybe PostPaymentIntentsRequestBodyTransferData'
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyTransferGroup :: Maybe Text
postPaymentIntentsRequestBodyTransferGroup = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyUseStripeSdk :: Maybe Bool
postPaymentIntentsRequestBodyUseStripeSdk = Maybe Bool
forall a. Maybe a
GHC.Maybe.Nothing
}
data PostPaymentIntentsRequestBodyCaptureMethod'
=
PostPaymentIntentsRequestBodyCaptureMethod'Other Data.Aeson.Types.Internal.Value
|
PostPaymentIntentsRequestBodyCaptureMethod'Typed Data.Text.Internal.Text
|
PostPaymentIntentsRequestBodyCaptureMethod'EnumAutomatic
|
PostPaymentIntentsRequestBodyCaptureMethod'EnumManual
deriving (Int -> PostPaymentIntentsRequestBodyCaptureMethod' -> ShowS
[PostPaymentIntentsRequestBodyCaptureMethod'] -> ShowS
PostPaymentIntentsRequestBodyCaptureMethod' -> String
(Int -> PostPaymentIntentsRequestBodyCaptureMethod' -> ShowS)
-> (PostPaymentIntentsRequestBodyCaptureMethod' -> String)
-> ([PostPaymentIntentsRequestBodyCaptureMethod'] -> ShowS)
-> Show PostPaymentIntentsRequestBodyCaptureMethod'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyCaptureMethod'] -> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyCaptureMethod'] -> ShowS
show :: PostPaymentIntentsRequestBodyCaptureMethod' -> String
$cshow :: PostPaymentIntentsRequestBodyCaptureMethod' -> String
showsPrec :: Int -> PostPaymentIntentsRequestBodyCaptureMethod' -> ShowS
$cshowsPrec :: Int -> PostPaymentIntentsRequestBodyCaptureMethod' -> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyCaptureMethod'
-> PostPaymentIntentsRequestBodyCaptureMethod' -> Bool
(PostPaymentIntentsRequestBodyCaptureMethod'
-> PostPaymentIntentsRequestBodyCaptureMethod' -> Bool)
-> (PostPaymentIntentsRequestBodyCaptureMethod'
-> PostPaymentIntentsRequestBodyCaptureMethod' -> Bool)
-> Eq PostPaymentIntentsRequestBodyCaptureMethod'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyCaptureMethod'
-> PostPaymentIntentsRequestBodyCaptureMethod' -> Bool
$c/= :: PostPaymentIntentsRequestBodyCaptureMethod'
-> PostPaymentIntentsRequestBodyCaptureMethod' -> Bool
== :: PostPaymentIntentsRequestBodyCaptureMethod'
-> PostPaymentIntentsRequestBodyCaptureMethod' -> Bool
$c== :: PostPaymentIntentsRequestBodyCaptureMethod'
-> PostPaymentIntentsRequestBodyCaptureMethod' -> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyCaptureMethod' where
toJSON :: PostPaymentIntentsRequestBodyCaptureMethod' -> Value
toJSON (PostPaymentIntentsRequestBodyCaptureMethod'Other Value
val) = Value
val
toJSON (PostPaymentIntentsRequestBodyCaptureMethod'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
toJSON (PostPaymentIntentsRequestBodyCaptureMethod'
PostPaymentIntentsRequestBodyCaptureMethod'EnumAutomatic) = Value
"automatic"
toJSON (PostPaymentIntentsRequestBodyCaptureMethod'
PostPaymentIntentsRequestBodyCaptureMethod'EnumManual) = Value
"manual"
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyCaptureMethod' where
parseJSON :: Value -> Parser PostPaymentIntentsRequestBodyCaptureMethod'
parseJSON Value
val =
PostPaymentIntentsRequestBodyCaptureMethod'
-> Parser PostPaymentIntentsRequestBodyCaptureMethod'
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure
( if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"automatic" -> PostPaymentIntentsRequestBodyCaptureMethod'
PostPaymentIntentsRequestBodyCaptureMethod'EnumAutomatic
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"manual" -> PostPaymentIntentsRequestBodyCaptureMethod'
PostPaymentIntentsRequestBodyCaptureMethod'EnumManual
| Bool
GHC.Base.otherwise -> Value -> PostPaymentIntentsRequestBodyCaptureMethod'
PostPaymentIntentsRequestBodyCaptureMethod'Other Value
val
)
data PostPaymentIntentsRequestBodyConfirmationMethod'
=
PostPaymentIntentsRequestBodyConfirmationMethod'Other Data.Aeson.Types.Internal.Value
|
PostPaymentIntentsRequestBodyConfirmationMethod'Typed Data.Text.Internal.Text
|
PostPaymentIntentsRequestBodyConfirmationMethod'EnumAutomatic
|
PostPaymentIntentsRequestBodyConfirmationMethod'EnumManual
deriving (Int -> PostPaymentIntentsRequestBodyConfirmationMethod' -> ShowS
[PostPaymentIntentsRequestBodyConfirmationMethod'] -> ShowS
PostPaymentIntentsRequestBodyConfirmationMethod' -> String
(Int -> PostPaymentIntentsRequestBodyConfirmationMethod' -> ShowS)
-> (PostPaymentIntentsRequestBodyConfirmationMethod' -> String)
-> ([PostPaymentIntentsRequestBodyConfirmationMethod'] -> ShowS)
-> Show PostPaymentIntentsRequestBodyConfirmationMethod'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyConfirmationMethod'] -> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyConfirmationMethod'] -> ShowS
show :: PostPaymentIntentsRequestBodyConfirmationMethod' -> String
$cshow :: PostPaymentIntentsRequestBodyConfirmationMethod' -> String
showsPrec :: Int -> PostPaymentIntentsRequestBodyConfirmationMethod' -> ShowS
$cshowsPrec :: Int -> PostPaymentIntentsRequestBodyConfirmationMethod' -> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyConfirmationMethod'
-> PostPaymentIntentsRequestBodyConfirmationMethod' -> Bool
(PostPaymentIntentsRequestBodyConfirmationMethod'
-> PostPaymentIntentsRequestBodyConfirmationMethod' -> Bool)
-> (PostPaymentIntentsRequestBodyConfirmationMethod'
-> PostPaymentIntentsRequestBodyConfirmationMethod' -> Bool)
-> Eq PostPaymentIntentsRequestBodyConfirmationMethod'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyConfirmationMethod'
-> PostPaymentIntentsRequestBodyConfirmationMethod' -> Bool
$c/= :: PostPaymentIntentsRequestBodyConfirmationMethod'
-> PostPaymentIntentsRequestBodyConfirmationMethod' -> Bool
== :: PostPaymentIntentsRequestBodyConfirmationMethod'
-> PostPaymentIntentsRequestBodyConfirmationMethod' -> Bool
$c== :: PostPaymentIntentsRequestBodyConfirmationMethod'
-> PostPaymentIntentsRequestBodyConfirmationMethod' -> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyConfirmationMethod' where
toJSON :: PostPaymentIntentsRequestBodyConfirmationMethod' -> Value
toJSON (PostPaymentIntentsRequestBodyConfirmationMethod'Other Value
val) = Value
val
toJSON (PostPaymentIntentsRequestBodyConfirmationMethod'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
toJSON (PostPaymentIntentsRequestBodyConfirmationMethod'
PostPaymentIntentsRequestBodyConfirmationMethod'EnumAutomatic) = Value
"automatic"
toJSON (PostPaymentIntentsRequestBodyConfirmationMethod'
PostPaymentIntentsRequestBodyConfirmationMethod'EnumManual) = Value
"manual"
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyConfirmationMethod' where
parseJSON :: Value -> Parser PostPaymentIntentsRequestBodyConfirmationMethod'
parseJSON Value
val =
PostPaymentIntentsRequestBodyConfirmationMethod'
-> Parser PostPaymentIntentsRequestBodyConfirmationMethod'
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure
( if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"automatic" -> PostPaymentIntentsRequestBodyConfirmationMethod'
PostPaymentIntentsRequestBodyConfirmationMethod'EnumAutomatic
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"manual" -> PostPaymentIntentsRequestBodyConfirmationMethod'
PostPaymentIntentsRequestBodyConfirmationMethod'EnumManual
| Bool
GHC.Base.otherwise -> Value -> PostPaymentIntentsRequestBodyConfirmationMethod'
PostPaymentIntentsRequestBodyConfirmationMethod'Other Value
val
)
data PostPaymentIntentsRequestBodyMandateData' = PostPaymentIntentsRequestBodyMandateData'
{
PostPaymentIntentsRequestBodyMandateData'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
}
deriving
( Int -> PostPaymentIntentsRequestBodyMandateData' -> ShowS
[PostPaymentIntentsRequestBodyMandateData'] -> ShowS
PostPaymentIntentsRequestBodyMandateData' -> String
(Int -> PostPaymentIntentsRequestBodyMandateData' -> ShowS)
-> (PostPaymentIntentsRequestBodyMandateData' -> String)
-> ([PostPaymentIntentsRequestBodyMandateData'] -> ShowS)
-> Show PostPaymentIntentsRequestBodyMandateData'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyMandateData'] -> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyMandateData'] -> ShowS
show :: PostPaymentIntentsRequestBodyMandateData' -> String
$cshow :: PostPaymentIntentsRequestBodyMandateData' -> String
showsPrec :: Int -> PostPaymentIntentsRequestBodyMandateData' -> ShowS
$cshowsPrec :: Int -> PostPaymentIntentsRequestBodyMandateData' -> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyMandateData'
-> PostPaymentIntentsRequestBodyMandateData' -> Bool
(PostPaymentIntentsRequestBodyMandateData'
-> PostPaymentIntentsRequestBodyMandateData' -> Bool)
-> (PostPaymentIntentsRequestBodyMandateData'
-> PostPaymentIntentsRequestBodyMandateData' -> Bool)
-> Eq PostPaymentIntentsRequestBodyMandateData'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyMandateData'
-> PostPaymentIntentsRequestBodyMandateData' -> Bool
$c/= :: PostPaymentIntentsRequestBodyMandateData'
-> PostPaymentIntentsRequestBodyMandateData' -> Bool
== :: PostPaymentIntentsRequestBodyMandateData'
-> PostPaymentIntentsRequestBodyMandateData' -> Bool
$c== :: PostPaymentIntentsRequestBodyMandateData'
-> PostPaymentIntentsRequestBodyMandateData' -> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyMandateData' where
toJSON :: PostPaymentIntentsRequestBodyMandateData' -> Value
toJSON PostPaymentIntentsRequestBodyMandateData'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"customer_acceptance" Text
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyMandateData'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance PostPaymentIntentsRequestBodyMandateData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyMandateData' -> Encoding
toEncoding PostPaymentIntentsRequestBodyMandateData'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs (Text
"customer_acceptance" Text
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyMandateData'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance PostPaymentIntentsRequestBodyMandateData'
obj)
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyMandateData' where
parseJSON :: Value -> Parser PostPaymentIntentsRequestBodyMandateData'
parseJSON = String
-> (Object -> Parser PostPaymentIntentsRequestBodyMandateData')
-> Value
-> Parser PostPaymentIntentsRequestBodyMandateData'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyMandateData'" (\Object
obj -> (PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> PostPaymentIntentsRequestBodyMandateData')
-> Parser
(PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> PostPaymentIntentsRequestBodyMandateData')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> PostPaymentIntentsRequestBodyMandateData'
PostPaymentIntentsRequestBodyMandateData' Parser
(PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> PostPaymentIntentsRequestBodyMandateData')
-> Parser
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> Parser PostPaymentIntentsRequestBodyMandateData'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"customer_acceptance"))
mkPostPaymentIntentsRequestBodyMandateData' ::
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance' ->
PostPaymentIntentsRequestBodyMandateData'
mkPostPaymentIntentsRequestBodyMandateData' :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> PostPaymentIntentsRequestBodyMandateData'
mkPostPaymentIntentsRequestBodyMandateData' PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance = PostPaymentIntentsRequestBodyMandateData' :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> PostPaymentIntentsRequestBodyMandateData'
PostPaymentIntentsRequestBodyMandateData' {postPaymentIntentsRequestBodyMandateData'CustomerAcceptance :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance = PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance}
data PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance' = PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
{
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> Maybe Int
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'AcceptedAt :: (GHC.Maybe.Maybe GHC.Types.Int),
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> Maybe Object
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Offline :: (GHC.Maybe.Maybe Data.Aeson.Types.Internal.Object),
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> Maybe
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'),
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
}
deriving
( Int
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> ShowS
[PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance']
-> ShowS
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> String
(Int
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> ShowS)
-> (PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> String)
-> ([PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance']
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance']
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance']
-> ShowS
show :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> String
$cshow :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> Bool
(PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> Bool)
-> (PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> Bool)
-> Eq PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> Bool
$c/= :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> Bool
== :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> Bool
$c== :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance' where
toJSON :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> Value
toJSON PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"accepted_at" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> Maybe Int
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'AcceptedAt PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"offline" Text -> Maybe Object -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> Maybe Object
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Offline PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"online" Text
-> Maybe
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> Maybe
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"type" Text
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> Encoding
toEncoding PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"accepted_at" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> Maybe Int
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'AcceptedAt PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"offline" Text -> Maybe Object -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> Maybe Object
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Offline PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"online" Text
-> Maybe
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> Maybe
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"type" Text
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
obj))))
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance' where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
parseJSON = String
-> (Object
-> Parser
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance')
-> Value
-> Parser
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'" (\Object
obj -> ((((Maybe Int
-> Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance')
-> Parser
(Maybe Int
-> Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Int
-> Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance' Parser
(Maybe Int
-> Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance')
-> Parser (Maybe Int)
-> Parser
(Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"accepted_at")) Parser
(Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance')
-> Parser (Maybe Object)
-> Parser
(Maybe
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"offline")) Parser
(Maybe
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance')
-> Parser
(Maybe
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online')
-> Parser
(PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"online")) Parser
(PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance')
-> Parser
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> Parser
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"type"))
mkPostPaymentIntentsRequestBodyMandateData'CustomerAcceptance' ::
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type' ->
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
mkPostPaymentIntentsRequestBodyMandateData'CustomerAcceptance' :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
mkPostPaymentIntentsRequestBodyMandateData'CustomerAcceptance' PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type =
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance' :: Maybe Int
-> Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'
{ postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'AcceptedAt :: Maybe Int
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'AcceptedAt = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Offline :: Maybe Object
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Offline = Maybe Object
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online :: Maybe
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online = Maybe
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type = PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type
}
data PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online' = PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
{
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> Text
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'IpAddress :: Data.Text.Internal.Text,
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> Text
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'UserAgent :: Data.Text.Internal.Text
}
deriving
( Int
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> ShowS
[PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online']
-> ShowS
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> String
(Int
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> ShowS)
-> (PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> String)
-> ([PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online']
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online']
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online']
-> ShowS
show :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> String
$cshow :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> Bool
(PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> Bool)
-> (PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> Bool
$c/= :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> Bool
== :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> Bool
$c== :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online' where
toJSON :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> Value
toJSON PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"ip_address" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> Text
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'IpAddress PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"user_agent" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> Text
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'UserAgent PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> Encoding
toEncoding PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"ip_address" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> Text
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'IpAddress PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"user_agent" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
-> Text
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'UserAgent PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
obj))
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online' where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
parseJSON = String
-> (Object
-> Parser
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online')
-> Value
-> Parser
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'" (\Object
obj -> ((Text
-> Text
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online')
-> Parser
(Text
-> Text
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Text
-> Text
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online' Parser
(Text
-> Text
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online')
-> Parser Text
-> Parser
(Text
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"ip_address")) Parser
(Text
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online')
-> Parser Text
-> Parser
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"user_agent"))
mkPostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online' ::
Data.Text.Internal.Text ->
Data.Text.Internal.Text ->
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
mkPostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online' :: Text
-> Text
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
mkPostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online' Text
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'IpAddress Text
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'UserAgent =
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online' :: Text
-> Text
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'
{ postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'IpAddress :: Text
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'IpAddress = Text
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'IpAddress,
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'UserAgent :: Text
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'UserAgent = Text
postPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Online'UserAgent
}
data PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
=
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'Other Data.Aeson.Types.Internal.Value
|
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'Typed Data.Text.Internal.Text
|
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'EnumOffline
|
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'EnumOnline
deriving (Int
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> ShowS
[PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type']
-> ShowS
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> String
(Int
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> ShowS)
-> (PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> String)
-> ([PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type']
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type']
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type']
-> ShowS
show :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> String
$cshow :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> Bool
(PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> Bool)
-> (PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> Bool
$c/= :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> Bool
== :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> Bool
$c== :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type' where
toJSON :: PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> Value
toJSON (PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'Other Value
val) = Value
val
toJSON (PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
toJSON (PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'EnumOffline) = Value
"offline"
toJSON (PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'EnumOnline) = Value
"online"
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type' where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
parseJSON Value
val =
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
-> Parser
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure
( if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"offline" -> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'EnumOffline
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"online" -> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'EnumOnline
| Bool
GHC.Base.otherwise -> Value
-> PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'
PostPaymentIntentsRequestBodyMandateData'CustomerAcceptance'Type'Other Value
val
)
data PostPaymentIntentsRequestBodyOffSession'OneOf2
=
PostPaymentIntentsRequestBodyOffSession'OneOf2Other Data.Aeson.Types.Internal.Value
|
PostPaymentIntentsRequestBodyOffSession'OneOf2Typed Data.Text.Internal.Text
|
PostPaymentIntentsRequestBodyOffSession'OneOf2EnumOneOff
|
PostPaymentIntentsRequestBodyOffSession'OneOf2EnumRecurring
deriving (Int -> PostPaymentIntentsRequestBodyOffSession'OneOf2 -> ShowS
[PostPaymentIntentsRequestBodyOffSession'OneOf2] -> ShowS
PostPaymentIntentsRequestBodyOffSession'OneOf2 -> String
(Int -> PostPaymentIntentsRequestBodyOffSession'OneOf2 -> ShowS)
-> (PostPaymentIntentsRequestBodyOffSession'OneOf2 -> String)
-> ([PostPaymentIntentsRequestBodyOffSession'OneOf2] -> ShowS)
-> Show PostPaymentIntentsRequestBodyOffSession'OneOf2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyOffSession'OneOf2] -> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyOffSession'OneOf2] -> ShowS
show :: PostPaymentIntentsRequestBodyOffSession'OneOf2 -> String
$cshow :: PostPaymentIntentsRequestBodyOffSession'OneOf2 -> String
showsPrec :: Int -> PostPaymentIntentsRequestBodyOffSession'OneOf2 -> ShowS
$cshowsPrec :: Int -> PostPaymentIntentsRequestBodyOffSession'OneOf2 -> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyOffSession'OneOf2
-> PostPaymentIntentsRequestBodyOffSession'OneOf2 -> Bool
(PostPaymentIntentsRequestBodyOffSession'OneOf2
-> PostPaymentIntentsRequestBodyOffSession'OneOf2 -> Bool)
-> (PostPaymentIntentsRequestBodyOffSession'OneOf2
-> PostPaymentIntentsRequestBodyOffSession'OneOf2 -> Bool)
-> Eq PostPaymentIntentsRequestBodyOffSession'OneOf2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyOffSession'OneOf2
-> PostPaymentIntentsRequestBodyOffSession'OneOf2 -> Bool
$c/= :: PostPaymentIntentsRequestBodyOffSession'OneOf2
-> PostPaymentIntentsRequestBodyOffSession'OneOf2 -> Bool
== :: PostPaymentIntentsRequestBodyOffSession'OneOf2
-> PostPaymentIntentsRequestBodyOffSession'OneOf2 -> Bool
$c== :: PostPaymentIntentsRequestBodyOffSession'OneOf2
-> PostPaymentIntentsRequestBodyOffSession'OneOf2 -> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyOffSession'OneOf2 where
toJSON :: PostPaymentIntentsRequestBodyOffSession'OneOf2 -> Value
toJSON (PostPaymentIntentsRequestBodyOffSession'OneOf2Other Value
val) = Value
val
toJSON (PostPaymentIntentsRequestBodyOffSession'OneOf2Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
toJSON (PostPaymentIntentsRequestBodyOffSession'OneOf2
PostPaymentIntentsRequestBodyOffSession'OneOf2EnumOneOff) = Value
"one_off"
toJSON (PostPaymentIntentsRequestBodyOffSession'OneOf2
PostPaymentIntentsRequestBodyOffSession'OneOf2EnumRecurring) = Value
"recurring"
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyOffSession'OneOf2 where
parseJSON :: Value -> Parser PostPaymentIntentsRequestBodyOffSession'OneOf2
parseJSON Value
val =
PostPaymentIntentsRequestBodyOffSession'OneOf2
-> Parser PostPaymentIntentsRequestBodyOffSession'OneOf2
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure
( if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"one_off" -> PostPaymentIntentsRequestBodyOffSession'OneOf2
PostPaymentIntentsRequestBodyOffSession'OneOf2EnumOneOff
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"recurring" -> PostPaymentIntentsRequestBodyOffSession'OneOf2
PostPaymentIntentsRequestBodyOffSession'OneOf2EnumRecurring
| Bool
GHC.Base.otherwise -> Value -> PostPaymentIntentsRequestBodyOffSession'OneOf2
PostPaymentIntentsRequestBodyOffSession'OneOf2Other Value
val
)
data PostPaymentIntentsRequestBodyOffSession'Variants
= PostPaymentIntentsRequestBodyOffSession'Bool GHC.Types.Bool
| PostPaymentIntentsRequestBodyOffSession'PostPaymentIntentsRequestBodyOffSession'OneOf2 PostPaymentIntentsRequestBodyOffSession'OneOf2
deriving (Int -> PostPaymentIntentsRequestBodyOffSession'Variants -> ShowS
[PostPaymentIntentsRequestBodyOffSession'Variants] -> ShowS
PostPaymentIntentsRequestBodyOffSession'Variants -> String
(Int -> PostPaymentIntentsRequestBodyOffSession'Variants -> ShowS)
-> (PostPaymentIntentsRequestBodyOffSession'Variants -> String)
-> ([PostPaymentIntentsRequestBodyOffSession'Variants] -> ShowS)
-> Show PostPaymentIntentsRequestBodyOffSession'Variants
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyOffSession'Variants] -> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyOffSession'Variants] -> ShowS
show :: PostPaymentIntentsRequestBodyOffSession'Variants -> String
$cshow :: PostPaymentIntentsRequestBodyOffSession'Variants -> String
showsPrec :: Int -> PostPaymentIntentsRequestBodyOffSession'Variants -> ShowS
$cshowsPrec :: Int -> PostPaymentIntentsRequestBodyOffSession'Variants -> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyOffSession'Variants
-> PostPaymentIntentsRequestBodyOffSession'Variants -> Bool
(PostPaymentIntentsRequestBodyOffSession'Variants
-> PostPaymentIntentsRequestBodyOffSession'Variants -> Bool)
-> (PostPaymentIntentsRequestBodyOffSession'Variants
-> PostPaymentIntentsRequestBodyOffSession'Variants -> Bool)
-> Eq PostPaymentIntentsRequestBodyOffSession'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyOffSession'Variants
-> PostPaymentIntentsRequestBodyOffSession'Variants -> Bool
$c/= :: PostPaymentIntentsRequestBodyOffSession'Variants
-> PostPaymentIntentsRequestBodyOffSession'Variants -> Bool
== :: PostPaymentIntentsRequestBodyOffSession'Variants
-> PostPaymentIntentsRequestBodyOffSession'Variants -> Bool
$c== :: PostPaymentIntentsRequestBodyOffSession'Variants
-> PostPaymentIntentsRequestBodyOffSession'Variants -> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyOffSession'Variants where
toJSON :: PostPaymentIntentsRequestBodyOffSession'Variants -> Value
toJSON (PostPaymentIntentsRequestBodyOffSession'Bool Bool
a) = Bool -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Bool
a
toJSON (PostPaymentIntentsRequestBodyOffSession'PostPaymentIntentsRequestBodyOffSession'OneOf2 PostPaymentIntentsRequestBodyOffSession'OneOf2
a) = PostPaymentIntentsRequestBodyOffSession'OneOf2 -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON PostPaymentIntentsRequestBodyOffSession'OneOf2
a
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyOffSession'Variants where
parseJSON :: Value -> Parser PostPaymentIntentsRequestBodyOffSession'Variants
parseJSON Value
val = case (Bool -> PostPaymentIntentsRequestBodyOffSession'Variants
PostPaymentIntentsRequestBodyOffSession'Bool (Bool -> PostPaymentIntentsRequestBodyOffSession'Variants)
-> Result Bool
-> Result PostPaymentIntentsRequestBodyOffSession'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value -> Result Bool
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result PostPaymentIntentsRequestBodyOffSession'Variants
-> Result PostPaymentIntentsRequestBodyOffSession'Variants
-> Result PostPaymentIntentsRequestBodyOffSession'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> ((PostPaymentIntentsRequestBodyOffSession'OneOf2
-> PostPaymentIntentsRequestBodyOffSession'Variants
PostPaymentIntentsRequestBodyOffSession'PostPaymentIntentsRequestBodyOffSession'OneOf2 (PostPaymentIntentsRequestBodyOffSession'OneOf2
-> PostPaymentIntentsRequestBodyOffSession'Variants)
-> Result PostPaymentIntentsRequestBodyOffSession'OneOf2
-> Result PostPaymentIntentsRequestBodyOffSession'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value -> Result PostPaymentIntentsRequestBodyOffSession'OneOf2
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result PostPaymentIntentsRequestBodyOffSession'Variants
-> Result PostPaymentIntentsRequestBodyOffSession'Variants
-> Result PostPaymentIntentsRequestBodyOffSession'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String -> Result PostPaymentIntentsRequestBodyOffSession'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched") of
Data.Aeson.Types.Internal.Success PostPaymentIntentsRequestBodyOffSession'Variants
a -> PostPaymentIntentsRequestBodyOffSession'Variants
-> Parser PostPaymentIntentsRequestBodyOffSession'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyOffSession'Variants
a
Data.Aeson.Types.Internal.Error String
a -> String -> Parser PostPaymentIntentsRequestBodyOffSession'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a
data PostPaymentIntentsRequestBodyPaymentMethodData' = PostPaymentIntentsRequestBodyPaymentMethodData'
{
PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
postPaymentIntentsRequestBodyPaymentMethodData'AcssDebit :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'),
PostPaymentIntentsRequestBodyPaymentMethodData' -> Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'AfterpayClearpay :: (GHC.Maybe.Maybe Data.Aeson.Types.Internal.Object),
PostPaymentIntentsRequestBodyPaymentMethodData' -> Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'Alipay :: (GHC.Maybe.Maybe Data.Aeson.Types.Internal.Object),
PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
postPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'),
PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
postPaymentIntentsRequestBodyPaymentMethodData'BacsDebit :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'),
PostPaymentIntentsRequestBodyPaymentMethodData' -> Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'Bancontact :: (GHC.Maybe.Maybe Data.Aeson.Types.Internal.Object),
PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'),
PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
postPaymentIntentsRequestBodyPaymentMethodData'Boleto :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'),
PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
postPaymentIntentsRequestBodyPaymentMethodData'Eps :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'),
PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
postPaymentIntentsRequestBodyPaymentMethodData'Fpx :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'),
PostPaymentIntentsRequestBodyPaymentMethodData' -> Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'Giropay :: (GHC.Maybe.Maybe Data.Aeson.Types.Internal.Object),
PostPaymentIntentsRequestBodyPaymentMethodData' -> Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'Grabpay :: (GHC.Maybe.Maybe Data.Aeson.Types.Internal.Object),
PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
postPaymentIntentsRequestBodyPaymentMethodData'Ideal :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'),
PostPaymentIntentsRequestBodyPaymentMethodData' -> Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'InteracPresent :: (GHC.Maybe.Maybe Data.Aeson.Types.Internal.Object),
PostPaymentIntentsRequestBodyPaymentMethodData' -> Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'Metadata :: (GHC.Maybe.Maybe Data.Aeson.Types.Internal.Object),
PostPaymentIntentsRequestBodyPaymentMethodData' -> Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'Oxxo :: (GHC.Maybe.Maybe Data.Aeson.Types.Internal.Object),
PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
postPaymentIntentsRequestBodyPaymentMethodData'P24 :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'),
PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
postPaymentIntentsRequestBodyPaymentMethodData'SepaDebit :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'),
PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
postPaymentIntentsRequestBodyPaymentMethodData'Sofort :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'),
PostPaymentIntentsRequestBodyPaymentMethodData'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
postPaymentIntentsRequestBodyPaymentMethodData'Type :: PostPaymentIntentsRequestBodyPaymentMethodData'Type'
}
deriving
( Int -> PostPaymentIntentsRequestBodyPaymentMethodData' -> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodData'] -> ShowS
PostPaymentIntentsRequestBodyPaymentMethodData' -> String
(Int -> PostPaymentIntentsRequestBodyPaymentMethodData' -> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodData' -> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodData'] -> ShowS)
-> Show PostPaymentIntentsRequestBodyPaymentMethodData'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodData'] -> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodData'] -> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodData' -> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodData' -> String
showsPrec :: Int -> PostPaymentIntentsRequestBodyPaymentMethodData' -> ShowS
$cshowsPrec :: Int -> PostPaymentIntentsRequestBodyPaymentMethodData' -> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyPaymentMethodData'
-> PostPaymentIntentsRequestBodyPaymentMethodData' -> Bool
(PostPaymentIntentsRequestBodyPaymentMethodData'
-> PostPaymentIntentsRequestBodyPaymentMethodData' -> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'
-> PostPaymentIntentsRequestBodyPaymentMethodData' -> Bool)
-> Eq PostPaymentIntentsRequestBodyPaymentMethodData'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodData'
-> PostPaymentIntentsRequestBodyPaymentMethodData' -> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodData'
-> PostPaymentIntentsRequestBodyPaymentMethodData' -> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodData'
-> PostPaymentIntentsRequestBodyPaymentMethodData' -> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodData'
-> PostPaymentIntentsRequestBodyPaymentMethodData' -> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodData' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodData' -> Value
toJSON PostPaymentIntentsRequestBodyPaymentMethodData'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"acss_debit" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
postPaymentIntentsRequestBodyPaymentMethodData'AcssDebit PostPaymentIntentsRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"afterpay_clearpay" Text -> Maybe Object -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData' -> Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'AfterpayClearpay PostPaymentIntentsRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"alipay" Text -> Maybe Object -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData' -> Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'Alipay PostPaymentIntentsRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"au_becs_debit" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
postPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit PostPaymentIntentsRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"bacs_debit" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
postPaymentIntentsRequestBodyPaymentMethodData'BacsDebit PostPaymentIntentsRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"bancontact" Text -> Maybe Object -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData' -> Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'Bancontact PostPaymentIntentsRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"billing_details" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails PostPaymentIntentsRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"boleto" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
postPaymentIntentsRequestBodyPaymentMethodData'Boleto PostPaymentIntentsRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"eps" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
postPaymentIntentsRequestBodyPaymentMethodData'Eps PostPaymentIntentsRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"fpx" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
postPaymentIntentsRequestBodyPaymentMethodData'Fpx PostPaymentIntentsRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"giropay" Text -> Maybe Object -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData' -> Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'Giropay PostPaymentIntentsRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"grabpay" Text -> Maybe Object -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData' -> Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'Grabpay PostPaymentIntentsRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"ideal" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
postPaymentIntentsRequestBodyPaymentMethodData'Ideal PostPaymentIntentsRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"interac_present" Text -> Maybe Object -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData' -> Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'InteracPresent PostPaymentIntentsRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"metadata" Text -> Maybe Object -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData' -> Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'Metadata PostPaymentIntentsRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"oxxo" Text -> Maybe Object -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData' -> Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'Oxxo PostPaymentIntentsRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"p24" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
postPaymentIntentsRequestBodyPaymentMethodData'P24 PostPaymentIntentsRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"sepa_debit" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
postPaymentIntentsRequestBodyPaymentMethodData'SepaDebit PostPaymentIntentsRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"sofort" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
postPaymentIntentsRequestBodyPaymentMethodData'Sofort PostPaymentIntentsRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"type" Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
postPaymentIntentsRequestBodyPaymentMethodData'Type PostPaymentIntentsRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyPaymentMethodData' -> Encoding
toEncoding PostPaymentIntentsRequestBodyPaymentMethodData'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"acss_debit" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
postPaymentIntentsRequestBodyPaymentMethodData'AcssDebit PostPaymentIntentsRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"afterpay_clearpay" Text -> Maybe Object -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData' -> Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'AfterpayClearpay PostPaymentIntentsRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"alipay" Text -> Maybe Object -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData' -> Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'Alipay PostPaymentIntentsRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"au_becs_debit" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
postPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit PostPaymentIntentsRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"bacs_debit" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
postPaymentIntentsRequestBodyPaymentMethodData'BacsDebit PostPaymentIntentsRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"bancontact" Text -> Maybe Object -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData' -> Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'Bancontact PostPaymentIntentsRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"billing_details" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails PostPaymentIntentsRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"boleto" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
postPaymentIntentsRequestBodyPaymentMethodData'Boleto PostPaymentIntentsRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"eps" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
postPaymentIntentsRequestBodyPaymentMethodData'Eps PostPaymentIntentsRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"fpx" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
postPaymentIntentsRequestBodyPaymentMethodData'Fpx PostPaymentIntentsRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"giropay" Text -> Maybe Object -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData' -> Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'Giropay PostPaymentIntentsRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"grabpay" Text -> Maybe Object -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData' -> Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'Grabpay PostPaymentIntentsRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"ideal" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
postPaymentIntentsRequestBodyPaymentMethodData'Ideal PostPaymentIntentsRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"interac_present" Text -> Maybe Object -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData' -> Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'InteracPresent PostPaymentIntentsRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"metadata" Text -> Maybe Object -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData' -> Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'Metadata PostPaymentIntentsRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"oxxo" Text -> Maybe Object -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData' -> Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'Oxxo PostPaymentIntentsRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"p24" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
postPaymentIntentsRequestBodyPaymentMethodData'P24 PostPaymentIntentsRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"sepa_debit" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
postPaymentIntentsRequestBodyPaymentMethodData'SepaDebit PostPaymentIntentsRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"sofort" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
postPaymentIntentsRequestBodyPaymentMethodData'Sofort PostPaymentIntentsRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"type" Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
postPaymentIntentsRequestBodyPaymentMethodData'Type PostPaymentIntentsRequestBodyPaymentMethodData'
obj))))))))))))))))))))
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodData' where
parseJSON :: Value -> Parser PostPaymentIntentsRequestBodyPaymentMethodData'
parseJSON = String
-> (Object
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData')
-> Value
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyPaymentMethodData'" (\Object
obj -> ((((((((((((((((((((Maybe PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
-> Maybe Object
-> Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
-> Maybe Object
-> Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
-> Maybe Object
-> Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData'
PostPaymentIntentsRequestBodyPaymentMethodData' Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
-> Maybe Object
-> Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit')
-> Parser
(Maybe Object
-> Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"acss_debit")) Parser
(Maybe Object
-> Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
-> Parser (Maybe Object)
-> Parser
(Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"afterpay_clearpay")) Parser
(Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
-> Parser (Maybe Object)
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"alipay")) Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit')
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"au_becs_debit")) Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit')
-> Parser
(Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"bacs_debit")) Parser
(Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
-> Parser (Maybe Object)
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"bancontact")) Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails')
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"billing_details")) Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto')
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"boleto")) Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps')
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"eps")) Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx')
-> Parser
(Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"fpx")) Parser
(Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
-> Parser (Maybe Object)
-> Parser
(Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"giropay")) Parser
(Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
-> Parser (Maybe Object)
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"grabpay")) Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal')
-> Parser
(Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"ideal")) Parser
(Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
-> Parser (Maybe Object)
-> Parser
(Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"interac_present")) Parser
(Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
-> Parser (Maybe Object)
-> Parser
(Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"metadata")) Parser
(Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
-> Parser (Maybe Object)
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"oxxo")) Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24')
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"p24")) Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit')
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"sepa_debit")) Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort')
-> Parser
(PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"sofort")) Parser
(PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData')
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Type'
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"type"))
mkPostPaymentIntentsRequestBodyPaymentMethodData' ::
PostPaymentIntentsRequestBodyPaymentMethodData'Type' ->
PostPaymentIntentsRequestBodyPaymentMethodData'
mkPostPaymentIntentsRequestBodyPaymentMethodData' :: PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData'
mkPostPaymentIntentsRequestBodyPaymentMethodData' PostPaymentIntentsRequestBodyPaymentMethodData'Type'
postPaymentIntentsRequestBodyPaymentMethodData'Type =
PostPaymentIntentsRequestBodyPaymentMethodData' :: Maybe PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
-> Maybe Object
-> Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Maybe Object
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData'
PostPaymentIntentsRequestBodyPaymentMethodData'
{ postPaymentIntentsRequestBodyPaymentMethodData'AcssDebit :: Maybe PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
postPaymentIntentsRequestBodyPaymentMethodData'AcssDebit = Maybe PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'AfterpayClearpay :: Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'AfterpayClearpay = Maybe Object
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'Alipay :: Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'Alipay = Maybe Object
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit :: Maybe PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
postPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit = Maybe PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'BacsDebit :: Maybe PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
postPaymentIntentsRequestBodyPaymentMethodData'BacsDebit = Maybe PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'Bancontact :: Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'Bancontact = Maybe Object
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails = Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'Boleto :: Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
postPaymentIntentsRequestBodyPaymentMethodData'Boleto = Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'Eps :: Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
postPaymentIntentsRequestBodyPaymentMethodData'Eps = Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'Fpx :: Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
postPaymentIntentsRequestBodyPaymentMethodData'Fpx = Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'Giropay :: Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'Giropay = Maybe Object
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'Grabpay :: Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'Grabpay = Maybe Object
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'Ideal :: Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
postPaymentIntentsRequestBodyPaymentMethodData'Ideal = Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'InteracPresent :: Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'InteracPresent = Maybe Object
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'Metadata :: Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'Metadata = Maybe Object
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'Oxxo :: Maybe Object
postPaymentIntentsRequestBodyPaymentMethodData'Oxxo = Maybe Object
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'P24 :: Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
postPaymentIntentsRequestBodyPaymentMethodData'P24 = Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'SepaDebit :: Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
postPaymentIntentsRequestBodyPaymentMethodData'SepaDebit = Maybe PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'Sofort :: Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
postPaymentIntentsRequestBodyPaymentMethodData'Sofort = Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'Type :: PostPaymentIntentsRequestBodyPaymentMethodData'Type'
postPaymentIntentsRequestBodyPaymentMethodData'Type = PostPaymentIntentsRequestBodyPaymentMethodData'Type'
postPaymentIntentsRequestBodyPaymentMethodData'Type
}
data PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit' = PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
{
PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit' -> Text
postPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'AccountNumber :: Data.Text.Internal.Text,
PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit' -> Text
postPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'InstitutionNumber :: Data.Text.Internal.Text,
PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit' -> Text
postPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'TransitNumber :: Data.Text.Internal.Text
}
deriving
( Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit']
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit' -> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit']
-> ShowS)
-> Show PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit']
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit']
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit' -> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit' -> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
-> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
-> Bool)
-> Eq PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
-> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit' -> Value
toJSON PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"account_number" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit' -> Text
postPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'AccountNumber PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"institution_number" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit' -> Text
postPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'InstitutionNumber PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"transit_number" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit' -> Text
postPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'TransitNumber PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
-> Encoding
toEncoding PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"account_number" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit' -> Text
postPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'AccountNumber PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"institution_number" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit' -> Text
postPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'InstitutionNumber PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"transit_number" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit' -> Text
postPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'TransitNumber PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
obj)))
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit' where
parseJSON :: Value
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
parseJSON = String
-> (Object
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit')
-> Value
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'" (\Object
obj -> (((Text
-> Text
-> Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit')
-> Parser
(Text
-> Text
-> Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Text
-> Text
-> Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit' Parser
(Text
-> Text
-> Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit')
-> Parser Text
-> Parser
(Text
-> Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"account_number")) Parser
(Text
-> Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit')
-> Parser Text
-> Parser
(Text -> PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"institution_number")) Parser
(Text -> PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit')
-> Parser Text
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"transit_number"))
mkPostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit' ::
Data.Text.Internal.Text ->
Data.Text.Internal.Text ->
Data.Text.Internal.Text ->
PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
mkPostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit' :: Text
-> Text
-> Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
mkPostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit' Text
postPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'AccountNumber Text
postPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'InstitutionNumber Text
postPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'TransitNumber =
PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit' :: Text
-> Text
-> Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
PostPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'
{ postPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'AccountNumber :: Text
postPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'AccountNumber = Text
postPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'AccountNumber,
postPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'InstitutionNumber :: Text
postPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'InstitutionNumber = Text
postPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'InstitutionNumber,
postPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'TransitNumber :: Text
postPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'TransitNumber = Text
postPaymentIntentsRequestBodyPaymentMethodData'AcssDebit'TransitNumber
}
data PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit' = PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
{
PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit' -> Text
postPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'AccountNumber :: Data.Text.Internal.Text,
PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit' -> Text
postPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'BsbNumber :: Data.Text.Internal.Text
}
deriving
( Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit']
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit']
-> ShowS)
-> Show PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit']
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit']
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> Bool)
-> Eq PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> Value
toJSON PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"account_number" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit' -> Text
postPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'AccountNumber PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"bsb_number" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit' -> Text
postPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'BsbNumber PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
-> Encoding
toEncoding PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"account_number" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit' -> Text
postPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'AccountNumber PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"bsb_number" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit' -> Text
postPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'BsbNumber PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
obj))
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit' where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
parseJSON = String
-> (Object
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit')
-> Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'" (\Object
obj -> ((Text
-> Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit')
-> Parser
(Text
-> Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Text
-> Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit' Parser
(Text
-> Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit')
-> Parser Text
-> Parser
(Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"account_number")) Parser
(Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit')
-> Parser Text
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"bsb_number"))
mkPostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit' ::
Data.Text.Internal.Text ->
Data.Text.Internal.Text ->
PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
mkPostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit' :: Text
-> Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
mkPostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit' Text
postPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'AccountNumber Text
postPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'BsbNumber =
PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit' :: Text
-> Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
PostPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'
{ postPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'AccountNumber :: Text
postPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'AccountNumber = Text
postPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'AccountNumber,
postPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'BsbNumber :: Text
postPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'BsbNumber = Text
postPaymentIntentsRequestBodyPaymentMethodData'AuBecsDebit'BsbNumber
}
data PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit' = PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
{
PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'AccountNumber :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'SortCode :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
}
deriving
( Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit']
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit' -> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit']
-> ShowS)
-> Show PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit']
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit']
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit' -> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit' -> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Bool)
-> Eq PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit' -> Value
toJSON PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"account_number" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'AccountNumber PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"sort_code" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'SortCode PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Encoding
toEncoding PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"account_number" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'AccountNumber PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"sort_code" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'SortCode PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
obj))
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit' where
parseJSON :: Value
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
parseJSON = String
-> (Object
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit')
-> Value
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'" (\Object
obj -> ((Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit')
-> Parser
(Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit' Parser
(Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit')
-> Parser (Maybe Text)
-> Parser
(Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"account_number")) Parser
(Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit')
-> Parser (Maybe Text)
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"sort_code"))
mkPostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit' :: PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
mkPostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit' :: PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
mkPostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit' =
PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit' :: Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
PostPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'
{ postPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'AccountNumber :: Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'AccountNumber = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'SortCode :: Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BacsDebit'SortCode = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
}
data PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails' = PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
{
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants),
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Email :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Name :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Phone :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
}
deriving
( Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails']
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails']
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails']
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails']
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Value
toJSON PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"address" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"email" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Email PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"name" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Name PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"phone" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Phone PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Encoding
toEncoding PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"address" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"email" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Email PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"name" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Name PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"phone" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Phone PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
obj))))
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails' where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
parseJSON = String
-> (Object
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails')
-> Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'" (\Object
obj -> ((((Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails')
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails' Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails')
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants)
-> Parser
(Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address")) Parser
(Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails')
-> Parser (Maybe Text)
-> Parser
(Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"email")) Parser
(Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails')
-> Parser (Maybe Text)
-> Parser
(Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"name")) Parser
(Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails')
-> Parser (Maybe Text)
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"phone"))
mkPostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails' :: PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
mkPostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails' :: PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
mkPostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails' =
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails' :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'
{ postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address = Maybe
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Email :: Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Email = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Name :: Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Name = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Phone :: Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Phone = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
}
data PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1 = PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
{
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1City :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Country :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Line1 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Line2 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1PostalCode :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1State :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
}
deriving
( Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1]
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1]
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1]
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1]
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1 where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Value
toJSON PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"city" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1City PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"country" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Country PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"line1" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Line1 PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"line2" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Line2 PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"postal_code" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1PostalCode PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"state" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1State PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Encoding
toEncoding PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"city" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1City PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"country" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Country PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"line1" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Line1 PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"line2" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Line2 PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"postal_code" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1PostalCode PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"state" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1State PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
obj))))))
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1 where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
parseJSON = String
-> (Object
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1)
-> Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1" (\Object
obj -> ((((((Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1)
-> Parser
(Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1 Parser
(Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1)
-> Parser (Maybe Text)
-> Parser
(Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"city")) Parser
(Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1)
-> Parser (Maybe Text)
-> Parser
(Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"country")) Parser
(Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1)
-> Parser (Maybe Text)
-> Parser
(Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"line1")) Parser
(Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1)
-> Parser (Maybe Text)
-> Parser
(Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"line2")) Parser
(Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1)
-> Parser (Maybe Text)
-> Parser
(Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"postal_code")) Parser
(Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1)
-> Parser (Maybe Text)
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"state"))
mkPostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1 :: PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
mkPostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1 :: PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
mkPostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1 =
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1 :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
{ postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1City :: Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1City = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Country :: Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Country = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Line1 :: Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Line1 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Line2 :: Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Line2 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1PostalCode :: Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1PostalCode = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1State :: Maybe Text
postPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1State = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
}
data PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
=
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'EmptyString
| PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1 PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
deriving (Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants]
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants]
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants]
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants]
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Value
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1 PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
a) = PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
a
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'EmptyString) = Value
""
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
parseJSON Value
val =
if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'EmptyString
| Bool
GHC.Base.otherwise -> case (PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1 (PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants)
-> Result
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Result
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value
-> Result
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
Data.Aeson.Types.Internal.Success PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
a -> PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
a
Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodData'BillingDetails'Address'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a
data PostPaymentIntentsRequestBodyPaymentMethodData'Boleto' = PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
{
PostPaymentIntentsRequestBodyPaymentMethodData'Boleto' -> Text
postPaymentIntentsRequestBodyPaymentMethodData'Boleto'TaxId :: Data.Text.Internal.Text
}
deriving
( Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Boleto' -> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'] -> ShowS
PostPaymentIntentsRequestBodyPaymentMethodData'Boleto' -> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Boleto' -> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodData'Boleto']
-> ShowS)
-> Show PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'] -> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'] -> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodData'Boleto' -> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodData'Boleto' -> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Boleto' -> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Boleto' -> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Boleto' -> Bool
(PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Boleto' -> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Boleto' -> Bool)
-> Eq PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Boleto' -> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Boleto' -> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Boleto' -> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Boleto' -> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodData'Boleto' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodData'Boleto' -> Value
toJSON PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"tax_id" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'Boleto' -> Text
postPaymentIntentsRequestBodyPaymentMethodData'Boleto'TaxId PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyPaymentMethodData'Boleto' -> Encoding
toEncoding PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs (Text
"tax_id" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'Boleto' -> Text
postPaymentIntentsRequestBodyPaymentMethodData'Boleto'TaxId PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
obj)
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodData'Boleto' where
parseJSON :: Value
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
parseJSON = String
-> (Object
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Boleto')
-> Value
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'" (\Object
obj -> (Text -> PostPaymentIntentsRequestBodyPaymentMethodData'Boleto')
-> Parser
(Text -> PostPaymentIntentsRequestBodyPaymentMethodData'Boleto')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Text -> PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
PostPaymentIntentsRequestBodyPaymentMethodData'Boleto' Parser
(Text -> PostPaymentIntentsRequestBodyPaymentMethodData'Boleto')
-> Parser Text
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"tax_id"))
mkPostPaymentIntentsRequestBodyPaymentMethodData'Boleto' ::
Data.Text.Internal.Text ->
PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
mkPostPaymentIntentsRequestBodyPaymentMethodData'Boleto' :: Text -> PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
mkPostPaymentIntentsRequestBodyPaymentMethodData'Boleto' Text
postPaymentIntentsRequestBodyPaymentMethodData'Boleto'TaxId = PostPaymentIntentsRequestBodyPaymentMethodData'Boleto' :: Text -> PostPaymentIntentsRequestBodyPaymentMethodData'Boleto'
PostPaymentIntentsRequestBodyPaymentMethodData'Boleto' {postPaymentIntentsRequestBodyPaymentMethodData'Boleto'TaxId :: Text
postPaymentIntentsRequestBodyPaymentMethodData'Boleto'TaxId = Text
postPaymentIntentsRequestBodyPaymentMethodData'Boleto'TaxId}
data PostPaymentIntentsRequestBodyPaymentMethodData'Eps' = PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
{
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
postPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank')
}
deriving
( Int -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps' -> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodData'Eps'] -> ShowS
PostPaymentIntentsRequestBodyPaymentMethodData'Eps' -> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Eps' -> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'Eps' -> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodData'Eps'] -> ShowS)
-> Show PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodData'Eps'] -> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodData'Eps'] -> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodData'Eps' -> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodData'Eps' -> String
showsPrec :: Int -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps' -> ShowS
$cshowsPrec :: Int -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps' -> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Eps' -> Bool
(PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Eps' -> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Eps' -> Bool)
-> Eq PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Eps' -> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Eps' -> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Eps' -> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Eps' -> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodData'Eps' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodData'Eps' -> Value
toJSON PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"bank" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
postPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyPaymentMethodData'Eps' -> Encoding
toEncoding PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs (Text
"bank" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
postPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
obj)
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodData'Eps' where
parseJSON :: Value -> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
parseJSON = String
-> (Object
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Eps')
-> Value
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyPaymentMethodData'Eps'" (\Object
obj -> (Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Eps')
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Eps')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps' Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Eps')
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank')
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"bank"))
mkPostPaymentIntentsRequestBodyPaymentMethodData'Eps' :: PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
mkPostPaymentIntentsRequestBodyPaymentMethodData'Eps' :: PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
mkPostPaymentIntentsRequestBodyPaymentMethodData'Eps' = PostPaymentIntentsRequestBodyPaymentMethodData'Eps' :: Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps' {postPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank :: Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
postPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank = Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
forall a. Maybe a
GHC.Maybe.Nothing}
data PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
=
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'Other Data.Aeson.Types.Internal.Value
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'Typed Data.Text.Internal.Text
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumArzteUndApothekerBank
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumAustrianAnadiBankAg
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumBankAustria
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumBankhausCarlSpangler
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumBankhausSchelhammerUndSchatteraAg
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumBawagPskAg
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumBksBankAg
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumBrullKallmusBankAg
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumBtvVierLanderBank
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumCapitalBankGraweGruppeAg
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumDolomitenbank
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumEasybankAg
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumErsteBankUndSparkassen
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumHypoAlpeadriabankInternationalAg
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumHypoBankBurgenlandAktiengesellschaft
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumHypoNoeLbFurNiederosterreichUWien
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumHypoOberosterreichSalzburgSteiermark
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumHypoTirolBankAg
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumHypoVorarlbergBankAg
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumMarchfelderBank
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumOberbankAg
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumRaiffeisenBankengruppeOsterreich
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumSchoellerbankAg
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumSpardaBankWien
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumVolksbankGruppe
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumVolkskreditbankAg
|
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumVrBankBraunau
deriving (Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'] -> ShowS
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank' -> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank']
-> ShowS)
-> Show PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'] -> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'] -> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank' -> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank' -> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
-> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank' -> Bool
(PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
-> Bool)
-> Eq PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank' -> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank' -> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank' -> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank' -> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank' -> Value
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'Other Value
val) = Value
val
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumArzteUndApothekerBank) = Value
"arzte_und_apotheker_bank"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumAustrianAnadiBankAg) = Value
"austrian_anadi_bank_ag"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumBankAustria) = Value
"bank_austria"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumBankhausCarlSpangler) = Value
"bankhaus_carl_spangler"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumBankhausSchelhammerUndSchatteraAg) = Value
"bankhaus_schelhammer_und_schattera_ag"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumBawagPskAg) = Value
"bawag_psk_ag"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumBksBankAg) = Value
"bks_bank_ag"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumBrullKallmusBankAg) = Value
"brull_kallmus_bank_ag"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumBtvVierLanderBank) = Value
"btv_vier_lander_bank"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumCapitalBankGraweGruppeAg) = Value
"capital_bank_grawe_gruppe_ag"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumDolomitenbank) = Value
"dolomitenbank"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumEasybankAg) = Value
"easybank_ag"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumErsteBankUndSparkassen) = Value
"erste_bank_und_sparkassen"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumHypoAlpeadriabankInternationalAg) = Value
"hypo_alpeadriabank_international_ag"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumHypoBankBurgenlandAktiengesellschaft) = Value
"hypo_bank_burgenland_aktiengesellschaft"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumHypoNoeLbFurNiederosterreichUWien) = Value
"hypo_noe_lb_fur_niederosterreich_u_wien"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumHypoOberosterreichSalzburgSteiermark) = Value
"hypo_oberosterreich_salzburg_steiermark"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumHypoTirolBankAg) = Value
"hypo_tirol_bank_ag"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumHypoVorarlbergBankAg) = Value
"hypo_vorarlberg_bank_ag"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumMarchfelderBank) = Value
"marchfelder_bank"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumOberbankAg) = Value
"oberbank_ag"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumRaiffeisenBankengruppeOsterreich) = Value
"raiffeisen_bankengruppe_osterreich"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumSchoellerbankAg) = Value
"schoellerbank_ag"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumSpardaBankWien) = Value
"sparda_bank_wien"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumVolksbankGruppe) = Value
"volksbank_gruppe"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumVolkskreditbankAg) = Value
"volkskreditbank_ag"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumVrBankBraunau) = Value
"vr_bank_braunau"
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank' where
parseJSON :: Value
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
parseJSON Value
val =
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure
( if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"arzte_und_apotheker_bank" -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumArzteUndApothekerBank
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"austrian_anadi_bank_ag" -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumAustrianAnadiBankAg
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bank_austria" -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumBankAustria
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bankhaus_carl_spangler" -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumBankhausCarlSpangler
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bankhaus_schelhammer_und_schattera_ag" -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumBankhausSchelhammerUndSchatteraAg
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bawag_psk_ag" -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumBawagPskAg
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bks_bank_ag" -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumBksBankAg
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"brull_kallmus_bank_ag" -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumBrullKallmusBankAg
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"btv_vier_lander_bank" -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumBtvVierLanderBank
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"capital_bank_grawe_gruppe_ag" -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumCapitalBankGraweGruppeAg
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"dolomitenbank" -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumDolomitenbank
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"easybank_ag" -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumEasybankAg
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"erste_bank_und_sparkassen" -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumErsteBankUndSparkassen
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"hypo_alpeadriabank_international_ag" -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumHypoAlpeadriabankInternationalAg
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"hypo_bank_burgenland_aktiengesellschaft" -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumHypoBankBurgenlandAktiengesellschaft
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"hypo_noe_lb_fur_niederosterreich_u_wien" -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumHypoNoeLbFurNiederosterreichUWien
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"hypo_oberosterreich_salzburg_steiermark" -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumHypoOberosterreichSalzburgSteiermark
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"hypo_tirol_bank_ag" -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumHypoTirolBankAg
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"hypo_vorarlberg_bank_ag" -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumHypoVorarlbergBankAg
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"marchfelder_bank" -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumMarchfelderBank
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"oberbank_ag" -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumOberbankAg
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"raiffeisen_bankengruppe_osterreich" -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumRaiffeisenBankengruppeOsterreich
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"schoellerbank_ag" -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumSchoellerbankAg
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"sparda_bank_wien" -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumSpardaBankWien
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"volksbank_gruppe" -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumVolksbankGruppe
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"volkskreditbank_ag" -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumVolkskreditbankAg
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"vr_bank_braunau" -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'EnumVrBankBraunau
| Bool
GHC.Base.otherwise -> Value -> PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Eps'Bank'Other Value
val
)
data PostPaymentIntentsRequestBodyPaymentMethodData'Fpx' = PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
{
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
postPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank :: PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
}
deriving
( Int -> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx' -> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'] -> ShowS
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx' -> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx' -> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'Fpx' -> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'] -> ShowS)
-> Show PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'] -> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'] -> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodData'Fpx' -> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodData'Fpx' -> String
showsPrec :: Int -> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx' -> ShowS
$cshowsPrec :: Int -> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx' -> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx' -> Bool
(PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx' -> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx' -> Bool)
-> Eq PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx' -> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx' -> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx' -> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx' -> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodData'Fpx' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodData'Fpx' -> Value
toJSON PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"bank" Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
postPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyPaymentMethodData'Fpx' -> Encoding
toEncoding PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs (Text
"bank" Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
postPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
obj)
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodData'Fpx' where
parseJSON :: Value -> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
parseJSON = String
-> (Object
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Fpx')
-> Value
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'" (\Object
obj -> (PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx')
-> Parser
(PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx' Parser
(PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx')
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"bank"))
mkPostPaymentIntentsRequestBodyPaymentMethodData'Fpx' ::
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank' ->
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
mkPostPaymentIntentsRequestBodyPaymentMethodData'Fpx' :: PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
mkPostPaymentIntentsRequestBodyPaymentMethodData'Fpx' PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
postPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank = PostPaymentIntentsRequestBodyPaymentMethodData'Fpx' :: PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx' {postPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank :: PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
postPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank = PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
postPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank}
data PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
=
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'Other Data.Aeson.Types.Internal.Value
|
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'Typed Data.Text.Internal.Text
|
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumAffinBank
|
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumAllianceBank
|
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumAmbank
|
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumBankIslam
|
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumBankMuamalat
|
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumBankRakyat
|
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumBsn
|
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumCimb
|
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumDeutscheBank
|
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumHongLeongBank
|
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumHsbc
|
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumKfh
|
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumMaybank2e
|
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumMaybank2u
|
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumOcbc
|
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumPbEnterprise
|
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumPublicBank
|
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumRhb
|
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumStandardChartered
|
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumUob
deriving (Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'] -> ShowS
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank' -> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank']
-> ShowS)
-> Show PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'] -> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'] -> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank' -> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank' -> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
-> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank' -> Bool
(PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
-> Bool)
-> Eq PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank' -> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank' -> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank' -> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank' -> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank' -> Value
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'Other Value
val) = Value
val
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumAffinBank) = Value
"affin_bank"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumAllianceBank) = Value
"alliance_bank"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumAmbank) = Value
"ambank"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumBankIslam) = Value
"bank_islam"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumBankMuamalat) = Value
"bank_muamalat"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumBankRakyat) = Value
"bank_rakyat"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumBsn) = Value
"bsn"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumCimb) = Value
"cimb"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumDeutscheBank) = Value
"deutsche_bank"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumHongLeongBank) = Value
"hong_leong_bank"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumHsbc) = Value
"hsbc"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumKfh) = Value
"kfh"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumMaybank2e) = Value
"maybank2e"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumMaybank2u) = Value
"maybank2u"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumOcbc) = Value
"ocbc"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumPbEnterprise) = Value
"pb_enterprise"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumPublicBank) = Value
"public_bank"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumRhb) = Value
"rhb"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumStandardChartered) = Value
"standard_chartered"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumUob) = Value
"uob"
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank' where
parseJSON :: Value
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
parseJSON Value
val =
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure
( if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"affin_bank" -> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumAffinBank
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"alliance_bank" -> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumAllianceBank
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ambank" -> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumAmbank
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bank_islam" -> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumBankIslam
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bank_muamalat" -> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumBankMuamalat
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bank_rakyat" -> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumBankRakyat
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bsn" -> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumBsn
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"cimb" -> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumCimb
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"deutsche_bank" -> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumDeutscheBank
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"hong_leong_bank" -> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumHongLeongBank
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"hsbc" -> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumHsbc
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"kfh" -> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumKfh
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"maybank2e" -> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumMaybank2e
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"maybank2u" -> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumMaybank2u
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ocbc" -> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumOcbc
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"pb_enterprise" -> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumPbEnterprise
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"public_bank" -> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumPublicBank
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"rhb" -> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumRhb
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"standard_chartered" -> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumStandardChartered
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"uob" -> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'EnumUob
| Bool
GHC.Base.otherwise -> Value -> PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Fpx'Bank'Other Value
val
)
data PostPaymentIntentsRequestBodyPaymentMethodData'Ideal' = PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
{
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
postPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank')
}
deriving
( Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal' -> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'] -> ShowS
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal' -> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal' -> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodData'Ideal']
-> ShowS)
-> Show PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'] -> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'] -> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodData'Ideal' -> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodData'Ideal' -> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal' -> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal' -> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal' -> Bool
(PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal' -> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal' -> Bool)
-> Eq PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal' -> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal' -> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal' -> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal' -> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodData'Ideal' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodData'Ideal' -> Value
toJSON PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"bank" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
postPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyPaymentMethodData'Ideal' -> Encoding
toEncoding PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs (Text
"bank" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
postPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
obj)
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodData'Ideal' where
parseJSON :: Value
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
parseJSON = String
-> (Object
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Ideal')
-> Value
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'" (\Object
obj -> (Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal')
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal' Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal')
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank')
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"bank"))
mkPostPaymentIntentsRequestBodyPaymentMethodData'Ideal' :: PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
mkPostPaymentIntentsRequestBodyPaymentMethodData'Ideal' :: PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
mkPostPaymentIntentsRequestBodyPaymentMethodData'Ideal' = PostPaymentIntentsRequestBodyPaymentMethodData'Ideal' :: Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal' {postPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank :: Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
postPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank = Maybe PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
forall a. Maybe a
GHC.Maybe.Nothing}
data PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
=
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'Other Data.Aeson.Types.Internal.Value
|
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'Typed Data.Text.Internal.Text
|
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumAbnAmro
|
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumAsnBank
|
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumBunq
|
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumHandelsbanken
|
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumIng
|
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumKnab
|
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumMoneyou
|
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumRabobank
|
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumRegiobank
|
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumRevolut
|
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumSnsBank
|
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumTriodosBank
|
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumVanLanschot
deriving (Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank']
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank']
-> ShowS)
-> Show PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank']
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank']
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> Bool)
-> Eq PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank' -> Value
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'Other Value
val) = Value
val
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumAbnAmro) = Value
"abn_amro"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumAsnBank) = Value
"asn_bank"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumBunq) = Value
"bunq"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumHandelsbanken) = Value
"handelsbanken"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumIng) = Value
"ing"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumKnab) = Value
"knab"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumMoneyou) = Value
"moneyou"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumRabobank) = Value
"rabobank"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumRegiobank) = Value
"regiobank"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumRevolut) = Value
"revolut"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumSnsBank) = Value
"sns_bank"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumTriodosBank) = Value
"triodos_bank"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumVanLanschot) = Value
"van_lanschot"
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank' where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
parseJSON Value
val =
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure
( if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"abn_amro" -> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumAbnAmro
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"asn_bank" -> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumAsnBank
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bunq" -> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumBunq
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"handelsbanken" -> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumHandelsbanken
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ing" -> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumIng
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"knab" -> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumKnab
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"moneyou" -> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumMoneyou
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"rabobank" -> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumRabobank
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"regiobank" -> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumRegiobank
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"revolut" -> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumRevolut
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"sns_bank" -> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumSnsBank
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"triodos_bank" -> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumTriodosBank
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"van_lanschot" -> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'EnumVanLanschot
| Bool
GHC.Base.otherwise -> Value -> PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'Ideal'Bank'Other Value
val
)
data PostPaymentIntentsRequestBodyPaymentMethodData'P24' = PostPaymentIntentsRequestBodyPaymentMethodData'P24'
{
PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
postPaymentIntentsRequestBodyPaymentMethodData'P24'Bank :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank')
}
deriving
( Int -> PostPaymentIntentsRequestBodyPaymentMethodData'P24' -> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodData'P24'] -> ShowS
PostPaymentIntentsRequestBodyPaymentMethodData'P24' -> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'P24' -> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'P24' -> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodData'P24'] -> ShowS)
-> Show PostPaymentIntentsRequestBodyPaymentMethodData'P24'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodData'P24'] -> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodData'P24'] -> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodData'P24' -> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodData'P24' -> String
showsPrec :: Int -> PostPaymentIntentsRequestBodyPaymentMethodData'P24' -> ShowS
$cshowsPrec :: Int -> PostPaymentIntentsRequestBodyPaymentMethodData'P24' -> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> PostPaymentIntentsRequestBodyPaymentMethodData'P24' -> Bool
(PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> PostPaymentIntentsRequestBodyPaymentMethodData'P24' -> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> PostPaymentIntentsRequestBodyPaymentMethodData'P24' -> Bool)
-> Eq PostPaymentIntentsRequestBodyPaymentMethodData'P24'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> PostPaymentIntentsRequestBodyPaymentMethodData'P24' -> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> PostPaymentIntentsRequestBodyPaymentMethodData'P24' -> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> PostPaymentIntentsRequestBodyPaymentMethodData'P24' -> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> PostPaymentIntentsRequestBodyPaymentMethodData'P24' -> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodData'P24' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodData'P24' -> Value
toJSON PostPaymentIntentsRequestBodyPaymentMethodData'P24'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"bank" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
postPaymentIntentsRequestBodyPaymentMethodData'P24'Bank PostPaymentIntentsRequestBodyPaymentMethodData'P24'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyPaymentMethodData'P24' -> Encoding
toEncoding PostPaymentIntentsRequestBodyPaymentMethodData'P24'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs (Text
"bank" Text
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'P24'
-> Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
postPaymentIntentsRequestBodyPaymentMethodData'P24'Bank PostPaymentIntentsRequestBodyPaymentMethodData'P24'
obj)
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodData'P24' where
parseJSON :: Value -> Parser PostPaymentIntentsRequestBodyPaymentMethodData'P24'
parseJSON = String
-> (Object
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'P24')
-> Value
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'P24'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyPaymentMethodData'P24'" (\Object
obj -> (Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'P24')
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'P24')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'P24'
PostPaymentIntentsRequestBodyPaymentMethodData'P24' Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'P24')
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank')
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'P24'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"bank"))
mkPostPaymentIntentsRequestBodyPaymentMethodData'P24' :: PostPaymentIntentsRequestBodyPaymentMethodData'P24'
mkPostPaymentIntentsRequestBodyPaymentMethodData'P24' :: PostPaymentIntentsRequestBodyPaymentMethodData'P24'
mkPostPaymentIntentsRequestBodyPaymentMethodData'P24' = PostPaymentIntentsRequestBodyPaymentMethodData'P24' :: Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'P24'
PostPaymentIntentsRequestBodyPaymentMethodData'P24' {postPaymentIntentsRequestBodyPaymentMethodData'P24'Bank :: Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
postPaymentIntentsRequestBodyPaymentMethodData'P24'Bank = Maybe PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
forall a. Maybe a
GHC.Maybe.Nothing}
data PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
=
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'Other Data.Aeson.Types.Internal.Value
|
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'Typed Data.Text.Internal.Text
|
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumAliorBank
|
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumBankMillennium
|
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumBankNowyBfgSa
|
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumBankPekaoSa
|
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumBankiSpbdzielcze
|
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumBlik
|
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumBnpParibas
|
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumBoz
|
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumCitiHandlowy
|
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumCreditAgricole
|
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumEnvelobank
|
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumEtransferPocztowy24
|
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumGetinBank
|
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumIdeabank
|
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumIng
|
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumInteligo
|
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumMbankMtransfer
|
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumNestPrzelew
|
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumNoblePay
|
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumPbacZIpko
|
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumPlusBank
|
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumSantanderPrzelew24
|
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumTmobileUsbugiBankowe
|
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumToyotaBank
|
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumVolkswagenBank
deriving (Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'] -> ShowS
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank' -> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank']
-> ShowS)
-> Show PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'] -> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'] -> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank' -> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank' -> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
-> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank' -> Bool
(PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
-> Bool)
-> Eq PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank' -> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank' -> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank' -> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
-> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank' -> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank' -> Value
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'Other Value
val) = Value
val
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumAliorBank) = Value
"alior_bank"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumBankMillennium) = Value
"bank_millennium"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumBankNowyBfgSa) = Value
"bank_nowy_bfg_sa"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumBankPekaoSa) = Value
"bank_pekao_sa"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumBankiSpbdzielcze) = Value
"banki_spbdzielcze"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumBlik) = Value
"blik"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumBnpParibas) = Value
"bnp_paribas"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumBoz) = Value
"boz"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumCitiHandlowy) = Value
"citi_handlowy"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumCreditAgricole) = Value
"credit_agricole"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumEnvelobank) = Value
"envelobank"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumEtransferPocztowy24) = Value
"etransfer_pocztowy24"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumGetinBank) = Value
"getin_bank"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumIdeabank) = Value
"ideabank"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumIng) = Value
"ing"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumInteligo) = Value
"inteligo"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumMbankMtransfer) = Value
"mbank_mtransfer"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumNestPrzelew) = Value
"nest_przelew"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumNoblePay) = Value
"noble_pay"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumPbacZIpko) = Value
"pbac_z_ipko"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumPlusBank) = Value
"plus_bank"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumSantanderPrzelew24) = Value
"santander_przelew24"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumTmobileUsbugiBankowe) = Value
"tmobile_usbugi_bankowe"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumToyotaBank) = Value
"toyota_bank"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumVolkswagenBank) = Value
"volkswagen_bank"
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank' where
parseJSON :: Value
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
parseJSON Value
val =
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure
( if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"alior_bank" -> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumAliorBank
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bank_millennium" -> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumBankMillennium
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bank_nowy_bfg_sa" -> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumBankNowyBfgSa
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bank_pekao_sa" -> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumBankPekaoSa
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"banki_spbdzielcze" -> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumBankiSpbdzielcze
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"blik" -> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumBlik
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bnp_paribas" -> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumBnpParibas
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"boz" -> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumBoz
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"citi_handlowy" -> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumCitiHandlowy
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"credit_agricole" -> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumCreditAgricole
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"envelobank" -> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumEnvelobank
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"etransfer_pocztowy24" -> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumEtransferPocztowy24
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"getin_bank" -> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumGetinBank
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ideabank" -> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumIdeabank
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ing" -> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumIng
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"inteligo" -> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumInteligo
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"mbank_mtransfer" -> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumMbankMtransfer
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"nest_przelew" -> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumNestPrzelew
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"noble_pay" -> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumNoblePay
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"pbac_z_ipko" -> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumPbacZIpko
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"plus_bank" -> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumPlusBank
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"santander_przelew24" -> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumSantanderPrzelew24
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"tmobile_usbugi_bankowe" -> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumTmobileUsbugiBankowe
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"toyota_bank" -> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumToyotaBank
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"volkswagen_bank" -> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'EnumVolkswagenBank
| Bool
GHC.Base.otherwise -> Value -> PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsRequestBodyPaymentMethodData'P24'Bank'Other Value
val
)
data PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit' = PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
{
PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit' -> Text
postPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'Iban :: Data.Text.Internal.Text
}
deriving
( Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit']
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit' -> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit']
-> ShowS)
-> Show PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit']
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit']
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit' -> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit' -> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Bool)
-> Eq PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit' -> Value
toJSON PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"iban" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit' -> Text
postPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'Iban PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
-> Encoding
toEncoding PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs (Text
"iban" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit' -> Text
postPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'Iban PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
obj)
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit' where
parseJSON :: Value
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
parseJSON = String
-> (Object
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit')
-> Value
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'" (\Object
obj -> (Text -> PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit')
-> Parser
(Text -> PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Text -> PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit' Parser
(Text -> PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit')
-> Parser Text
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"iban"))
mkPostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit' ::
Data.Text.Internal.Text ->
PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
mkPostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit' :: Text -> PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
mkPostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit' Text
postPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'Iban = PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit' :: Text -> PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'
PostPaymentIntentsRequestBodyPaymentMethodData'SepaDebit' {postPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'Iban :: Text
postPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'Iban = Text
postPaymentIntentsRequestBodyPaymentMethodData'SepaDebit'Iban}
data PostPaymentIntentsRequestBodyPaymentMethodData'Sofort' = PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
{
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
postPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country :: PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
}
deriving
( Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort' -> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'] -> ShowS
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort' -> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort' -> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodData'Sofort']
-> ShowS)
-> Show PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'] -> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'] -> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodData'Sofort' -> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodData'Sofort' -> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort' -> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort' -> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort' -> Bool
(PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort' -> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort' -> Bool)
-> Eq PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort' -> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort' -> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort' -> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort' -> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodData'Sofort' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodData'Sofort' -> Value
toJSON PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"country" Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
postPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyPaymentMethodData'Sofort' -> Encoding
toEncoding PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs (Text
"country" Text
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
postPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
obj)
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodData'Sofort' where
parseJSON :: Value
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
parseJSON = String
-> (Object
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Sofort')
-> Value
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'" (\Object
obj -> (PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort')
-> Parser
(PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort' Parser
(PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort')
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"country"))
mkPostPaymentIntentsRequestBodyPaymentMethodData'Sofort' ::
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country' ->
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
mkPostPaymentIntentsRequestBodyPaymentMethodData'Sofort' :: PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
mkPostPaymentIntentsRequestBodyPaymentMethodData'Sofort' PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
postPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country = PostPaymentIntentsRequestBodyPaymentMethodData'Sofort' :: PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort' {postPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country :: PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
postPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country = PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
postPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country}
data PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
=
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'Other Data.Aeson.Types.Internal.Value
|
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'Typed Data.Text.Internal.Text
|
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'EnumAT
|
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'EnumBE
|
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'EnumDE
|
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'EnumES
|
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'EnumIT
|
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'EnumNL
deriving (Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country']
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country']
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country']
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country']
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> Value
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'Other Value
val) = Value
val
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'EnumAT) = Value
"AT"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'EnumBE) = Value
"BE"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'EnumDE) = Value
"DE"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'EnumES) = Value
"ES"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'EnumIT) = Value
"IT"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'EnumNL) = Value
"NL"
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country' where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
parseJSON Value
val =
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure
( if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"AT" -> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'EnumAT
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"BE" -> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'EnumBE
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"DE" -> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'EnumDE
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ES" -> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'EnumES
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"IT" -> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'EnumIT
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"NL" -> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'EnumNL
| Bool
GHC.Base.otherwise -> Value
-> PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'
PostPaymentIntentsRequestBodyPaymentMethodData'Sofort'Country'Other Value
val
)
data PostPaymentIntentsRequestBodyPaymentMethodData'Type'
=
PostPaymentIntentsRequestBodyPaymentMethodData'Type'Other Data.Aeson.Types.Internal.Value
|
PostPaymentIntentsRequestBodyPaymentMethodData'Type'Typed Data.Text.Internal.Text
|
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumAcssDebit
|
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumAfterpayClearpay
|
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumAlipay
|
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumAuBecsDebit
|
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumBacsDebit
|
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumBancontact
|
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumBoleto
|
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumEps
|
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumFpx
|
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumGiropay
|
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumGrabpay
|
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumIdeal
|
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumOxxo
|
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumP24
|
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumSepaDebit
|
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumSofort
deriving (Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type' -> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodData'Type'] -> ShowS
PostPaymentIntentsRequestBodyPaymentMethodData'Type' -> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type' -> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'Type' -> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodData'Type']
-> ShowS)
-> Show PostPaymentIntentsRequestBodyPaymentMethodData'Type'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodData'Type'] -> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodData'Type'] -> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodData'Type' -> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodData'Type' -> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type' -> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type' -> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type' -> Bool
(PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type' -> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type' -> Bool)
-> Eq PostPaymentIntentsRequestBodyPaymentMethodData'Type'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type' -> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type' -> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type' -> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsRequestBodyPaymentMethodData'Type' -> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodData'Type' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodData'Type' -> Value
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Type'Other Value
val) = Value
val
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Type'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumAcssDebit) = Value
"acss_debit"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumAfterpayClearpay) = Value
"afterpay_clearpay"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumAlipay) = Value
"alipay"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumAuBecsDebit) = Value
"au_becs_debit"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumBacsDebit) = Value
"bacs_debit"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumBancontact) = Value
"bancontact"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumBoleto) = Value
"boleto"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumEps) = Value
"eps"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumFpx) = Value
"fpx"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumGiropay) = Value
"giropay"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumGrabpay) = Value
"grabpay"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumIdeal) = Value
"ideal"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumOxxo) = Value
"oxxo"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumP24) = Value
"p24"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumSepaDebit) = Value
"sepa_debit"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumSofort) = Value
"sofort"
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodData'Type' where
parseJSON :: Value
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Type'
parseJSON Value
val =
PostPaymentIntentsRequestBodyPaymentMethodData'Type'
-> Parser PostPaymentIntentsRequestBodyPaymentMethodData'Type'
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure
( if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"acss_debit" -> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumAcssDebit
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"afterpay_clearpay" -> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumAfterpayClearpay
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"alipay" -> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumAlipay
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"au_becs_debit" -> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumAuBecsDebit
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bacs_debit" -> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumBacsDebit
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bancontact" -> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumBancontact
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"boleto" -> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumBoleto
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"eps" -> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumEps
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"fpx" -> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumFpx
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"giropay" -> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumGiropay
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"grabpay" -> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumGrabpay
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ideal" -> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumIdeal
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"oxxo" -> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumOxxo
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"p24" -> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumP24
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"sepa_debit" -> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumSepaDebit
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"sofort" -> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'EnumSofort
| Bool
GHC.Base.otherwise -> Value -> PostPaymentIntentsRequestBodyPaymentMethodData'Type'
PostPaymentIntentsRequestBodyPaymentMethodData'Type'Other Value
val
)
data PostPaymentIntentsRequestBodyPaymentMethodOptions' = PostPaymentIntentsRequestBodyPaymentMethodOptions'
{
PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants),
PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants),
PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Alipay :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants),
PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants),
PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Boleto :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants),
PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Card :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants),
PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants),
PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants),
PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'P24 :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants),
PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants),
PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Sofort :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants)
}
deriving
( Int -> PostPaymentIntentsRequestBodyPaymentMethodOptions' -> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'] -> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions' -> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions' -> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions' -> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'] -> ShowS)
-> Show PostPaymentIntentsRequestBodyPaymentMethodOptions'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'] -> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'] -> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions' -> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions' -> String
showsPrec :: Int -> PostPaymentIntentsRequestBodyPaymentMethodOptions' -> ShowS
$cshowsPrec :: Int -> PostPaymentIntentsRequestBodyPaymentMethodOptions' -> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions' -> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions' -> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions' -> Bool)
-> Eq PostPaymentIntentsRequestBodyPaymentMethodOptions'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions' -> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions' -> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions' -> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions' -> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions' -> Value
toJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"acss_debit" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit PostPaymentIntentsRequestBodyPaymentMethodOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"afterpay_clearpay" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay PostPaymentIntentsRequestBodyPaymentMethodOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"alipay" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Alipay PostPaymentIntentsRequestBodyPaymentMethodOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"bancontact" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact PostPaymentIntentsRequestBodyPaymentMethodOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"boleto" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Boleto PostPaymentIntentsRequestBodyPaymentMethodOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"card" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Card PostPaymentIntentsRequestBodyPaymentMethodOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"card_present" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent PostPaymentIntentsRequestBodyPaymentMethodOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"oxxo" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo PostPaymentIntentsRequestBodyPaymentMethodOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"p24" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'P24 PostPaymentIntentsRequestBodyPaymentMethodOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"sepa_debit" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit PostPaymentIntentsRequestBodyPaymentMethodOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"sofort" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Sofort PostPaymentIntentsRequestBodyPaymentMethodOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyPaymentMethodOptions' -> Encoding
toEncoding PostPaymentIntentsRequestBodyPaymentMethodOptions'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"acss_debit" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit PostPaymentIntentsRequestBodyPaymentMethodOptions'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"afterpay_clearpay" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay PostPaymentIntentsRequestBodyPaymentMethodOptions'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"alipay" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Alipay PostPaymentIntentsRequestBodyPaymentMethodOptions'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"bancontact" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact PostPaymentIntentsRequestBodyPaymentMethodOptions'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"boleto" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Boleto PostPaymentIntentsRequestBodyPaymentMethodOptions'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"card" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Card PostPaymentIntentsRequestBodyPaymentMethodOptions'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"card_present" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent PostPaymentIntentsRequestBodyPaymentMethodOptions'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"oxxo" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo PostPaymentIntentsRequestBodyPaymentMethodOptions'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"p24" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'P24 PostPaymentIntentsRequestBodyPaymentMethodOptions'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"sepa_debit" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit PostPaymentIntentsRequestBodyPaymentMethodOptions'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"sofort" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Sofort PostPaymentIntentsRequestBodyPaymentMethodOptions'
obj)))))))))))
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions' where
parseJSON :: Value -> Parser PostPaymentIntentsRequestBodyPaymentMethodOptions'
parseJSON = String
-> (Object
-> Parser PostPaymentIntentsRequestBodyPaymentMethodOptions')
-> Value
-> Parser PostPaymentIntentsRequestBodyPaymentMethodOptions'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyPaymentMethodOptions'" (\Object
obj -> (((((((((((Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions')
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'
PostPaymentIntentsRequestBodyPaymentMethodOptions' Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions')
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants)
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"acss_debit")) Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions')
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants)
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"afterpay_clearpay")) Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions')
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants)
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"alipay")) Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions')
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants)
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"bancontact")) Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions')
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants)
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"boleto")) Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions')
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants)
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"card")) Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions')
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants)
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"card_present")) Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions')
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants)
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"oxxo")) Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions')
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants)
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"p24")) Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions')
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants)
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"sepa_debit")) Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions')
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants)
-> Parser PostPaymentIntentsRequestBodyPaymentMethodOptions'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"sofort"))
mkPostPaymentIntentsRequestBodyPaymentMethodOptions' :: PostPaymentIntentsRequestBodyPaymentMethodOptions'
mkPostPaymentIntentsRequestBodyPaymentMethodOptions' :: PostPaymentIntentsRequestBodyPaymentMethodOptions'
mkPostPaymentIntentsRequestBodyPaymentMethodOptions' =
PostPaymentIntentsRequestBodyPaymentMethodOptions' :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'
PostPaymentIntentsRequestBodyPaymentMethodOptions'
{ postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit = Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay = Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodOptions'Alipay :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Alipay = Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact = Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodOptions'Boleto :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Boleto = Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodOptions'Card :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Card = Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent = Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo = Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodOptions'P24 :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'P24 = Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit = Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodOptions'Sofort :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Sofort = Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
forall a. Maybe a
GHC.Maybe.Nothing
}
data PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1 = PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
{
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'),
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod')
}
deriving
( Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1]
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1]
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1]
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1]
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1 where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Value
toJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"mandate_options" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"verification_method" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Encoding
toEncoding PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"mandate_options" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"verification_method" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
obj))
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1 where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
parseJSON = String
-> (Object
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1)
-> Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1" (\Object
obj -> ((Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1)
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1 Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1)
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions')
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"mandate_options")) Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1)
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod')
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"verification_method"))
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1 :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1 :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1 =
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1 :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
{ postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions = Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod = Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
forall a. Maybe a
GHC.Maybe.Nothing
}
data PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions' = PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
{
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants),
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'IntervalDescription :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'),
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType')
}
deriving
( Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions']
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions']
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions']
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions']
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Value
toJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"custom_mandate_url" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"interval_description" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'IntervalDescription PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"payment_schedule" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"transaction_type" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Encoding
toEncoding PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"custom_mandate_url" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"interval_description" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'IntervalDescription PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"payment_schedule" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"transaction_type" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
obj))))
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions' where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
parseJSON = String
-> (Object
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions')
-> Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'" (\Object
obj -> ((((Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Maybe Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions')
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Maybe Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Maybe Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions' Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Maybe Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions')
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants)
-> Parser
(Maybe Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"custom_mandate_url")) Parser
(Maybe Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions')
-> Parser (Maybe Text)
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"interval_description")) Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions')
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule')
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"payment_schedule")) Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions')
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType')
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"transaction_type"))
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions' :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions' :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions' =
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions' :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Maybe Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
{ postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl = Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'IntervalDescription :: Maybe Text
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'IntervalDescription = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule = Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
postPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType = Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
forall a. Maybe a
GHC.Maybe.Nothing
}
data PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
=
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'EmptyString
| PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Text Data.Text.Internal.Text
deriving (Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants]
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants]
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants]
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants]
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Value
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Text Text
a) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
a
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'EmptyString) = Value
""
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
parseJSON Value
val =
if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'EmptyString
| Bool
GHC.Base.otherwise -> case (Text
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Text (Text
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants)
-> Result Text
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value -> Result Text
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
Data.Aeson.Types.Internal.Success PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
a -> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
a
Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a
data PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
=
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'Other Data.Aeson.Types.Internal.Value
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'Typed Data.Text.Internal.Text
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'EnumCombined
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'EnumInterval
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'EnumSporadic
deriving (Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule']
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule']
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule']
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule']
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Value
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'Other Value
val) = Value
val
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'EnumCombined) = Value
"combined"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'EnumInterval) = Value
"interval"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'EnumSporadic) = Value
"sporadic"
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule' where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
parseJSON Value
val =
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure
( if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"combined" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'EnumCombined
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"interval" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'EnumInterval
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"sporadic" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'EnumSporadic
| Bool
GHC.Base.otherwise -> Value
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'Other Value
val
)
data PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
=
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'Other Data.Aeson.Types.Internal.Value
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'Typed Data.Text.Internal.Text
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'EnumBusiness
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'EnumPersonal
deriving (Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType']
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType']
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType']
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType']
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> Value
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'Other Value
val) = Value
val
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'EnumBusiness) = Value
"business"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'EnumPersonal) = Value
"personal"
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType' where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
parseJSON Value
val =
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure
( if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"business" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'EnumBusiness
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"personal" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'EnumPersonal
| Bool
GHC.Base.otherwise -> Value
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'Other Value
val
)
data PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
=
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'Other Data.Aeson.Types.Internal.Value
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'Typed Data.Text.Internal.Text
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'EnumAutomatic
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'EnumInstant
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'EnumMicrodeposits
deriving (Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod']
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod']
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod']
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod']
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> Value
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'Other Value
val) = Value
val
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'EnumAutomatic) = Value
"automatic"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'EnumInstant) = Value
"instant"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'EnumMicrodeposits) = Value
"microdeposits"
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod' where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
parseJSON Value
val =
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure
( if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"automatic" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'EnumAutomatic
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"instant" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'EnumInstant
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"microdeposits" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'EnumMicrodeposits
| Bool
GHC.Base.otherwise -> Value
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'Other Value
val
)
data PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
=
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'EmptyString
| PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1 PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
deriving (Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants]
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants]
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants]
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants]
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Value
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1 PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
a) = PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
a
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'EmptyString) = Value
""
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
parseJSON Value
val =
if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'EmptyString
| Bool
GHC.Base.otherwise -> case (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1 (PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants)
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
Data.Aeson.Types.Internal.Success PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
a -> PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
a
Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AcssDebit'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a
data PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1 = PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
{
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1Reference :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
}
deriving
( Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1]
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1]
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1]
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1]
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1 where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> Value
toJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"reference" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1Reference PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> Encoding
toEncoding PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs (Text
"reference" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1Reference PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
obj)
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1 where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
parseJSON = String
-> (Object
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1)
-> Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1" (\Object
obj -> (Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1)
-> Parser
(Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1 Parser
(Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1)
-> Parser (Maybe Text)
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"reference"))
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1 :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1 :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1 = PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1 :: Maybe Text
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1 {postPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1Reference :: Maybe Text
postPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1Reference = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing}
data PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
=
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'EmptyString
| PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1 PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
deriving (Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants]
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants]
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants]
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants]
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Value
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1 PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
a) = PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
a
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'EmptyString) = Value
""
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
parseJSON Value
val =
if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'EmptyString
| Bool
GHC.Base.otherwise -> case (PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1 (PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants)
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
Data.Aeson.Types.Internal.Success PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
a -> PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
a
Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a
data PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
=
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'EmptyString
| PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Object Data.Aeson.Types.Internal.Object
deriving (Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants]
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants]
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants]
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants]
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> Value
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Object Object
a) = Object -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Object
a
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'EmptyString) = Value
""
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
parseJSON Value
val =
if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'EmptyString
| Bool
GHC.Base.otherwise -> case (Object
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Object (Object
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants)
-> Result Object
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value -> Result Object
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
Data.Aeson.Types.Internal.Success PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
a -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
a
Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Alipay'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a
data PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1 = PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
{
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
postPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage')
}
deriving
( Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1]
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1]
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1]
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1]
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1 where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> Value
toJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"preferred_language" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
postPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> Encoding
toEncoding PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs (Text
"preferred_language" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
postPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
obj)
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1 where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
parseJSON = String
-> (Object
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1)
-> Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1" (\Object
obj -> (Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1)
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1 Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1)
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage')
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"preferred_language"))
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1 :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1 :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1 = PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1 :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1 {postPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
postPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage = Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
forall a. Maybe a
GHC.Maybe.Nothing}
data PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
=
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'Other Data.Aeson.Types.Internal.Value
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'Typed Data.Text.Internal.Text
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'EnumDe
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'EnumEn
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'EnumFr
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'EnumNl
deriving (Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage']
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage']
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage']
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage']
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> Value
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'Other Value
val) = Value
val
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'EnumDe) = Value
"de"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'EnumEn) = Value
"en"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'EnumFr) = Value
"fr"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'EnumNl) = Value
"nl"
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage' where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
parseJSON Value
val =
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure
( if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"de" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'EnumDe
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"en" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'EnumEn
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"fr" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'EnumFr
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"nl" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'EnumNl
| Bool
GHC.Base.otherwise -> Value
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'Other Value
val
)
data PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
=
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'EmptyString
| PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1 PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
deriving (Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants]
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants]
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants]
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants]
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Value
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1 PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
a) = PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
a
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'EmptyString) = Value
""
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
parseJSON Value
val =
if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'EmptyString
| Bool
GHC.Base.otherwise -> case (PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1 (PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants)
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
Data.Aeson.Types.Internal.Success PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
a -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
a
Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Bancontact'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a
data PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1 = PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
{
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> Maybe Int
postPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1ExpiresAfterDays :: (GHC.Maybe.Maybe GHC.Types.Int)
}
deriving
( Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1]
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1]
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1]
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1]
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1 where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> Value
toJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"expires_after_days" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> Maybe Int
postPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1ExpiresAfterDays PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> Encoding
toEncoding PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs (Text
"expires_after_days" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> Maybe Int
postPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1ExpiresAfterDays PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
obj)
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1 where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
parseJSON = String
-> (Object
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1)
-> Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1" (\Object
obj -> (Maybe Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1)
-> Parser
(Maybe Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1 Parser
(Maybe Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1)
-> Parser (Maybe Int)
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"expires_after_days"))
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1 :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1 :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1 = PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1 :: Maybe Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1 {postPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1ExpiresAfterDays :: Maybe Int
postPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1ExpiresAfterDays = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing}
data PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
=
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'EmptyString
| PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1 PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
deriving (Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants]
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants]
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants]
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants]
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> Value
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1 PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
a) = PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
a
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'EmptyString) = Value
""
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
parseJSON Value
val =
if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'EmptyString
| Bool
GHC.Base.otherwise -> case (PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1 (PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants)
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
Data.Aeson.Types.Internal.Success PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
a -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
a
Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Boleto'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a
data PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1 = PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
{
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1CvcToken :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'),
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'),
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure')
}
deriving
( Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1]
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1]
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1]
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1]
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> Bool)
-> Eq PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1 where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> Value
toJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"cvc_token" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1CvcToken PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"installments" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"network" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"request_three_d_secure" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> Encoding
toEncoding PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"cvc_token" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> Maybe Text
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1CvcToken PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"installments" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"network" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"request_three_d_secure" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
obj))))
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1 where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
parseJSON = String
-> (Object
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1)
-> Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1" (\Object
obj -> ((((Maybe Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1)
-> Parser
(Maybe Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1 Parser
(Maybe Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1)
-> Parser (Maybe Text)
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"cvc_token")) Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1)
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments')
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"installments")) Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1)
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network')
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"network")) Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1)
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure')
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"request_three_d_secure"))
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1 :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1 :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1 =
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1 :: Maybe Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
{ postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1CvcToken :: Maybe Text
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1CvcToken = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments = Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network = Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure = Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
forall a. Maybe a
GHC.Maybe.Nothing
}
data PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments' = PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
{
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Maybe Bool
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Enabled :: (GHC.Maybe.Maybe GHC.Types.Bool),
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants)
}
deriving
( Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments']
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments']
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments']
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments']
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Value
toJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"enabled" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Maybe Bool
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Enabled PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"plan" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Encoding
toEncoding PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"enabled" Text -> Maybe Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Maybe Bool
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Enabled PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"plan" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
obj))
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments' where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
parseJSON = String
-> (Object
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments')
-> Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'" (\Object
obj -> ((Maybe Bool
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments')
-> Parser
(Maybe Bool
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Bool
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments' Parser
(Maybe Bool
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments')
-> Parser (Maybe Bool)
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"enabled")) Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments')
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants)
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"plan"))
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments' :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments' :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments' =
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments' :: Maybe Bool
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
{ postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Enabled :: Maybe Bool
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Enabled = Maybe Bool
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan = Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
forall a. Maybe a
GHC.Maybe.Nothing
}
data PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1 = PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
{
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> Int
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1Count :: GHC.Types.Int
}
deriving
( Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1]
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1]
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1]
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1]
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1 where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> Value
toJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"count" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> Int
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1Count PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"interval" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= Text -> Value
Data.Aeson.Types.Internal.String Text
"month" Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"type" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= Text -> Value
Data.Aeson.Types.Internal.String Text
"fixed_count" Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> Encoding
toEncoding PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"count" Text -> Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> Int
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1Count PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"interval" Text -> Value -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= Text -> Value
Data.Aeson.Types.Internal.String Text
"month") Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"type" Text -> Value -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= Text -> Value
Data.Aeson.Types.Internal.String Text
"fixed_count")))
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1 where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
parseJSON = String
-> (Object
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1)
-> Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1" (\Object
obj -> (Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1)
-> Parser
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1 Parser
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1)
-> Parser Int
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"count"))
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1 ::
GHC.Types.Int ->
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1 :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1 Int
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1Count = PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1 :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1 {postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1Count :: Int
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1Count = Int
postPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1Count}
data PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
=
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'EmptyString
| PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1 PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
deriving (Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants]
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants]
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants]
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants]
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> Value
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1 PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
a) = PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
a
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'EmptyString) = Value
""
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
parseJSON Value
val =
if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'EmptyString
| Bool
GHC.Base.otherwise -> case (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1 (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants)
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
Data.Aeson.Types.Internal.Success PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
a -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
a
Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a
data PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
=
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'Other Data.Aeson.Types.Internal.Value
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'Typed Data.Text.Internal.Text
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumAmex
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumCartesBancaires
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumDiners
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumDiscover
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumInterac
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumJcb
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumMastercard
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumUnionpay
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumUnknown
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumVisa
deriving (Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network']
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network']
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network']
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network']
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Value
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'Other Value
val) = Value
val
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumAmex) = Value
"amex"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumCartesBancaires) = Value
"cartes_bancaires"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumDiners) = Value
"diners"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumDiscover) = Value
"discover"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumInterac) = Value
"interac"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumJcb) = Value
"jcb"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumMastercard) = Value
"mastercard"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumUnionpay) = Value
"unionpay"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumUnknown) = Value
"unknown"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumVisa) = Value
"visa"
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network' where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
parseJSON Value
val =
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure
( if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"amex" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumAmex
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"cartes_bancaires" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumCartesBancaires
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"diners" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumDiners
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"discover" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumDiscover
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"interac" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumInterac
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"jcb" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumJcb
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"mastercard" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumMastercard
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"unionpay" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumUnionpay
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"unknown" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumUnknown
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"visa" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumVisa
| Bool
GHC.Base.otherwise -> Value
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1Network'Other Value
val
)
data PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
=
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'Other Data.Aeson.Types.Internal.Value
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'Typed Data.Text.Internal.Text
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'EnumAny
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'EnumAutomatic
deriving (Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure']
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure']
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure']
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure']
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> Value
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'Other Value
val) = Value
val
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'EnumAny) = Value
"any"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'EnumAutomatic) = Value
"automatic"
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure' where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
parseJSON Value
val =
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure
( if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"any" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'EnumAny
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"automatic" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'EnumAutomatic
| Bool
GHC.Base.otherwise -> Value
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'Other Value
val
)
data PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
=
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'EmptyString
| PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1 PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
deriving (Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants]
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants]
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants]
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants]
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Value
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1 PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
a) = PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
a
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'EmptyString) = Value
""
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
parseJSON Value
val =
if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'EmptyString
| Bool
GHC.Base.otherwise -> case (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1 (PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants)
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
Data.Aeson.Types.Internal.Success PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
a -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
a
Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Card'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a
data PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
=
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'EmptyString
| PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Object Data.Aeson.Types.Internal.Object
deriving (Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants]
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants]
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants]
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants]
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Value
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Object Object
a) = Object -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Object
a
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'EmptyString) = Value
""
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
parseJSON Value
val =
if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'EmptyString
| Bool
GHC.Base.otherwise -> case (Object
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Object (Object
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants)
-> Result Object
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value -> Result Object
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
Data.Aeson.Types.Internal.Success PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
a -> PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
a
Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'CardPresent'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a
data PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1 = PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
{
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> Maybe Int
postPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1ExpiresAfterDays :: (GHC.Maybe.Maybe GHC.Types.Int)
}
deriving
( Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1]
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1]
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1]
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1]
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> Bool)
-> Eq PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1 where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> Value
toJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"expires_after_days" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> Maybe Int
postPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1ExpiresAfterDays PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> Encoding
toEncoding PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs (Text
"expires_after_days" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> Maybe Int
postPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1ExpiresAfterDays PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
obj)
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1 where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
parseJSON = String
-> (Object
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1)
-> Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1" (\Object
obj -> (Maybe Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1)
-> Parser
(Maybe Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1 Parser
(Maybe Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1)
-> Parser (Maybe Int)
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"expires_after_days"))
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1 :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1 :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1 = PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1 :: Maybe Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1 {postPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1ExpiresAfterDays :: Maybe Int
postPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1ExpiresAfterDays = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing}
data PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
=
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'EmptyString
| PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1 PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
deriving (Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants]
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants]
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants]
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants]
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Value
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1 PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
a) = PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
a
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'EmptyString) = Value
""
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
parseJSON Value
val =
if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'EmptyString
| Bool
GHC.Base.otherwise -> case (PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1 (PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants)
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
Data.Aeson.Types.Internal.Success PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
a -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
a
Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Oxxo'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a
data PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1 = PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
{
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> Maybe Bool
postPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1TosShownAndAccepted :: (GHC.Maybe.Maybe GHC.Types.Bool)
}
deriving
( Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1]
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1]
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1]
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1]
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> Bool)
-> Eq PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1 where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> Value
toJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"tos_shown_and_accepted" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> Maybe Bool
postPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1TosShownAndAccepted PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> Encoding
toEncoding PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs (Text
"tos_shown_and_accepted" Text -> Maybe Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> Maybe Bool
postPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1TosShownAndAccepted PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
obj)
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1 where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
parseJSON = String
-> (Object
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1)
-> Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1" (\Object
obj -> (Maybe Bool
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1)
-> Parser
(Maybe Bool
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Bool
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1 Parser
(Maybe Bool
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1)
-> Parser (Maybe Bool)
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"tos_shown_and_accepted"))
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1 :: PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1 :: PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1 = PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1 :: Maybe Bool
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1 {postPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1TosShownAndAccepted :: Maybe Bool
postPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1TosShownAndAccepted = Maybe Bool
forall a. Maybe a
GHC.Maybe.Nothing}
data PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
=
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'EmptyString
| PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1 PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
deriving (Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants]
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants]
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants]
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants]
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Value
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1 PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
a) = PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
a
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'EmptyString) = Value
""
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
parseJSON Value
val =
if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'EmptyString
| Bool
GHC.Base.otherwise -> case (PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1 (PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants)
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
Data.Aeson.Types.Internal.Success PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
a -> PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
a
Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'P24'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a
data PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1 = PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
{
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> Maybe Object
postPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1MandateOptions :: (GHC.Maybe.Maybe Data.Aeson.Types.Internal.Object)
}
deriving
( Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1]
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1]
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1]
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1]
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1 where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> Value
toJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"mandate_options" Text -> Maybe Object -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> Maybe Object
postPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1MandateOptions PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> Encoding
toEncoding PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs (Text
"mandate_options" Text -> Maybe Object -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> Maybe Object
postPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1MandateOptions PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
obj)
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1 where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
parseJSON = String
-> (Object
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1)
-> Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1" (\Object
obj -> (Maybe Object
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1)
-> Parser
(Maybe Object
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Object
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1 Parser
(Maybe Object
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1)
-> Parser (Maybe Object)
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"mandate_options"))
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1 :: PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1 :: PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1 = PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1 :: Maybe Object
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1 {postPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1MandateOptions :: Maybe Object
postPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1MandateOptions = Maybe Object
forall a. Maybe a
GHC.Maybe.Nothing}
data PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
=
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'EmptyString
| PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1 PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
deriving (Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants]
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants]
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants]
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants]
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Value
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1 PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
a) = PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
a
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'EmptyString) = Value
""
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
parseJSON Value
val =
if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'EmptyString
| Bool
GHC.Base.otherwise -> case (PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1 (PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants)
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
Data.Aeson.Types.Internal.Success PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
a -> PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
a
Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'SepaDebit'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a
data PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1 = PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
{
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
postPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage :: (GHC.Maybe.Maybe PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage')
}
deriving
( Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1]
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1]
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1]
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1]
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1 where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> Value
toJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"preferred_language" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
postPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> Encoding
toEncoding PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs (Text
"preferred_language" Text
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
postPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
obj)
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1 where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
parseJSON = String
-> (Object
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1)
-> Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1" (\Object
obj -> (Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1)
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1 Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1)
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage')
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
(Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"preferred_language"))
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1 :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1 :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
mkPostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1 = PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1 :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1 {postPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage :: Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
postPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage = Maybe
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
forall a. Maybe a
GHC.Maybe.Nothing}
data PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
=
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'Other Data.Aeson.Types.Internal.Value
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'Typed Data.Text.Internal.Text
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumDe
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumEn
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumEs
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumFr
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumIt
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumNl
|
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumPl
deriving (Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage']
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage']
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage']
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage']
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage' where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> Value
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'Other Value
val) = Value
val
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumDe) = Value
"de"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumEn) = Value
"en"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumEs) = Value
"es"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumFr) = Value
"fr"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumIt) = Value
"it"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumNl) = Value
"nl"
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumPl) = Value
"pl"
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage' where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
parseJSON Value
val =
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure
( if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"de" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumDe
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"en" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumEn
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"es" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumEs
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"fr" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumFr
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"it" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumIt
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"nl" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumNl
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"pl" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumPl
| Bool
GHC.Base.otherwise -> Value
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'Other Value
val
)
data PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
=
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'EmptyString
| PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1 PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
deriving (Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> ShowS
[PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants]
-> ShowS
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> String
(Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> ShowS)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> String)
-> ([PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants]
-> ShowS)
-> Show
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants]
-> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants]
-> ShowS
show :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> String
$cshow :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> ShowS
$cshowsPrec :: Int
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> Bool
(PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> Bool)
-> (PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> Bool)
-> Eq
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> Bool
$c/= :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> Bool
== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> Bool
$c== :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants where
toJSON :: PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> Value
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1 PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
a) = PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
a
toJSON (PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'EmptyString) = Value
""
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants where
parseJSON :: Value
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
parseJSON Value
val =
if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'EmptyString
| Bool
GHC.Base.otherwise -> case (PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1 (PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants)
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
Data.Aeson.Types.Internal.Success PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
a -> PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
a
Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
PostPaymentIntentsRequestBodyPaymentMethodOptions'Sofort'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a
data PostPaymentIntentsRequestBodySetupFutureUsage'
=
PostPaymentIntentsRequestBodySetupFutureUsage'Other Data.Aeson.Types.Internal.Value
|
PostPaymentIntentsRequestBodySetupFutureUsage'Typed Data.Text.Internal.Text
|
PostPaymentIntentsRequestBodySetupFutureUsage'EnumOffSession
|
PostPaymentIntentsRequestBodySetupFutureUsage'EnumOnSession
deriving (Int -> PostPaymentIntentsRequestBodySetupFutureUsage' -> ShowS
[PostPaymentIntentsRequestBodySetupFutureUsage'] -> ShowS
PostPaymentIntentsRequestBodySetupFutureUsage' -> String
(Int -> PostPaymentIntentsRequestBodySetupFutureUsage' -> ShowS)
-> (PostPaymentIntentsRequestBodySetupFutureUsage' -> String)
-> ([PostPaymentIntentsRequestBodySetupFutureUsage'] -> ShowS)
-> Show PostPaymentIntentsRequestBodySetupFutureUsage'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodySetupFutureUsage'] -> ShowS
$cshowList :: [PostPaymentIntentsRequestBodySetupFutureUsage'] -> ShowS
show :: PostPaymentIntentsRequestBodySetupFutureUsage' -> String
$cshow :: PostPaymentIntentsRequestBodySetupFutureUsage' -> String
showsPrec :: Int -> PostPaymentIntentsRequestBodySetupFutureUsage' -> ShowS
$cshowsPrec :: Int -> PostPaymentIntentsRequestBodySetupFutureUsage' -> ShowS
GHC.Show.Show, PostPaymentIntentsRequestBodySetupFutureUsage'
-> PostPaymentIntentsRequestBodySetupFutureUsage' -> Bool
(PostPaymentIntentsRequestBodySetupFutureUsage'
-> PostPaymentIntentsRequestBodySetupFutureUsage' -> Bool)
-> (PostPaymentIntentsRequestBodySetupFutureUsage'
-> PostPaymentIntentsRequestBodySetupFutureUsage' -> Bool)
-> Eq PostPaymentIntentsRequestBodySetupFutureUsage'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodySetupFutureUsage'
-> PostPaymentIntentsRequestBodySetupFutureUsage' -> Bool
$c/= :: PostPaymentIntentsRequestBodySetupFutureUsage'
-> PostPaymentIntentsRequestBodySetupFutureUsage' -> Bool
== :: PostPaymentIntentsRequestBodySetupFutureUsage'
-> PostPaymentIntentsRequestBodySetupFutureUsage' -> Bool
$c== :: PostPaymentIntentsRequestBodySetupFutureUsage'
-> PostPaymentIntentsRequestBodySetupFutureUsage' -> Bool
GHC.Classes.Eq)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodySetupFutureUsage' where
toJSON :: PostPaymentIntentsRequestBodySetupFutureUsage' -> Value
toJSON (PostPaymentIntentsRequestBodySetupFutureUsage'Other Value
val) = Value
val
toJSON (PostPaymentIntentsRequestBodySetupFutureUsage'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
toJSON (PostPaymentIntentsRequestBodySetupFutureUsage'
PostPaymentIntentsRequestBodySetupFutureUsage'EnumOffSession) = Value
"off_session"
toJSON (PostPaymentIntentsRequestBodySetupFutureUsage'
PostPaymentIntentsRequestBodySetupFutureUsage'EnumOnSession) = Value
"on_session"
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodySetupFutureUsage' where
parseJSON :: Value -> Parser PostPaymentIntentsRequestBodySetupFutureUsage'
parseJSON Value
val =
PostPaymentIntentsRequestBodySetupFutureUsage'
-> Parser PostPaymentIntentsRequestBodySetupFutureUsage'
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure
( if
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"off_session" -> PostPaymentIntentsRequestBodySetupFutureUsage'
PostPaymentIntentsRequestBodySetupFutureUsage'EnumOffSession
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"on_session" -> PostPaymentIntentsRequestBodySetupFutureUsage'
PostPaymentIntentsRequestBodySetupFutureUsage'EnumOnSession
| Bool
GHC.Base.otherwise -> Value -> PostPaymentIntentsRequestBodySetupFutureUsage'
PostPaymentIntentsRequestBodySetupFutureUsage'Other Value
val
)
data PostPaymentIntentsRequestBodyShipping' = PostPaymentIntentsRequestBodyShipping'
{
PostPaymentIntentsRequestBodyShipping'
-> PostPaymentIntentsRequestBodyShipping'Address'
postPaymentIntentsRequestBodyShipping'Address :: PostPaymentIntentsRequestBodyShipping'Address',
PostPaymentIntentsRequestBodyShipping' -> Maybe Text
postPaymentIntentsRequestBodyShipping'Carrier :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
PostPaymentIntentsRequestBodyShipping' -> Text
postPaymentIntentsRequestBodyShipping'Name :: Data.Text.Internal.Text,
PostPaymentIntentsRequestBodyShipping' -> Maybe Text
postPaymentIntentsRequestBodyShipping'Phone :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
PostPaymentIntentsRequestBodyShipping' -> Maybe Text
postPaymentIntentsRequestBodyShipping'TrackingNumber :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
}
deriving
( Int -> PostPaymentIntentsRequestBodyShipping' -> ShowS
[PostPaymentIntentsRequestBodyShipping'] -> ShowS
PostPaymentIntentsRequestBodyShipping' -> String
(Int -> PostPaymentIntentsRequestBodyShipping' -> ShowS)
-> (PostPaymentIntentsRequestBodyShipping' -> String)
-> ([PostPaymentIntentsRequestBodyShipping'] -> ShowS)
-> Show PostPaymentIntentsRequestBodyShipping'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyShipping'] -> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyShipping'] -> ShowS
show :: PostPaymentIntentsRequestBodyShipping' -> String
$cshow :: PostPaymentIntentsRequestBodyShipping' -> String
showsPrec :: Int -> PostPaymentIntentsRequestBodyShipping' -> ShowS
$cshowsPrec :: Int -> PostPaymentIntentsRequestBodyShipping' -> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyShipping'
-> PostPaymentIntentsRequestBodyShipping' -> Bool
(PostPaymentIntentsRequestBodyShipping'
-> PostPaymentIntentsRequestBodyShipping' -> Bool)
-> (PostPaymentIntentsRequestBodyShipping'
-> PostPaymentIntentsRequestBodyShipping' -> Bool)
-> Eq PostPaymentIntentsRequestBodyShipping'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyShipping'
-> PostPaymentIntentsRequestBodyShipping' -> Bool
$c/= :: PostPaymentIntentsRequestBodyShipping'
-> PostPaymentIntentsRequestBodyShipping' -> Bool
== :: PostPaymentIntentsRequestBodyShipping'
-> PostPaymentIntentsRequestBodyShipping' -> Bool
$c== :: PostPaymentIntentsRequestBodyShipping'
-> PostPaymentIntentsRequestBodyShipping' -> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyShipping' where
toJSON :: PostPaymentIntentsRequestBodyShipping' -> Value
toJSON PostPaymentIntentsRequestBodyShipping'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"address" Text -> PostPaymentIntentsRequestBodyShipping'Address' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyShipping'
-> PostPaymentIntentsRequestBodyShipping'Address'
postPaymentIntentsRequestBodyShipping'Address PostPaymentIntentsRequestBodyShipping'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"carrier" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyShipping' -> Maybe Text
postPaymentIntentsRequestBodyShipping'Carrier PostPaymentIntentsRequestBodyShipping'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyShipping' -> Text
postPaymentIntentsRequestBodyShipping'Name PostPaymentIntentsRequestBodyShipping'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"phone" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyShipping' -> Maybe Text
postPaymentIntentsRequestBodyShipping'Phone PostPaymentIntentsRequestBodyShipping'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"tracking_number" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyShipping' -> Maybe Text
postPaymentIntentsRequestBodyShipping'TrackingNumber PostPaymentIntentsRequestBodyShipping'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyShipping' -> Encoding
toEncoding PostPaymentIntentsRequestBodyShipping'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"address" Text -> PostPaymentIntentsRequestBodyShipping'Address' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyShipping'
-> PostPaymentIntentsRequestBodyShipping'Address'
postPaymentIntentsRequestBodyShipping'Address PostPaymentIntentsRequestBodyShipping'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"carrier" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyShipping' -> Maybe Text
postPaymentIntentsRequestBodyShipping'Carrier PostPaymentIntentsRequestBodyShipping'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"name" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyShipping' -> Text
postPaymentIntentsRequestBodyShipping'Name PostPaymentIntentsRequestBodyShipping'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"phone" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyShipping' -> Maybe Text
postPaymentIntentsRequestBodyShipping'Phone PostPaymentIntentsRequestBodyShipping'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"tracking_number" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyShipping' -> Maybe Text
postPaymentIntentsRequestBodyShipping'TrackingNumber PostPaymentIntentsRequestBodyShipping'
obj)))))
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyShipping' where
parseJSON :: Value -> Parser PostPaymentIntentsRequestBodyShipping'
parseJSON = String
-> (Object -> Parser PostPaymentIntentsRequestBodyShipping')
-> Value
-> Parser PostPaymentIntentsRequestBodyShipping'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyShipping'" (\Object
obj -> (((((PostPaymentIntentsRequestBodyShipping'Address'
-> Maybe Text
-> Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyShipping')
-> Parser
(PostPaymentIntentsRequestBodyShipping'Address'
-> Maybe Text
-> Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyShipping')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsRequestBodyShipping'Address'
-> Maybe Text
-> Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyShipping'
PostPaymentIntentsRequestBodyShipping' Parser
(PostPaymentIntentsRequestBodyShipping'Address'
-> Maybe Text
-> Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyShipping')
-> Parser PostPaymentIntentsRequestBodyShipping'Address'
-> Parser
(Maybe Text
-> Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyShipping')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser PostPaymentIntentsRequestBodyShipping'Address'
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"address")) Parser
(Maybe Text
-> Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyShipping')
-> Parser (Maybe Text)
-> Parser
(Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyShipping')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"carrier")) Parser
(Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyShipping')
-> Parser Text
-> Parser
(Maybe Text
-> Maybe Text -> PostPaymentIntentsRequestBodyShipping')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"name")) Parser
(Maybe Text
-> Maybe Text -> PostPaymentIntentsRequestBodyShipping')
-> Parser (Maybe Text)
-> Parser (Maybe Text -> PostPaymentIntentsRequestBodyShipping')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"phone")) Parser (Maybe Text -> PostPaymentIntentsRequestBodyShipping')
-> Parser (Maybe Text)
-> Parser PostPaymentIntentsRequestBodyShipping'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"tracking_number"))
mkPostPaymentIntentsRequestBodyShipping' ::
PostPaymentIntentsRequestBodyShipping'Address' ->
Data.Text.Internal.Text ->
PostPaymentIntentsRequestBodyShipping'
mkPostPaymentIntentsRequestBodyShipping' :: PostPaymentIntentsRequestBodyShipping'Address'
-> Text -> PostPaymentIntentsRequestBodyShipping'
mkPostPaymentIntentsRequestBodyShipping' PostPaymentIntentsRequestBodyShipping'Address'
postPaymentIntentsRequestBodyShipping'Address Text
postPaymentIntentsRequestBodyShipping'Name =
PostPaymentIntentsRequestBodyShipping' :: PostPaymentIntentsRequestBodyShipping'Address'
-> Maybe Text
-> Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyShipping'
PostPaymentIntentsRequestBodyShipping'
{ postPaymentIntentsRequestBodyShipping'Address :: PostPaymentIntentsRequestBodyShipping'Address'
postPaymentIntentsRequestBodyShipping'Address = PostPaymentIntentsRequestBodyShipping'Address'
postPaymentIntentsRequestBodyShipping'Address,
postPaymentIntentsRequestBodyShipping'Carrier :: Maybe Text
postPaymentIntentsRequestBodyShipping'Carrier = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyShipping'Name :: Text
postPaymentIntentsRequestBodyShipping'Name = Text
postPaymentIntentsRequestBodyShipping'Name,
postPaymentIntentsRequestBodyShipping'Phone :: Maybe Text
postPaymentIntentsRequestBodyShipping'Phone = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyShipping'TrackingNumber :: Maybe Text
postPaymentIntentsRequestBodyShipping'TrackingNumber = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
}
data PostPaymentIntentsRequestBodyShipping'Address' = PostPaymentIntentsRequestBodyShipping'Address'
{
PostPaymentIntentsRequestBodyShipping'Address' -> Maybe Text
postPaymentIntentsRequestBodyShipping'Address'City :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
PostPaymentIntentsRequestBodyShipping'Address' -> Maybe Text
postPaymentIntentsRequestBodyShipping'Address'Country :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
PostPaymentIntentsRequestBodyShipping'Address' -> Text
postPaymentIntentsRequestBodyShipping'Address'Line1 :: Data.Text.Internal.Text,
PostPaymentIntentsRequestBodyShipping'Address' -> Maybe Text
postPaymentIntentsRequestBodyShipping'Address'Line2 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
PostPaymentIntentsRequestBodyShipping'Address' -> Maybe Text
postPaymentIntentsRequestBodyShipping'Address'PostalCode :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
PostPaymentIntentsRequestBodyShipping'Address' -> Maybe Text
postPaymentIntentsRequestBodyShipping'Address'State :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
}
deriving
( Int -> PostPaymentIntentsRequestBodyShipping'Address' -> ShowS
[PostPaymentIntentsRequestBodyShipping'Address'] -> ShowS
PostPaymentIntentsRequestBodyShipping'Address' -> String
(Int -> PostPaymentIntentsRequestBodyShipping'Address' -> ShowS)
-> (PostPaymentIntentsRequestBodyShipping'Address' -> String)
-> ([PostPaymentIntentsRequestBodyShipping'Address'] -> ShowS)
-> Show PostPaymentIntentsRequestBodyShipping'Address'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyShipping'Address'] -> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyShipping'Address'] -> ShowS
show :: PostPaymentIntentsRequestBodyShipping'Address' -> String
$cshow :: PostPaymentIntentsRequestBodyShipping'Address' -> String
showsPrec :: Int -> PostPaymentIntentsRequestBodyShipping'Address' -> ShowS
$cshowsPrec :: Int -> PostPaymentIntentsRequestBodyShipping'Address' -> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyShipping'Address'
-> PostPaymentIntentsRequestBodyShipping'Address' -> Bool
(PostPaymentIntentsRequestBodyShipping'Address'
-> PostPaymentIntentsRequestBodyShipping'Address' -> Bool)
-> (PostPaymentIntentsRequestBodyShipping'Address'
-> PostPaymentIntentsRequestBodyShipping'Address' -> Bool)
-> Eq PostPaymentIntentsRequestBodyShipping'Address'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyShipping'Address'
-> PostPaymentIntentsRequestBodyShipping'Address' -> Bool
$c/= :: PostPaymentIntentsRequestBodyShipping'Address'
-> PostPaymentIntentsRequestBodyShipping'Address' -> Bool
== :: PostPaymentIntentsRequestBodyShipping'Address'
-> PostPaymentIntentsRequestBodyShipping'Address' -> Bool
$c== :: PostPaymentIntentsRequestBodyShipping'Address'
-> PostPaymentIntentsRequestBodyShipping'Address' -> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyShipping'Address' where
toJSON :: PostPaymentIntentsRequestBodyShipping'Address' -> Value
toJSON PostPaymentIntentsRequestBodyShipping'Address'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"city" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyShipping'Address' -> Maybe Text
postPaymentIntentsRequestBodyShipping'Address'City PostPaymentIntentsRequestBodyShipping'Address'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"country" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyShipping'Address' -> Maybe Text
postPaymentIntentsRequestBodyShipping'Address'Country PostPaymentIntentsRequestBodyShipping'Address'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"line1" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyShipping'Address' -> Text
postPaymentIntentsRequestBodyShipping'Address'Line1 PostPaymentIntentsRequestBodyShipping'Address'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"line2" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyShipping'Address' -> Maybe Text
postPaymentIntentsRequestBodyShipping'Address'Line2 PostPaymentIntentsRequestBodyShipping'Address'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"postal_code" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyShipping'Address' -> Maybe Text
postPaymentIntentsRequestBodyShipping'Address'PostalCode PostPaymentIntentsRequestBodyShipping'Address'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"state" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyShipping'Address' -> Maybe Text
postPaymentIntentsRequestBodyShipping'Address'State PostPaymentIntentsRequestBodyShipping'Address'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyShipping'Address' -> Encoding
toEncoding PostPaymentIntentsRequestBodyShipping'Address'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"city" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyShipping'Address' -> Maybe Text
postPaymentIntentsRequestBodyShipping'Address'City PostPaymentIntentsRequestBodyShipping'Address'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"country" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyShipping'Address' -> Maybe Text
postPaymentIntentsRequestBodyShipping'Address'Country PostPaymentIntentsRequestBodyShipping'Address'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"line1" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyShipping'Address' -> Text
postPaymentIntentsRequestBodyShipping'Address'Line1 PostPaymentIntentsRequestBodyShipping'Address'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"line2" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyShipping'Address' -> Maybe Text
postPaymentIntentsRequestBodyShipping'Address'Line2 PostPaymentIntentsRequestBodyShipping'Address'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"postal_code" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyShipping'Address' -> Maybe Text
postPaymentIntentsRequestBodyShipping'Address'PostalCode PostPaymentIntentsRequestBodyShipping'Address'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"state" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyShipping'Address' -> Maybe Text
postPaymentIntentsRequestBodyShipping'Address'State PostPaymentIntentsRequestBodyShipping'Address'
obj))))))
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyShipping'Address' where
parseJSON :: Value -> Parser PostPaymentIntentsRequestBodyShipping'Address'
parseJSON = String
-> (Object
-> Parser PostPaymentIntentsRequestBodyShipping'Address')
-> Value
-> Parser PostPaymentIntentsRequestBodyShipping'Address'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyShipping'Address'" (\Object
obj -> ((((((Maybe Text
-> Maybe Text
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyShipping'Address')
-> Parser
(Maybe Text
-> Maybe Text
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyShipping'Address')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe Text
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyShipping'Address'
PostPaymentIntentsRequestBodyShipping'Address' Parser
(Maybe Text
-> Maybe Text
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyShipping'Address')
-> Parser (Maybe Text)
-> Parser
(Maybe Text
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyShipping'Address')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"city")) Parser
(Maybe Text
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyShipping'Address')
-> Parser (Maybe Text)
-> Parser
(Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyShipping'Address')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"country")) Parser
(Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyShipping'Address')
-> Parser Text
-> Parser
(Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyShipping'Address')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"line1")) Parser
(Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyShipping'Address')
-> Parser (Maybe Text)
-> Parser
(Maybe Text
-> Maybe Text -> PostPaymentIntentsRequestBodyShipping'Address')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"line2")) Parser
(Maybe Text
-> Maybe Text -> PostPaymentIntentsRequestBodyShipping'Address')
-> Parser (Maybe Text)
-> Parser
(Maybe Text -> PostPaymentIntentsRequestBodyShipping'Address')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"postal_code")) Parser
(Maybe Text -> PostPaymentIntentsRequestBodyShipping'Address')
-> Parser (Maybe Text)
-> Parser PostPaymentIntentsRequestBodyShipping'Address'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"state"))
mkPostPaymentIntentsRequestBodyShipping'Address' ::
Data.Text.Internal.Text ->
PostPaymentIntentsRequestBodyShipping'Address'
mkPostPaymentIntentsRequestBodyShipping'Address' :: Text -> PostPaymentIntentsRequestBodyShipping'Address'
mkPostPaymentIntentsRequestBodyShipping'Address' Text
postPaymentIntentsRequestBodyShipping'Address'Line1 =
PostPaymentIntentsRequestBodyShipping'Address' :: Maybe Text
-> Maybe Text
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsRequestBodyShipping'Address'
PostPaymentIntentsRequestBodyShipping'Address'
{ postPaymentIntentsRequestBodyShipping'Address'City :: Maybe Text
postPaymentIntentsRequestBodyShipping'Address'City = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyShipping'Address'Country :: Maybe Text
postPaymentIntentsRequestBodyShipping'Address'Country = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyShipping'Address'Line1 :: Text
postPaymentIntentsRequestBodyShipping'Address'Line1 = Text
postPaymentIntentsRequestBodyShipping'Address'Line1,
postPaymentIntentsRequestBodyShipping'Address'Line2 :: Maybe Text
postPaymentIntentsRequestBodyShipping'Address'Line2 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyShipping'Address'PostalCode :: Maybe Text
postPaymentIntentsRequestBodyShipping'Address'PostalCode = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyShipping'Address'State :: Maybe Text
postPaymentIntentsRequestBodyShipping'Address'State = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
}
data PostPaymentIntentsRequestBodyTransferData' = PostPaymentIntentsRequestBodyTransferData'
{
PostPaymentIntentsRequestBodyTransferData' -> Maybe Int
postPaymentIntentsRequestBodyTransferData'Amount :: (GHC.Maybe.Maybe GHC.Types.Int),
PostPaymentIntentsRequestBodyTransferData' -> Text
postPaymentIntentsRequestBodyTransferData'Destination :: Data.Text.Internal.Text
}
deriving
( Int -> PostPaymentIntentsRequestBodyTransferData' -> ShowS
[PostPaymentIntentsRequestBodyTransferData'] -> ShowS
PostPaymentIntentsRequestBodyTransferData' -> String
(Int -> PostPaymentIntentsRequestBodyTransferData' -> ShowS)
-> (PostPaymentIntentsRequestBodyTransferData' -> String)
-> ([PostPaymentIntentsRequestBodyTransferData'] -> ShowS)
-> Show PostPaymentIntentsRequestBodyTransferData'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsRequestBodyTransferData'] -> ShowS
$cshowList :: [PostPaymentIntentsRequestBodyTransferData'] -> ShowS
show :: PostPaymentIntentsRequestBodyTransferData' -> String
$cshow :: PostPaymentIntentsRequestBodyTransferData' -> String
showsPrec :: Int -> PostPaymentIntentsRequestBodyTransferData' -> ShowS
$cshowsPrec :: Int -> PostPaymentIntentsRequestBodyTransferData' -> ShowS
GHC.Show.Show,
PostPaymentIntentsRequestBodyTransferData'
-> PostPaymentIntentsRequestBodyTransferData' -> Bool
(PostPaymentIntentsRequestBodyTransferData'
-> PostPaymentIntentsRequestBodyTransferData' -> Bool)
-> (PostPaymentIntentsRequestBodyTransferData'
-> PostPaymentIntentsRequestBodyTransferData' -> Bool)
-> Eq PostPaymentIntentsRequestBodyTransferData'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsRequestBodyTransferData'
-> PostPaymentIntentsRequestBodyTransferData' -> Bool
$c/= :: PostPaymentIntentsRequestBodyTransferData'
-> PostPaymentIntentsRequestBodyTransferData' -> Bool
== :: PostPaymentIntentsRequestBodyTransferData'
-> PostPaymentIntentsRequestBodyTransferData' -> Bool
$c== :: PostPaymentIntentsRequestBodyTransferData'
-> PostPaymentIntentsRequestBodyTransferData' -> Bool
GHC.Classes.Eq
)
instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsRequestBodyTransferData' where
toJSON :: PostPaymentIntentsRequestBodyTransferData' -> Value
toJSON PostPaymentIntentsRequestBodyTransferData'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"amount" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyTransferData' -> Maybe Int
postPaymentIntentsRequestBodyTransferData'Amount PostPaymentIntentsRequestBodyTransferData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"destination" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyTransferData' -> Text
postPaymentIntentsRequestBodyTransferData'Destination PostPaymentIntentsRequestBodyTransferData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
toEncoding :: PostPaymentIntentsRequestBodyTransferData' -> Encoding
toEncoding PostPaymentIntentsRequestBodyTransferData'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"amount" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyTransferData' -> Maybe Int
postPaymentIntentsRequestBodyTransferData'Amount PostPaymentIntentsRequestBodyTransferData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"destination" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsRequestBodyTransferData' -> Text
postPaymentIntentsRequestBodyTransferData'Destination PostPaymentIntentsRequestBodyTransferData'
obj))
instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsRequestBodyTransferData' where
parseJSON :: Value -> Parser PostPaymentIntentsRequestBodyTransferData'
parseJSON = String
-> (Object -> Parser PostPaymentIntentsRequestBodyTransferData')
-> Value
-> Parser PostPaymentIntentsRequestBodyTransferData'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsRequestBodyTransferData'" (\Object
obj -> ((Maybe Int -> Text -> PostPaymentIntentsRequestBodyTransferData')
-> Parser
(Maybe Int -> Text -> PostPaymentIntentsRequestBodyTransferData')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Int -> Text -> PostPaymentIntentsRequestBodyTransferData'
PostPaymentIntentsRequestBodyTransferData' Parser
(Maybe Int -> Text -> PostPaymentIntentsRequestBodyTransferData')
-> Parser (Maybe Int)
-> Parser (Text -> PostPaymentIntentsRequestBodyTransferData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"amount")) Parser (Text -> PostPaymentIntentsRequestBodyTransferData')
-> Parser Text -> Parser PostPaymentIntentsRequestBodyTransferData'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"destination"))
mkPostPaymentIntentsRequestBodyTransferData' ::
Data.Text.Internal.Text ->
PostPaymentIntentsRequestBodyTransferData'
mkPostPaymentIntentsRequestBodyTransferData' :: Text -> PostPaymentIntentsRequestBodyTransferData'
mkPostPaymentIntentsRequestBodyTransferData' Text
postPaymentIntentsRequestBodyTransferData'Destination =
PostPaymentIntentsRequestBodyTransferData' :: Maybe Int -> Text -> PostPaymentIntentsRequestBodyTransferData'
PostPaymentIntentsRequestBodyTransferData'
{ postPaymentIntentsRequestBodyTransferData'Amount :: Maybe Int
postPaymentIntentsRequestBodyTransferData'Amount = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
postPaymentIntentsRequestBodyTransferData'Destination :: Text
postPaymentIntentsRequestBodyTransferData'Destination = Text
postPaymentIntentsRequestBodyTransferData'Destination
}
data PostPaymentIntentsResponse
=
PostPaymentIntentsResponseError GHC.Base.String
|
PostPaymentIntentsResponse200 PaymentIntent
|
PostPaymentIntentsResponseDefault Error
deriving (Int -> PostPaymentIntentsResponse -> ShowS
[PostPaymentIntentsResponse] -> ShowS
PostPaymentIntentsResponse -> String
(Int -> PostPaymentIntentsResponse -> ShowS)
-> (PostPaymentIntentsResponse -> String)
-> ([PostPaymentIntentsResponse] -> ShowS)
-> Show PostPaymentIntentsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPaymentIntentsResponse] -> ShowS
$cshowList :: [PostPaymentIntentsResponse] -> ShowS
show :: PostPaymentIntentsResponse -> String
$cshow :: PostPaymentIntentsResponse -> String
showsPrec :: Int -> PostPaymentIntentsResponse -> ShowS
$cshowsPrec :: Int -> PostPaymentIntentsResponse -> ShowS
GHC.Show.Show, PostPaymentIntentsResponse -> PostPaymentIntentsResponse -> Bool
(PostPaymentIntentsResponse -> PostPaymentIntentsResponse -> Bool)
-> (PostPaymentIntentsResponse
-> PostPaymentIntentsResponse -> Bool)
-> Eq PostPaymentIntentsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsResponse -> PostPaymentIntentsResponse -> Bool
$c/= :: PostPaymentIntentsResponse -> PostPaymentIntentsResponse -> Bool
== :: PostPaymentIntentsResponse -> PostPaymentIntentsResponse -> Bool
$c== :: PostPaymentIntentsResponse -> PostPaymentIntentsResponse -> Bool
GHC.Classes.Eq)