{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
-- CHANGE WITH CAUTION: This is a generated code file generated by https://github.com/Haskell-OpenAPI-Code-Generator/Haskell-OpenAPI-Client-Code-Generator.
{-# LANGUAGE OverloadedStrings #-}

-- | Contains the different functions to run the operation postPaymentIntentsIntent
module StripeAPI.Operations.PostPaymentIntentsIntent 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

-- | > POST /v1/payment_intents/{intent}
--
-- \<p>Updates properties on a PaymentIntent object without confirming.\<\/p>
--
-- \<p>Depending on which properties you update, you may need to confirm the
-- PaymentIntent again. For example, updating the \<code>payment_method\<\/code> will
-- always require you to confirm the PaymentIntent again. If you prefer to
-- update and confirm at the same time, we recommend updating properties via
-- the \<a href=\"\/docs\/api\/payment_intents\/confirm\">confirm API\<\/a> instead.\<\/p>
postPaymentIntentsIntent ::
  forall m.
  StripeAPI.Common.MonadHTTP m =>
  -- | intent | Constraints: Maximum length of 5000
  Data.Text.Internal.Text ->
  -- | The request body to send
  GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBody ->
  -- | Monadic computation which returns the result of the operation
  StripeAPI.Common.ClientT m (Network.HTTP.Client.Types.Response PostPaymentIntentsIntentResponse)
postPaymentIntentsIntent :: Text
-> Maybe PostPaymentIntentsIntentRequestBody
-> ClientT m (Response PostPaymentIntentsIntentResponse)
postPaymentIntentsIntent
  Text
intent
  Maybe PostPaymentIntentsIntentRequestBody
body =
    (Response ByteString -> Response PostPaymentIntentsIntentResponse)
-> ClientT m (Response ByteString)
-> ClientT m (Response PostPaymentIntentsIntentResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
      ( \Response ByteString
response_0 ->
          (ByteString -> PostPaymentIntentsIntentResponse)
-> Response ByteString -> Response PostPaymentIntentsIntentResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
            ( (String -> PostPaymentIntentsIntentResponse)
-> (PostPaymentIntentsIntentResponse
    -> PostPaymentIntentsIntentResponse)
-> Either String PostPaymentIntentsIntentResponse
-> PostPaymentIntentsIntentResponse
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Data.Either.either String -> PostPaymentIntentsIntentResponse
PostPaymentIntentsIntentResponseError PostPaymentIntentsIntentResponse
-> PostPaymentIntentsIntentResponse
forall a. a -> a
GHC.Base.id
                (Either String PostPaymentIntentsIntentResponse
 -> PostPaymentIntentsIntentResponse)
-> (ByteString -> Either String PostPaymentIntentsIntentResponse)
-> ByteString
-> PostPaymentIntentsIntentResponse
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 -> PostPaymentIntentsIntentResponse
PostPaymentIntentsIntentResponse200
                                       (PaymentIntent -> PostPaymentIntentsIntentResponse)
-> Either String PaymentIntent
-> Either String PostPaymentIntentsIntentResponse
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 -> PostPaymentIntentsIntentResponse
PostPaymentIntentsIntentResponseDefault
                                       (Error -> PostPaymentIntentsIntentResponse)
-> Either String Error
-> Either String PostPaymentIntentsIntentResponse
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 PostPaymentIntentsIntentResponse
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 PostPaymentIntentsIntentRequestBody
-> RequestBodyEncoding
-> ClientT m (Response ByteString)
forall (m :: * -> *) body.
(MonadHTTP m, ToJSON body) =>
Text
-> Text
-> [QueryParameter]
-> Maybe body
-> RequestBodyEncoding
-> ClientT 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/" String -> String -> String
forall a. [a] -> [a] -> [a]
GHC.Base.++ (ByteString -> String
Data.ByteString.Char8.unpack (Bool -> ByteString -> ByteString
Network.HTTP.Types.URI.urlEncode Bool
GHC.Types.True (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
GHC.Base.$ (String -> ByteString
Data.ByteString.Char8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
GHC.Base.$ Text -> String
forall a. StringifyModel a => a -> String
StripeAPI.Common.stringifyModel Text
intent)) String -> String -> String
forall a. [a] -> [a] -> [a]
GHC.Base.++ String
""))) [QueryParameter]
forall a. Monoid a => a
GHC.Base.mempty Maybe PostPaymentIntentsIntentRequestBody
body RequestBodyEncoding
StripeAPI.Common.RequestBodyEncodingFormData)

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema@ in the specification.
data PostPaymentIntentsIntentRequestBody = PostPaymentIntentsIntentRequestBody
  { -- | amount: Amount intended to be collected by this PaymentIntent. A positive integer representing how much to charge in the [smallest currency unit](https:\/\/stripe.com\/docs\/currencies\#zero-decimal) (e.g., 100 cents to charge \$1.00 or 100 to charge ¥100, a zero-decimal currency). The minimum amount is \$0.50 US or [equivalent in charge currency](https:\/\/stripe.com\/docs\/currencies\#minimum-and-maximum-charge-amounts). The amount value supports up to eight digits (e.g., a value of 99999999 for a USD charge of \$999,999.99).
    PostPaymentIntentsIntentRequestBody -> Maybe Int
postPaymentIntentsIntentRequestBodyAmount :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | application_fee_amount: The amount of the application fee (if any) that will be requested to be applied to the payment and transferred to the application owner\'s Stripe account. The amount of the application fee collected will be capped at the total payment amount. For more information, see the PaymentIntents [use case for connected accounts](https:\/\/stripe.com\/docs\/payments\/connected-accounts).
    PostPaymentIntentsIntentRequestBody
-> Maybe
     PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
postPaymentIntentsIntentRequestBodyApplicationFeeAmount :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants),
    -- | currency: Three-letter [ISO currency code](https:\/\/www.iso.org\/iso-4217-currency-codes.html), in lowercase. Must be a [supported currency](https:\/\/stripe.com\/docs\/currencies).
    PostPaymentIntentsIntentRequestBody -> Maybe Text
postPaymentIntentsIntentRequestBodyCurrency :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | customer: ID of the Customer this PaymentIntent belongs to, if one exists.
    --
    -- Payment methods attached to other Customers cannot be used with this PaymentIntent.
    --
    -- If present in combination with [setup_future_usage](https:\/\/stripe.com\/docs\/api\#payment_intent_object-setup_future_usage), this PaymentIntent\'s payment method will be attached to the Customer after the PaymentIntent has been confirmed and any required actions from the user are complete.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBody -> Maybe Text
postPaymentIntentsIntentRequestBodyCustomer :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | description: An arbitrary string attached to the object. Often useful for displaying to users.
    --
    -- Constraints:
    --
    -- * Maximum length of 1000
    PostPaymentIntentsIntentRequestBody -> Maybe Text
postPaymentIntentsIntentRequestBodyDescription :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | expand: Specifies which fields in the response should be expanded.
    PostPaymentIntentsIntentRequestBody -> Maybe [Text]
postPaymentIntentsIntentRequestBodyExpand :: (GHC.Maybe.Maybe ([Data.Text.Internal.Text])),
    -- | metadata: Set of [key-value pairs](https:\/\/stripe.com\/docs\/api\/metadata) that you can attach to an object. This can be useful for storing additional information about the object in a structured format. Individual keys can be unset by posting an empty value to them. All keys can be unset by posting an empty value to \`metadata\`.
    PostPaymentIntentsIntentRequestBody
-> Maybe PostPaymentIntentsIntentRequestBodyMetadata'Variants
postPaymentIntentsIntentRequestBodyMetadata :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyMetadata'Variants),
    -- | payment_method: ID of the payment method (a PaymentMethod, Card, or [compatible Source](https:\/\/stripe.com\/docs\/payments\/payment-methods\/transitioning\#compatibility) object) to attach to this PaymentIntent.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBody -> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethod :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | payment_method_data: If provided, this hash will be used to create a PaymentMethod. The new PaymentMethod will appear
    -- in the [payment_method](https:\/\/stripe.com\/docs\/api\/payment_intents\/object\#payment_intent_object-payment_method)
    -- property on the PaymentIntent.
    PostPaymentIntentsIntentRequestBody
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'
postPaymentIntentsIntentRequestBodyPaymentMethodData :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'),
    -- | payment_method_options: Payment-method-specific configuration for this PaymentIntent.
    PostPaymentIntentsIntentRequestBody
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'),
    -- | payment_method_types: The list of payment method types (e.g. card) that this PaymentIntent is allowed to use.
    PostPaymentIntentsIntentRequestBody -> Maybe [Text]
postPaymentIntentsIntentRequestBodyPaymentMethodTypes :: (GHC.Maybe.Maybe ([Data.Text.Internal.Text])),
    -- | receipt_email: Email address that the receipt for the resulting payment will be sent to. If \`receipt_email\` is specified for a payment in live mode, a receipt will be sent regardless of your [email settings](https:\/\/dashboard.stripe.com\/account\/emails).
    PostPaymentIntentsIntentRequestBody
-> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
postPaymentIntentsIntentRequestBodyReceiptEmail :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants),
    -- | setup_future_usage: Indicates that you intend to make future payments with this PaymentIntent\'s payment method.
    --
    -- Providing this parameter will [attach the payment method](https:\/\/stripe.com\/docs\/payments\/save-during-payment) to the PaymentIntent\'s Customer, if present, after the PaymentIntent is confirmed and any required actions from the user are complete. If no Customer was provided, the payment method can still be [attached](https:\/\/stripe.com\/docs\/api\/payment_methods\/attach) to a Customer after the transaction completes.
    --
    -- When processing card payments, Stripe also uses \`setup_future_usage\` to dynamically optimize your payment flow and comply with regional legislation and network rules, such as [SCA](https:\/\/stripe.com\/docs\/strong-customer-authentication).
    --
    -- If \`setup_future_usage\` is already set and you are performing a request using a publishable key, you may only update the value from \`on_session\` to \`off_session\`.
    PostPaymentIntentsIntentRequestBody
-> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
postPaymentIntentsIntentRequestBodySetupFutureUsage :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'),
    -- | shipping: Shipping information for this PaymentIntent.
    PostPaymentIntentsIntentRequestBody
-> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
postPaymentIntentsIntentRequestBodyShipping :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants),
    -- | statement_descriptor: For non-card charges, you can use this value as the complete description that appears on your customers’ statements. Must contain at least one letter, maximum 22 characters.
    --
    -- Constraints:
    --
    -- * Maximum length of 22
    PostPaymentIntentsIntentRequestBody -> Maybe Text
postPaymentIntentsIntentRequestBodyStatementDescriptor :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | statement_descriptor_suffix: Provides information about a card payment that customers see on their statements. Concatenated with the prefix (shortened descriptor) or statement descriptor that’s set on the account to form the complete statement descriptor. Maximum 22 characters for the concatenated descriptor.
    --
    -- Constraints:
    --
    -- * Maximum length of 22
    PostPaymentIntentsIntentRequestBody -> Maybe Text
postPaymentIntentsIntentRequestBodyStatementDescriptorSuffix :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | transfer_data: The parameters used to automatically create a Transfer when the payment succeeds. For more information, see the PaymentIntents [use case for connected accounts](https:\/\/stripe.com\/docs\/payments\/connected-accounts).
    PostPaymentIntentsIntentRequestBody
-> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
postPaymentIntentsIntentRequestBodyTransferData :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyTransferData'),
    -- | transfer_group: A string that identifies the resulting payment as part of a group. \`transfer_group\` may only be provided if it has not been set. See the PaymentIntents [use case for connected accounts](https:\/\/stripe.com\/docs\/payments\/connected-accounts) for details.
    PostPaymentIntentsIntentRequestBody -> Maybe Text
postPaymentIntentsIntentRequestBodyTransferGroup :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int -> PostPaymentIntentsIntentRequestBody -> String -> String
[PostPaymentIntentsIntentRequestBody] -> String -> String
PostPaymentIntentsIntentRequestBody -> String
(Int -> PostPaymentIntentsIntentRequestBody -> String -> String)
-> (PostPaymentIntentsIntentRequestBody -> String)
-> ([PostPaymentIntentsIntentRequestBody] -> String -> String)
-> Show PostPaymentIntentsIntentRequestBody
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBody] -> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBody] -> String -> String
show :: PostPaymentIntentsIntentRequestBody -> String
$cshow :: PostPaymentIntentsIntentRequestBody -> String
showsPrec :: Int -> PostPaymentIntentsIntentRequestBody -> String -> String
$cshowsPrec :: Int -> PostPaymentIntentsIntentRequestBody -> String -> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBody
-> PostPaymentIntentsIntentRequestBody -> Bool
(PostPaymentIntentsIntentRequestBody
 -> PostPaymentIntentsIntentRequestBody -> Bool)
-> (PostPaymentIntentsIntentRequestBody
    -> PostPaymentIntentsIntentRequestBody -> Bool)
-> Eq PostPaymentIntentsIntentRequestBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBody
-> PostPaymentIntentsIntentRequestBody -> Bool
$c/= :: PostPaymentIntentsIntentRequestBody
-> PostPaymentIntentsIntentRequestBody -> Bool
== :: PostPaymentIntentsIntentRequestBody
-> PostPaymentIntentsIntentRequestBody -> Bool
$c== :: PostPaymentIntentsIntentRequestBody
-> PostPaymentIntentsIntentRequestBody -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBody where
  toJSON :: PostPaymentIntentsIntentRequestBody -> Value
toJSON PostPaymentIntentsIntentRequestBody
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..= PostPaymentIntentsIntentRequestBody -> Maybe Int
postPaymentIntentsIntentRequestBodyAmount PostPaymentIntentsIntentRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"application_fee_amount" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBody
-> Maybe
     PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
postPaymentIntentsIntentRequestBodyApplicationFeeAmount PostPaymentIntentsIntentRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"currency" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBody -> Maybe Text
postPaymentIntentsIntentRequestBodyCurrency PostPaymentIntentsIntentRequestBody
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..= PostPaymentIntentsIntentRequestBody -> Maybe Text
postPaymentIntentsIntentRequestBodyCustomer PostPaymentIntentsIntentRequestBody
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..= PostPaymentIntentsIntentRequestBody -> Maybe Text
postPaymentIntentsIntentRequestBodyDescription PostPaymentIntentsIntentRequestBody
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..= PostPaymentIntentsIntentRequestBody -> Maybe [Text]
postPaymentIntentsIntentRequestBodyExpand PostPaymentIntentsIntentRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"metadata" Text
-> Maybe PostPaymentIntentsIntentRequestBodyMetadata'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBody
-> Maybe PostPaymentIntentsIntentRequestBodyMetadata'Variants
postPaymentIntentsIntentRequestBodyMetadata PostPaymentIntentsIntentRequestBody
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..= PostPaymentIntentsIntentRequestBody -> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethod PostPaymentIntentsIntentRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"payment_method_data" Text
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBody
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'
postPaymentIntentsIntentRequestBodyPaymentMethodData PostPaymentIntentsIntentRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"payment_method_options" Text
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBody
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions PostPaymentIntentsIntentRequestBody
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..= PostPaymentIntentsIntentRequestBody -> Maybe [Text]
postPaymentIntentsIntentRequestBodyPaymentMethodTypes PostPaymentIntentsIntentRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"receipt_email" Text
-> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBody
-> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
postPaymentIntentsIntentRequestBodyReceiptEmail PostPaymentIntentsIntentRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"setup_future_usage" Text
-> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBody
-> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
postPaymentIntentsIntentRequestBodySetupFutureUsage PostPaymentIntentsIntentRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"shipping" Text
-> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBody
-> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
postPaymentIntentsIntentRequestBodyShipping PostPaymentIntentsIntentRequestBody
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..= PostPaymentIntentsIntentRequestBody -> Maybe Text
postPaymentIntentsIntentRequestBodyStatementDescriptor PostPaymentIntentsIntentRequestBody
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..= PostPaymentIntentsIntentRequestBody -> Maybe Text
postPaymentIntentsIntentRequestBodyStatementDescriptorSuffix PostPaymentIntentsIntentRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"transfer_data" Text
-> Maybe PostPaymentIntentsIntentRequestBodyTransferData' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBody
-> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
postPaymentIntentsIntentRequestBodyTransferData PostPaymentIntentsIntentRequestBody
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..= PostPaymentIntentsIntentRequestBody -> Maybe Text
postPaymentIntentsIntentRequestBodyTransferGroup PostPaymentIntentsIntentRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBody -> Encoding
toEncoding PostPaymentIntentsIntentRequestBody
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..= PostPaymentIntentsIntentRequestBody -> Maybe Int
postPaymentIntentsIntentRequestBodyAmount PostPaymentIntentsIntentRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"application_fee_amount" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBody
-> Maybe
     PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
postPaymentIntentsIntentRequestBodyApplicationFeeAmount PostPaymentIntentsIntentRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"currency" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBody -> Maybe Text
postPaymentIntentsIntentRequestBodyCurrency PostPaymentIntentsIntentRequestBody
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..= PostPaymentIntentsIntentRequestBody -> Maybe Text
postPaymentIntentsIntentRequestBodyCustomer PostPaymentIntentsIntentRequestBody
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..= PostPaymentIntentsIntentRequestBody -> Maybe Text
postPaymentIntentsIntentRequestBodyDescription PostPaymentIntentsIntentRequestBody
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..= PostPaymentIntentsIntentRequestBody -> Maybe [Text]
postPaymentIntentsIntentRequestBodyExpand PostPaymentIntentsIntentRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"metadata" Text
-> Maybe PostPaymentIntentsIntentRequestBodyMetadata'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBody
-> Maybe PostPaymentIntentsIntentRequestBodyMetadata'Variants
postPaymentIntentsIntentRequestBodyMetadata PostPaymentIntentsIntentRequestBody
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..= PostPaymentIntentsIntentRequestBody -> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethod PostPaymentIntentsIntentRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"payment_method_data" Text
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBody
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'
postPaymentIntentsIntentRequestBodyPaymentMethodData PostPaymentIntentsIntentRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"payment_method_options" Text
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBody
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions PostPaymentIntentsIntentRequestBody
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..= PostPaymentIntentsIntentRequestBody -> Maybe [Text]
postPaymentIntentsIntentRequestBodyPaymentMethodTypes PostPaymentIntentsIntentRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"receipt_email" Text
-> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBody
-> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
postPaymentIntentsIntentRequestBodyReceiptEmail PostPaymentIntentsIntentRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"setup_future_usage" Text
-> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBody
-> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
postPaymentIntentsIntentRequestBodySetupFutureUsage PostPaymentIntentsIntentRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"shipping" Text
-> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBody
-> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
postPaymentIntentsIntentRequestBodyShipping PostPaymentIntentsIntentRequestBody
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..= PostPaymentIntentsIntentRequestBody -> Maybe Text
postPaymentIntentsIntentRequestBodyStatementDescriptor PostPaymentIntentsIntentRequestBody
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..= PostPaymentIntentsIntentRequestBody -> Maybe Text
postPaymentIntentsIntentRequestBodyStatementDescriptorSuffix PostPaymentIntentsIntentRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"transfer_data" Text
-> Maybe PostPaymentIntentsIntentRequestBodyTransferData' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBody
-> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
postPaymentIntentsIntentRequestBodyTransferData PostPaymentIntentsIntentRequestBody
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..= PostPaymentIntentsIntentRequestBody -> Maybe Text
postPaymentIntentsIntentRequestBodyTransferGroup PostPaymentIntentsIntentRequestBody
obj))))))))))))))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBody where
  parseJSON :: Value -> Parser PostPaymentIntentsIntentRequestBody
parseJSON = String
-> (Object -> Parser PostPaymentIntentsIntentRequestBody)
-> Value
-> Parser PostPaymentIntentsIntentRequestBody
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBody" (\Object
obj -> ((((((((((((((((((Maybe Int
 -> Maybe
      PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe PostPaymentIntentsIntentRequestBodyMetadata'Variants
 -> Maybe Text
 -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'
 -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
 -> Maybe [Text]
 -> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
 -> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
 -> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
 -> Maybe Text
 -> Maybe Text
 -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
 -> Maybe Text
 -> PostPaymentIntentsIntentRequestBody)
-> Parser
     (Maybe Int
      -> Maybe
           PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe PostPaymentIntentsIntentRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
      -> Maybe [Text]
      -> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
      -> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
      -> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBody)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Int
-> Maybe
     PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe PostPaymentIntentsIntentRequestBodyMetadata'Variants
-> Maybe Text
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
-> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
-> Maybe Text
-> PostPaymentIntentsIntentRequestBody
PostPaymentIntentsIntentRequestBody Parser
  (Maybe Int
   -> Maybe
        PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe PostPaymentIntentsIntentRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
   -> Maybe [Text]
   -> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
   -> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
   -> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
   -> Maybe Text
   -> PostPaymentIntentsIntentRequestBody)
-> Parser (Maybe Int)
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe PostPaymentIntentsIntentRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
      -> Maybe [Text]
      -> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
      -> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
      -> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBody)
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
  (Maybe
     PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe PostPaymentIntentsIntentRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
   -> Maybe [Text]
   -> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
   -> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
   -> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
   -> Maybe Text
   -> PostPaymentIntentsIntentRequestBody)
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe PostPaymentIntentsIntentRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
      -> Maybe [Text]
      -> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
      -> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
      -> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"application_fee_amount")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe PostPaymentIntentsIntentRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
   -> Maybe [Text]
   -> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
   -> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
   -> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
   -> Maybe Text
   -> PostPaymentIntentsIntentRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe PostPaymentIntentsIntentRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
      -> Maybe [Text]
      -> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
      -> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
      -> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBody)
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
"currency")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe PostPaymentIntentsIntentRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
   -> Maybe [Text]
   -> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
   -> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
   -> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
   -> Maybe Text
   -> PostPaymentIntentsIntentRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Maybe PostPaymentIntentsIntentRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
      -> Maybe [Text]
      -> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
      -> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
      -> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBody)
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 [Text]
   -> Maybe PostPaymentIntentsIntentRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
   -> Maybe [Text]
   -> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
   -> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
   -> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
   -> Maybe Text
   -> PostPaymentIntentsIntentRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text]
      -> Maybe PostPaymentIntentsIntentRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
      -> Maybe [Text]
      -> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
      -> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
      -> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBody)
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 [Text]
   -> Maybe PostPaymentIntentsIntentRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
   -> Maybe [Text]
   -> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
   -> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
   -> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
   -> Maybe Text
   -> PostPaymentIntentsIntentRequestBody)
-> Parser (Maybe [Text])
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
      -> Maybe [Text]
      -> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
      -> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
      -> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBody)
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 PostPaymentIntentsIntentRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
   -> Maybe [Text]
   -> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
   -> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
   -> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
   -> Maybe Text
   -> PostPaymentIntentsIntentRequestBody)
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyMetadata'Variants)
-> Parser
     (Maybe Text
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
      -> Maybe [Text]
      -> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
      -> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
      -> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyMetadata'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"metadata")) Parser
  (Maybe Text
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
   -> Maybe [Text]
   -> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
   -> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
   -> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
   -> Maybe Text
   -> PostPaymentIntentsIntentRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
      -> Maybe [Text]
      -> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
      -> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
      -> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBody)
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 PostPaymentIntentsIntentRequestBodyPaymentMethodData'
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
   -> Maybe [Text]
   -> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
   -> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
   -> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
   -> Maybe Text
   -> PostPaymentIntentsIntentRequestBody)
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData')
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
      -> Maybe [Text]
      -> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
      -> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
      -> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"payment_method_data")) Parser
  (Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
   -> Maybe [Text]
   -> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
   -> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
   -> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
   -> Maybe Text
   -> PostPaymentIntentsIntentRequestBody)
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions')
-> Parser
     (Maybe [Text]
      -> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
      -> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
      -> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"payment_method_options")) Parser
  (Maybe [Text]
   -> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
   -> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
   -> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
   -> Maybe Text
   -> PostPaymentIntentsIntentRequestBody)
-> Parser (Maybe [Text])
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
      -> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
      -> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBody)
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 PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
   -> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
   -> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
   -> Maybe Text
   -> PostPaymentIntentsIntentRequestBody)
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants)
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
      -> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"receipt_email")) Parser
  (Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
   -> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
   -> Maybe Text
   -> PostPaymentIntentsIntentRequestBody)
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage')
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"setup_future_usage")) Parser
  (Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
   -> Maybe Text
   -> PostPaymentIntentsIntentRequestBody)
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"shipping")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
   -> Maybe Text
   -> PostPaymentIntentsIntentRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBody)
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 PostPaymentIntentsIntentRequestBodyTransferData'
   -> Maybe Text
   -> PostPaymentIntentsIntentRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyTransferData'
      -> Maybe Text -> PostPaymentIntentsIntentRequestBody)
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 PostPaymentIntentsIntentRequestBodyTransferData'
   -> Maybe Text -> PostPaymentIntentsIntentRequestBody)
-> Parser (Maybe PostPaymentIntentsIntentRequestBodyTransferData')
-> Parser (Maybe Text -> PostPaymentIntentsIntentRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostPaymentIntentsIntentRequestBodyTransferData')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"transfer_data")) Parser (Maybe Text -> PostPaymentIntentsIntentRequestBody)
-> Parser (Maybe Text)
-> Parser PostPaymentIntentsIntentRequestBody
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"))

-- | Create a new 'PostPaymentIntentsIntentRequestBody' with all required fields.
mkPostPaymentIntentsIntentRequestBody :: PostPaymentIntentsIntentRequestBody
mkPostPaymentIntentsIntentRequestBody :: PostPaymentIntentsIntentRequestBody
mkPostPaymentIntentsIntentRequestBody =
  PostPaymentIntentsIntentRequestBody :: Maybe Int
-> Maybe
     PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe PostPaymentIntentsIntentRequestBodyMetadata'Variants
-> Maybe Text
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe [Text]
-> Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
-> Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
-> Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
-> Maybe Text
-> Maybe Text
-> Maybe PostPaymentIntentsIntentRequestBodyTransferData'
-> Maybe Text
-> PostPaymentIntentsIntentRequestBody
PostPaymentIntentsIntentRequestBody
    { postPaymentIntentsIntentRequestBodyAmount :: Maybe Int
postPaymentIntentsIntentRequestBodyAmount = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyApplicationFeeAmount :: Maybe
  PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
postPaymentIntentsIntentRequestBodyApplicationFeeAmount = Maybe
  PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyCurrency :: Maybe Text
postPaymentIntentsIntentRequestBodyCurrency = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyCustomer :: Maybe Text
postPaymentIntentsIntentRequestBodyCustomer = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyDescription :: Maybe Text
postPaymentIntentsIntentRequestBodyDescription = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyExpand :: Maybe [Text]
postPaymentIntentsIntentRequestBodyExpand = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyMetadata :: Maybe PostPaymentIntentsIntentRequestBodyMetadata'Variants
postPaymentIntentsIntentRequestBodyMetadata = Maybe PostPaymentIntentsIntentRequestBodyMetadata'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethod :: Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethod = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData :: Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'
postPaymentIntentsIntentRequestBodyPaymentMethodData = Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodOptions :: Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions = Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodTypes :: Maybe [Text]
postPaymentIntentsIntentRequestBodyPaymentMethodTypes = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyReceiptEmail :: Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
postPaymentIntentsIntentRequestBodyReceiptEmail = Maybe PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodySetupFutureUsage :: Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
postPaymentIntentsIntentRequestBodySetupFutureUsage = Maybe PostPaymentIntentsIntentRequestBodySetupFutureUsage'
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyShipping :: Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
postPaymentIntentsIntentRequestBodyShipping = Maybe PostPaymentIntentsIntentRequestBodyShipping'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyStatementDescriptor :: Maybe Text
postPaymentIntentsIntentRequestBodyStatementDescriptor = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyStatementDescriptorSuffix :: Maybe Text
postPaymentIntentsIntentRequestBodyStatementDescriptorSuffix = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyTransferData :: Maybe PostPaymentIntentsIntentRequestBodyTransferData'
postPaymentIntentsIntentRequestBodyTransferData = Maybe PostPaymentIntentsIntentRequestBodyTransferData'
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyTransferGroup :: Maybe Text
postPaymentIntentsIntentRequestBodyTransferGroup = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the oneOf schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.application_fee_amount.anyOf@ in the specification.
--
-- The amount of the application fee (if any) that will be requested to be applied to the payment and transferred to the application owner\'s Stripe account. The amount of the application fee collected will be capped at the total payment amount. For more information, see the PaymentIntents [use case for connected accounts](https:\/\/stripe.com\/docs\/payments\/connected-accounts).
data PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
  = -- | Represents the JSON value @""@
    PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'EmptyString
  | PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Int GHC.Types.Int
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
-> String
-> String
[PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants]
-> String -> String
PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants]
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
-> PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
-> Bool
(PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
 -> PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
    -> PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
-> PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
-> PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
-> Bool
== :: PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
-> PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
-> PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants where
  toJSON :: PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
-> Value
toJSON (PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Int Int
a) = Int -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Int
a
  toJSON (PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'EmptyString) = Value
""

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'EmptyString
        | Bool
GHC.Base.otherwise -> case (Int
-> PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Int (Int
 -> PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants)
-> Result Int
-> Result
     PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value -> Result Int
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
  PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
     PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
a -> PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
     PostPaymentIntentsIntentRequestBodyApplicationFeeAmount'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a

-- | Defines the oneOf schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.metadata.anyOf@ in the specification.
--
-- Set of [key-value pairs](https:\/\/stripe.com\/docs\/api\/metadata) that you can attach to an object. This can be useful for storing additional information about the object in a structured format. Individual keys can be unset by posting an empty value to them. All keys can be unset by posting an empty value to \`metadata\`.
data PostPaymentIntentsIntentRequestBodyMetadata'Variants
  = -- | Represents the JSON value @""@
    PostPaymentIntentsIntentRequestBodyMetadata'EmptyString
  | PostPaymentIntentsIntentRequestBodyMetadata'Object Data.Aeson.Types.Internal.Object
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyMetadata'Variants
-> String
-> String
[PostPaymentIntentsIntentRequestBodyMetadata'Variants]
-> String -> String
PostPaymentIntentsIntentRequestBodyMetadata'Variants -> String
(Int
 -> PostPaymentIntentsIntentRequestBodyMetadata'Variants
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyMetadata'Variants -> String)
-> ([PostPaymentIntentsIntentRequestBodyMetadata'Variants]
    -> String -> String)
-> Show PostPaymentIntentsIntentRequestBodyMetadata'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyMetadata'Variants]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyMetadata'Variants]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyMetadata'Variants -> String
$cshow :: PostPaymentIntentsIntentRequestBodyMetadata'Variants -> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyMetadata'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyMetadata'Variants
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyMetadata'Variants
-> PostPaymentIntentsIntentRequestBodyMetadata'Variants -> Bool
(PostPaymentIntentsIntentRequestBodyMetadata'Variants
 -> PostPaymentIntentsIntentRequestBodyMetadata'Variants -> Bool)
-> (PostPaymentIntentsIntentRequestBodyMetadata'Variants
    -> PostPaymentIntentsIntentRequestBodyMetadata'Variants -> Bool)
-> Eq PostPaymentIntentsIntentRequestBodyMetadata'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyMetadata'Variants
-> PostPaymentIntentsIntentRequestBodyMetadata'Variants -> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyMetadata'Variants
-> PostPaymentIntentsIntentRequestBodyMetadata'Variants -> Bool
== :: PostPaymentIntentsIntentRequestBodyMetadata'Variants
-> PostPaymentIntentsIntentRequestBodyMetadata'Variants -> Bool
$c== :: PostPaymentIntentsIntentRequestBodyMetadata'Variants
-> PostPaymentIntentsIntentRequestBodyMetadata'Variants -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyMetadata'Variants where
  toJSON :: PostPaymentIntentsIntentRequestBodyMetadata'Variants -> Value
toJSON (PostPaymentIntentsIntentRequestBodyMetadata'Object Object
a) = Object -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Object
a
  toJSON (PostPaymentIntentsIntentRequestBodyMetadata'Variants
PostPaymentIntentsIntentRequestBodyMetadata'EmptyString) = Value
""

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyMetadata'Variants where
  parseJSON :: Value
-> Parser PostPaymentIntentsIntentRequestBodyMetadata'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsIntentRequestBodyMetadata'Variants
-> Parser PostPaymentIntentsIntentRequestBodyMetadata'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyMetadata'Variants
PostPaymentIntentsIntentRequestBodyMetadata'EmptyString
        | Bool
GHC.Base.otherwise -> case (Object -> PostPaymentIntentsIntentRequestBodyMetadata'Variants
PostPaymentIntentsIntentRequestBodyMetadata'Object (Object -> PostPaymentIntentsIntentRequestBodyMetadata'Variants)
-> Result Object
-> Result PostPaymentIntentsIntentRequestBodyMetadata'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 PostPaymentIntentsIntentRequestBodyMetadata'Variants
-> Result PostPaymentIntentsIntentRequestBodyMetadata'Variants
-> Result PostPaymentIntentsIntentRequestBodyMetadata'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result PostPaymentIntentsIntentRequestBodyMetadata'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostPaymentIntentsIntentRequestBodyMetadata'Variants
a -> PostPaymentIntentsIntentRequestBodyMetadata'Variants
-> Parser PostPaymentIntentsIntentRequestBodyMetadata'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyMetadata'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String
-> Parser PostPaymentIntentsIntentRequestBodyMetadata'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_data@ in the specification.
--
-- If provided, this hash will be used to create a PaymentMethod. The new PaymentMethod will appear
-- in the [payment_method](https:\/\/stripe.com\/docs\/api\/payment_intents\/object\#payment_intent_object-payment_method)
-- property on the PaymentIntent.
data PostPaymentIntentsIntentRequestBodyPaymentMethodData' = PostPaymentIntentsIntentRequestBodyPaymentMethodData'
  { -- | acss_debit
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'),
    -- | afterpay_clearpay
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'AfterpayClearpay :: (GHC.Maybe.Maybe Data.Aeson.Types.Internal.Object),
    -- | alipay
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'Alipay :: (GHC.Maybe.Maybe Data.Aeson.Types.Internal.Object),
    -- | au_becs_debit
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
postPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'),
    -- | bacs_debit
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
postPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'),
    -- | bancontact
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'Bancontact :: (GHC.Maybe.Maybe Data.Aeson.Types.Internal.Object),
    -- | billing_details
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'),
    -- | boleto
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'),
    -- | eps
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Eps :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'),
    -- | fpx
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'),
    -- | giropay
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'Giropay :: (GHC.Maybe.Maybe Data.Aeson.Types.Internal.Object),
    -- | grabpay
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'Grabpay :: (GHC.Maybe.Maybe Data.Aeson.Types.Internal.Object),
    -- | ideal
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'),
    -- | interac_present
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'InteracPresent :: (GHC.Maybe.Maybe Data.Aeson.Types.Internal.Object),
    -- | metadata
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'Metadata :: (GHC.Maybe.Maybe Data.Aeson.Types.Internal.Object),
    -- | oxxo
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'Oxxo :: (GHC.Maybe.Maybe Data.Aeson.Types.Internal.Object),
    -- | p24
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
postPaymentIntentsIntentRequestBodyPaymentMethodData'P24 :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'),
    -- | sepa_debit
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
postPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'),
    -- | sofort
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'),
    -- | type
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Type :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodData']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodData' -> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodData']
    -> String -> String)
-> Show PostPaymentIntentsIntentRequestBodyPaymentMethodData'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodData' -> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodData' -> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData' -> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodData'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData' -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodData' -> Bool)
-> Eq PostPaymentIntentsIntentRequestBodyPaymentMethodData'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData' -> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData' -> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData' -> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData' -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodData' -> Value
toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"acss_debit" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit PostPaymentIntentsIntentRequestBodyPaymentMethodData'
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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'AfterpayClearpay PostPaymentIntentsIntentRequestBodyPaymentMethodData'
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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'Alipay PostPaymentIntentsIntentRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"au_becs_debit" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
postPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit PostPaymentIntentsIntentRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"bacs_debit" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
postPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit PostPaymentIntentsIntentRequestBodyPaymentMethodData'
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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'Bancontact PostPaymentIntentsIntentRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"billing_details" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails PostPaymentIntentsIntentRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"boleto" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto PostPaymentIntentsIntentRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"eps" Text
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Eps PostPaymentIntentsIntentRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"fpx" Text
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx PostPaymentIntentsIntentRequestBodyPaymentMethodData'
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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'Giropay PostPaymentIntentsIntentRequestBodyPaymentMethodData'
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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'Grabpay PostPaymentIntentsIntentRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"ideal" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal PostPaymentIntentsIntentRequestBodyPaymentMethodData'
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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'InteracPresent PostPaymentIntentsIntentRequestBodyPaymentMethodData'
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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'Metadata PostPaymentIntentsIntentRequestBodyPaymentMethodData'
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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'Oxxo PostPaymentIntentsIntentRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"p24" Text
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
postPaymentIntentsIntentRequestBodyPaymentMethodData'P24 PostPaymentIntentsIntentRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"sepa_debit" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
postPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit PostPaymentIntentsIntentRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"sofort" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort PostPaymentIntentsIntentRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"type" Text
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Type PostPaymentIntentsIntentRequestBodyPaymentMethodData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyPaymentMethodData' -> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyPaymentMethodData'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"acss_debit" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit PostPaymentIntentsIntentRequestBodyPaymentMethodData'
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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'AfterpayClearpay PostPaymentIntentsIntentRequestBodyPaymentMethodData'
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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'Alipay PostPaymentIntentsIntentRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"au_becs_debit" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
postPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit PostPaymentIntentsIntentRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"bacs_debit" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
postPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit PostPaymentIntentsIntentRequestBodyPaymentMethodData'
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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'Bancontact PostPaymentIntentsIntentRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"billing_details" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails PostPaymentIntentsIntentRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"boleto" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto PostPaymentIntentsIntentRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"eps" Text
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Eps PostPaymentIntentsIntentRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"fpx" Text
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx PostPaymentIntentsIntentRequestBodyPaymentMethodData'
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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'Giropay PostPaymentIntentsIntentRequestBodyPaymentMethodData'
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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'Grabpay PostPaymentIntentsIntentRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"ideal" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal PostPaymentIntentsIntentRequestBodyPaymentMethodData'
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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'InteracPresent PostPaymentIntentsIntentRequestBodyPaymentMethodData'
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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'Metadata PostPaymentIntentsIntentRequestBodyPaymentMethodData'
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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'Oxxo PostPaymentIntentsIntentRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"p24" Text
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
postPaymentIntentsIntentRequestBodyPaymentMethodData'P24 PostPaymentIntentsIntentRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"sepa_debit" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
postPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit PostPaymentIntentsIntentRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"sofort" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort PostPaymentIntentsIntentRequestBodyPaymentMethodData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"type" Text
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Type PostPaymentIntentsIntentRequestBodyPaymentMethodData'
obj))))))))))))))))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData' where
  parseJSON :: Value
-> Parser PostPaymentIntentsIntentRequestBodyPaymentMethodData'
parseJSON = String
-> (Object
    -> Parser PostPaymentIntentsIntentRequestBodyPaymentMethodData')
-> Value
-> Parser PostPaymentIntentsIntentRequestBodyPaymentMethodData'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyPaymentMethodData'" (\Object
obj -> ((((((((((((((((((((Maybe
   PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
 -> Maybe Object
 -> Maybe Object
 -> Maybe
      PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
 -> Maybe
      PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
 -> Maybe Object
 -> Maybe
      PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
 -> Maybe
      PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
 -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
 -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
 -> Maybe Object
 -> Maybe Object
 -> Maybe
      PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
 -> Maybe Object
 -> Maybe Object
 -> Maybe Object
 -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
 -> Maybe
      PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
 -> Maybe
      PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
      -> Maybe Object
      -> Maybe Object
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
      -> Maybe Object
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
      -> Maybe Object
      -> Maybe Object
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
      -> Maybe Object
      -> Maybe Object
      -> Maybe Object
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> Maybe Object
-> Maybe Object
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> Maybe Object
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
-> Maybe Object
-> Maybe Object
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'
PostPaymentIntentsIntentRequestBodyPaymentMethodData' Parser
  (Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
   -> Maybe Object
   -> Maybe Object
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
   -> Maybe Object
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
   -> Maybe Object
   -> Maybe Object
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
   -> Maybe Object
   -> Maybe Object
   -> Maybe Object
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit')
-> Parser
     (Maybe Object
      -> Maybe Object
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
      -> Maybe Object
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
      -> Maybe Object
      -> Maybe Object
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
      -> Maybe Object
      -> Maybe Object
      -> Maybe Object
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"acss_debit")) Parser
  (Maybe Object
   -> Maybe Object
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
   -> Maybe Object
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
   -> Maybe Object
   -> Maybe Object
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
   -> Maybe Object
   -> Maybe Object
   -> Maybe Object
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
-> Parser (Maybe Object)
-> Parser
     (Maybe Object
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
      -> Maybe Object
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
      -> Maybe Object
      -> Maybe Object
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
      -> Maybe Object
      -> Maybe Object
      -> Maybe Object
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
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
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
   -> Maybe Object
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
   -> Maybe Object
   -> Maybe Object
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
   -> Maybe Object
   -> Maybe Object
   -> Maybe Object
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
-> Parser (Maybe Object)
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
      -> Maybe Object
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
      -> Maybe Object
      -> Maybe Object
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
      -> Maybe Object
      -> Maybe Object
      -> Maybe Object
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
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
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
   -> Maybe Object
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
   -> Maybe Object
   -> Maybe Object
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
   -> Maybe Object
   -> Maybe Object
   -> Maybe Object
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
      -> Maybe Object
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
      -> Maybe Object
      -> Maybe Object
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
      -> Maybe Object
      -> Maybe Object
      -> Maybe Object
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"au_becs_debit")) Parser
  (Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
   -> Maybe Object
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
   -> Maybe Object
   -> Maybe Object
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
   -> Maybe Object
   -> Maybe Object
   -> Maybe Object
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit')
-> Parser
     (Maybe Object
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
      -> Maybe Object
      -> Maybe Object
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
      -> Maybe Object
      -> Maybe Object
      -> Maybe Object
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"bacs_debit")) Parser
  (Maybe Object
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
   -> Maybe Object
   -> Maybe Object
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
   -> Maybe Object
   -> Maybe Object
   -> Maybe Object
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
-> Parser (Maybe Object)
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
      -> Maybe Object
      -> Maybe Object
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
      -> Maybe Object
      -> Maybe Object
      -> Maybe Object
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
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
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
   -> Maybe Object
   -> Maybe Object
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
   -> Maybe Object
   -> Maybe Object
   -> Maybe Object
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails')
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
      -> Maybe Object
      -> Maybe Object
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
      -> Maybe Object
      -> Maybe Object
      -> Maybe Object
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"billing_details")) Parser
  (Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
   -> Maybe Object
   -> Maybe Object
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
   -> Maybe Object
   -> Maybe Object
   -> Maybe Object
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto')
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
      -> Maybe Object
      -> Maybe Object
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
      -> Maybe Object
      -> Maybe Object
      -> Maybe Object
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"boleto")) Parser
  (Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
   -> Maybe Object
   -> Maybe Object
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
   -> Maybe Object
   -> Maybe Object
   -> Maybe Object
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps')
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
      -> Maybe Object
      -> Maybe Object
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
      -> Maybe Object
      -> Maybe Object
      -> Maybe Object
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"eps")) Parser
  (Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
   -> Maybe Object
   -> Maybe Object
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
   -> Maybe Object
   -> Maybe Object
   -> Maybe Object
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx')
-> Parser
     (Maybe Object
      -> Maybe Object
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
      -> Maybe Object
      -> Maybe Object
      -> Maybe Object
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"fpx")) Parser
  (Maybe Object
   -> Maybe Object
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
   -> Maybe Object
   -> Maybe Object
   -> Maybe Object
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
-> Parser (Maybe Object)
-> Parser
     (Maybe Object
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
      -> Maybe Object
      -> Maybe Object
      -> Maybe Object
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
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
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
   -> Maybe Object
   -> Maybe Object
   -> Maybe Object
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
-> Parser (Maybe Object)
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
      -> Maybe Object
      -> Maybe Object
      -> Maybe Object
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
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 PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
   -> Maybe Object
   -> Maybe Object
   -> Maybe Object
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal')
-> Parser
     (Maybe Object
      -> Maybe Object
      -> Maybe Object
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"ideal")) Parser
  (Maybe Object
   -> Maybe Object
   -> Maybe Object
   -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
-> Parser (Maybe Object)
-> Parser
     (Maybe Object
      -> Maybe Object
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
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 PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
-> Parser (Maybe Object)
-> Parser
     (Maybe Object
      -> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
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 PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
-> Parser (Maybe Object)
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
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 PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"p24")) Parser
  (Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit')
-> Parser
     (Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"sepa_debit")) Parser
  (Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort')
-> Parser
     (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"sofort")) Parser
  (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData')
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
-> Parser PostPaymentIntentsIntentRequestBodyPaymentMethodData'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"type"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyPaymentMethodData'' with all required fields.
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData' ::
  -- | 'postPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type' ->
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData' :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData' PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Type =
  PostPaymentIntentsIntentRequestBodyPaymentMethodData' :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> Maybe Object
-> Maybe Object
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> Maybe Object
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
-> Maybe Object
-> Maybe Object
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
-> Maybe Object
-> Maybe Object
-> Maybe Object
-> Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'
    { postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'AfterpayClearpay :: Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'AfterpayClearpay = Maybe Object
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'Alipay :: Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'Alipay = Maybe Object
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
postPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
postPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'Bancontact :: Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'Bancontact = Maybe Object
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto :: Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto = Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'Eps :: Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Eps = Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx :: Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx = Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'Giropay :: Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'Giropay = Maybe Object
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'Grabpay :: Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'Grabpay = Maybe Object
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal :: Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal = Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'InteracPresent :: Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'InteracPresent = Maybe Object
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'Metadata :: Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'Metadata = Maybe Object
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'Oxxo :: Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodData'Oxxo = Maybe Object
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'P24 :: Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
postPaymentIntentsIntentRequestBodyPaymentMethodData'P24 = Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
postPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort :: Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort = Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'Type :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Type = PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Type
    }

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_data.properties.acss_debit@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit' = PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
  { -- | account_number
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'AccountNumber :: Data.Text.Internal.Text,
    -- | institution_number
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'InstitutionNumber :: Data.Text.Internal.Text,
    -- | transit_number
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'TransitNumber :: Data.Text.Internal.Text
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit']
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> Value
toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'AccountNumber PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'InstitutionNumber PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'TransitNumber PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'AccountNumber PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'InstitutionNumber PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
-> Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'TransitNumber PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
obj)))

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit' where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
parseJSON = String
-> (Object
    -> Parser
         PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit')
-> Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'" (\Object
obj -> (((Text
 -> Text
 -> Text
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit')
-> Parser
     (Text
      -> Text
      -> Text
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Text
-> Text
-> Text
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit' Parser
  (Text
   -> Text
   -> Text
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit')
-> Parser Text
-> Parser
     (Text
      -> Text
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'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
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit')
-> Parser Text
-> Parser
     (Text
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'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
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit')
-> Parser Text
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'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"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'' with all required fields.
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit' ::
  -- | 'postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'AccountNumber'
  Data.Text.Internal.Text ->
  -- | 'postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'InstitutionNumber'
  Data.Text.Internal.Text ->
  -- | 'postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'TransitNumber'
  Data.Text.Internal.Text ->
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit' :: Text
-> Text
-> Text
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit' Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'AccountNumber Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'InstitutionNumber Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'TransitNumber =
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit' :: Text
-> Text
-> Text
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'
    { postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'AccountNumber :: Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'AccountNumber = Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'AccountNumber,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'InstitutionNumber :: Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'InstitutionNumber = Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'InstitutionNumber,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'TransitNumber :: Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'TransitNumber = Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AcssDebit'TransitNumber
    }

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_data.properties.au_becs_debit@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit' = PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
  { -- | account_number
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'AccountNumber :: Data.Text.Internal.Text,
    -- | bsb_number
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'BsbNumber :: Data.Text.Internal.Text
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit']
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> Value
toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'AccountNumber PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'BsbNumber PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'AccountNumber PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
-> Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'BsbNumber PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
obj))

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit' where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
parseJSON = String
-> (Object
    -> Parser
         PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit')
-> Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'" (\Object
obj -> ((Text
 -> Text
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit')
-> Parser
     (Text
      -> Text
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Text
-> Text
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit' Parser
  (Text
   -> Text
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit')
-> Parser Text
-> Parser
     (Text
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'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
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit')
-> Parser Text
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'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"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'' with all required fields.
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit' ::
  -- | 'postPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'AccountNumber'
  Data.Text.Internal.Text ->
  -- | 'postPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'BsbNumber'
  Data.Text.Internal.Text ->
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit' :: Text
-> Text
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit' Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'AccountNumber Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'BsbNumber =
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit' :: Text
-> Text
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'
    { postPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'AccountNumber :: Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'AccountNumber = Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'AccountNumber,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'BsbNumber :: Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'BsbNumber = Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'AuBecsDebit'BsbNumber
    }

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_data.properties.bacs_debit@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit' = PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
  { -- | account_number
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'AccountNumber :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | sort_code
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'SortCode :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit']
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> Value
toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'AccountNumber PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'SortCode PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'AccountNumber PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'SortCode PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
obj))

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit' where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
parseJSON = String
-> (Object
    -> Parser
         PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit')
-> Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'" (\Object
obj -> ((Maybe Text
 -> Maybe Text
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit')
-> Parser
     (Maybe Text
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe Text
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit' Parser
  (Maybe Text
   -> Maybe Text
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'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
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit')
-> Parser (Maybe Text)
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'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"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'' with all required fields.
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit' :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit' :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit' =
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit' :: Maybe Text
-> Maybe Text
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'
    { postPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'AccountNumber :: Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'AccountNumber = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'SortCode :: Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BacsDebit'SortCode = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_data.properties.billing_details@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails' = PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
  { -- | address
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants),
    -- | email
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Email :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | name
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Name :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | phone
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Phone :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails']
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> Value
toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"address" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Email PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Name PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Phone PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"address" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Email PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Name PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Phone PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
obj))))

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails' where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
parseJSON = String
-> (Object
    -> Parser
         PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails')
-> Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'" (\Object
obj -> ((((Maybe
   PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails' Parser
  (Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'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
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'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
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'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
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails')
-> Parser (Maybe Text)
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'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"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'' with all required fields.
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails' :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails' :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails' =
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails' :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'
    { postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Email :: Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Email = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Name :: Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Name = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Phone :: Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Phone = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_data.properties.billing_details.properties.address.anyOf@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1 = PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
  { -- | city
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1City :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | country
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Country :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | line1
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Line1 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | line2
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Line2 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | postal_code
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1PostalCode :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | state
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1State :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1]
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1]
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1 where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Value
toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1City PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Country PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Line1 PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Line2 PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1PostalCode PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1State PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1City PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Country PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Line1 PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Line2 PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1PostalCode PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1State PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
obj))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1 where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
parseJSON = String
-> (Object
    -> Parser
         PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1)
-> Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1" (\Object
obj -> ((((((Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'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
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1 Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'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
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'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
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'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
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'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
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'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
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1)
-> Parser (Maybe Text)
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'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"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1' with all required fields.
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1 :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1 :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1 =
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1 :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
    { postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1City :: Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1City = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Country :: Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Country = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Line1 :: Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Line1 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Line2 :: Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1Line2 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1PostalCode :: Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1PostalCode = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1State :: Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1State = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the oneOf schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_data.properties.billing_details.properties.address.anyOf@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
  = -- | Represents the JSON value @""@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'EmptyString
  | PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1 PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants]
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants]
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Value
toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1 PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
a) = PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
a
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'EmptyString) = Value
""

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'EmptyString
        | Bool
GHC.Base.otherwise -> case (PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1 (PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants)
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
a -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'BillingDetails'Address'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_data.properties.boleto@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto' = PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
  { -- | tax_id
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
-> Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'TaxId :: Data.Text.Internal.Text
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto']
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
    -> Bool)
-> Eq PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
-> Value
toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
-> Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'TaxId PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
-> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
-> Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'TaxId PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
obj)

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto' where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
parseJSON = String
-> (Object
    -> Parser
         PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto')
-> Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'" (\Object
obj -> (Text
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto')
-> Parser
     (Text
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Text
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto' Parser
  (Text
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto')
-> Parser Text
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'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"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'' with all required fields.
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto' ::
  -- | 'postPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'TaxId'
  Data.Text.Internal.Text ->
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto' :: Text
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto' Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'TaxId = PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto' :: Text
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto' {postPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'TaxId :: Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'TaxId = Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'Boleto'TaxId}

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_data.properties.eps@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps' = PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
  { -- | bank
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank')
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps' -> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps']
    -> String -> String)
-> Show PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps' -> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps' -> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
    -> Bool)
-> Eq PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps' -> Value
toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"bank" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
-> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs (Text
"bank" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
obj)

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps' where
  parseJSON :: Value
-> Parser PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
parseJSON = String
-> (Object
    -> Parser
         PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps')
-> Value
-> Parser PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'" (\Object
obj -> (Maybe
   PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps' Parser
  (Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank')
-> Parser PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"bank"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'' with all required fields.
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps' :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps' :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps' = PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps' :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps' {postPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
forall a. Maybe a
GHC.Maybe.Nothing}

-- | Defines the enum schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_data.properties.eps.properties.bank@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'Other Data.Aeson.Types.Internal.Value
  | -- | This constructor can be used to send values to the server which are not present in the specification yet.
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"arzte_und_apotheker_bank"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumArzteUndApothekerBank
  | -- | Represents the JSON value @"austrian_anadi_bank_ag"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumAustrianAnadiBankAg
  | -- | Represents the JSON value @"bank_austria"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumBankAustria
  | -- | Represents the JSON value @"bankhaus_carl_spangler"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumBankhausCarlSpangler
  | -- | Represents the JSON value @"bankhaus_schelhammer_und_schattera_ag"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumBankhausSchelhammerUndSchatteraAg
  | -- | Represents the JSON value @"bawag_psk_ag"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumBawagPskAg
  | -- | Represents the JSON value @"bks_bank_ag"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumBksBankAg
  | -- | Represents the JSON value @"brull_kallmus_bank_ag"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumBrullKallmusBankAg
  | -- | Represents the JSON value @"btv_vier_lander_bank"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumBtvVierLanderBank
  | -- | Represents the JSON value @"capital_bank_grawe_gruppe_ag"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumCapitalBankGraweGruppeAg
  | -- | Represents the JSON value @"dolomitenbank"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumDolomitenbank
  | -- | Represents the JSON value @"easybank_ag"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumEasybankAg
  | -- | Represents the JSON value @"erste_bank_und_sparkassen"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumErsteBankUndSparkassen
  | -- | Represents the JSON value @"hypo_alpeadriabank_international_ag"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumHypoAlpeadriabankInternationalAg
  | -- | Represents the JSON value @"hypo_bank_burgenland_aktiengesellschaft"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumHypoBankBurgenlandAktiengesellschaft
  | -- | Represents the JSON value @"hypo_noe_lb_fur_niederosterreich_u_wien"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumHypoNoeLbFurNiederosterreichUWien
  | -- | Represents the JSON value @"hypo_oberosterreich_salzburg_steiermark"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumHypoOberosterreichSalzburgSteiermark
  | -- | Represents the JSON value @"hypo_tirol_bank_ag"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumHypoTirolBankAg
  | -- | Represents the JSON value @"hypo_vorarlberg_bank_ag"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumHypoVorarlbergBankAg
  | -- | Represents the JSON value @"marchfelder_bank"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumMarchfelderBank
  | -- | Represents the JSON value @"oberbank_ag"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumOberbankAg
  | -- | Represents the JSON value @"raiffeisen_bankengruppe_osterreich"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumRaiffeisenBankengruppeOsterreich
  | -- | Represents the JSON value @"schoellerbank_ag"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumSchoellerbankAg
  | -- | Represents the JSON value @"sparda_bank_wien"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumSpardaBankWien
  | -- | Represents the JSON value @"volksbank_gruppe"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumVolksbankGruppe
  | -- | Represents the JSON value @"volkskreditbank_ag"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumVolkskreditbankAg
  | -- | Represents the JSON value @"vr_bank_braunau"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumVrBankBraunau
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank']
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
-> Value
toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'Other Value
val) = Value
val
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumArzteUndApothekerBank) = Value
"arzte_und_apotheker_bank"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumAustrianAnadiBankAg) = Value
"austrian_anadi_bank_ag"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumBankAustria) = Value
"bank_austria"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumBankhausCarlSpangler) = Value
"bankhaus_carl_spangler"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumBankhausSchelhammerUndSchatteraAg) = Value
"bankhaus_schelhammer_und_schattera_ag"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumBawagPskAg) = Value
"bawag_psk_ag"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumBksBankAg) = Value
"bks_bank_ag"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumBrullKallmusBankAg) = Value
"brull_kallmus_bank_ag"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumBtvVierLanderBank) = Value
"btv_vier_lander_bank"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumCapitalBankGraweGruppeAg) = Value
"capital_bank_grawe_gruppe_ag"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumDolomitenbank) = Value
"dolomitenbank"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumEasybankAg) = Value
"easybank_ag"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumErsteBankUndSparkassen) = Value
"erste_bank_und_sparkassen"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumHypoAlpeadriabankInternationalAg) = Value
"hypo_alpeadriabank_international_ag"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumHypoBankBurgenlandAktiengesellschaft) = Value
"hypo_bank_burgenland_aktiengesellschaft"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumHypoNoeLbFurNiederosterreichUWien) = Value
"hypo_noe_lb_fur_niederosterreich_u_wien"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumHypoOberosterreichSalzburgSteiermark) = Value
"hypo_oberosterreich_salzburg_steiermark"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumHypoTirolBankAg) = Value
"hypo_tirol_bank_ag"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumHypoVorarlbergBankAg) = Value
"hypo_vorarlberg_bank_ag"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumMarchfelderBank) = Value
"marchfelder_bank"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumOberbankAg) = Value
"oberbank_ag"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumRaiffeisenBankengruppeOsterreich) = Value
"raiffeisen_bankengruppe_osterreich"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumSchoellerbankAg) = Value
"schoellerbank_ag"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumSpardaBankWien) = Value
"sparda_bank_wien"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumVolksbankGruppe) = Value
"volksbank_gruppe"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumVolkskreditbankAg) = Value
"volkskreditbank_ag"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumVrBankBraunau) = Value
"vr_bank_braunau"

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank' where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
parseJSON Value
val =
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'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" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumArzteUndApothekerBank
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"austrian_anadi_bank_ag" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumAustrianAnadiBankAg
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bank_austria" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumBankAustria
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bankhaus_carl_spangler" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumBankhausCarlSpangler
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bankhaus_schelhammer_und_schattera_ag" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumBankhausSchelhammerUndSchatteraAg
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bawag_psk_ag" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumBawagPskAg
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bks_bank_ag" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumBksBankAg
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"brull_kallmus_bank_ag" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumBrullKallmusBankAg
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"btv_vier_lander_bank" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumBtvVierLanderBank
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"capital_bank_grawe_gruppe_ag" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumCapitalBankGraweGruppeAg
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"dolomitenbank" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumDolomitenbank
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"easybank_ag" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumEasybankAg
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"erste_bank_und_sparkassen" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumErsteBankUndSparkassen
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"hypo_alpeadriabank_international_ag" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumHypoAlpeadriabankInternationalAg
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"hypo_bank_burgenland_aktiengesellschaft" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'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" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumHypoNoeLbFurNiederosterreichUWien
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"hypo_oberosterreich_salzburg_steiermark" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumHypoOberosterreichSalzburgSteiermark
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"hypo_tirol_bank_ag" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumHypoTirolBankAg
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"hypo_vorarlberg_bank_ag" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumHypoVorarlbergBankAg
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"marchfelder_bank" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumMarchfelderBank
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"oberbank_ag" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumOberbankAg
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"raiffeisen_bankengruppe_osterreich" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumRaiffeisenBankengruppeOsterreich
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"schoellerbank_ag" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumSchoellerbankAg
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"sparda_bank_wien" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumSpardaBankWien
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"volksbank_gruppe" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumVolksbankGruppe
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"volkskreditbank_ag" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumVolkskreditbankAg
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"vr_bank_braunau" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'EnumVrBankBraunau
            | Bool
GHC.Base.otherwise -> Value
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Eps'Bank'Other Value
val
      )

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_data.properties.fpx@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx' = PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
  { -- | bank
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx' -> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx']
    -> String -> String)
-> Show PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx' -> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx' -> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
    -> Bool)
-> Eq PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx' -> Value
toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"bank" Text
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
-> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs (Text
"bank" Text
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
obj)

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx' where
  parseJSON :: Value
-> Parser PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
parseJSON = String
-> (Object
    -> Parser
         PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx')
-> Value
-> Parser PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'" (\Object
obj -> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx')
-> Parser
     (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx' Parser
  (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx')
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
-> Parser PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"bank"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'' with all required fields.
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx' ::
  -- | 'postPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank' ->
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx' :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx' PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank = PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx' :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx' {postPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank = PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank}

-- | Defines the enum schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_data.properties.fpx.properties.bank@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'Other Data.Aeson.Types.Internal.Value
  | -- | This constructor can be used to send values to the server which are not present in the specification yet.
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"affin_bank"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumAffinBank
  | -- | Represents the JSON value @"alliance_bank"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumAllianceBank
  | -- | Represents the JSON value @"ambank"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumAmbank
  | -- | Represents the JSON value @"bank_islam"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumBankIslam
  | -- | Represents the JSON value @"bank_muamalat"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumBankMuamalat
  | -- | Represents the JSON value @"bank_rakyat"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumBankRakyat
  | -- | Represents the JSON value @"bsn"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumBsn
  | -- | Represents the JSON value @"cimb"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumCimb
  | -- | Represents the JSON value @"deutsche_bank"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumDeutscheBank
  | -- | Represents the JSON value @"hong_leong_bank"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumHongLeongBank
  | -- | Represents the JSON value @"hsbc"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumHsbc
  | -- | Represents the JSON value @"kfh"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumKfh
  | -- | Represents the JSON value @"maybank2e"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumMaybank2e
  | -- | Represents the JSON value @"maybank2u"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumMaybank2u
  | -- | Represents the JSON value @"ocbc"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumOcbc
  | -- | Represents the JSON value @"pb_enterprise"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumPbEnterprise
  | -- | Represents the JSON value @"public_bank"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumPublicBank
  | -- | Represents the JSON value @"rhb"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumRhb
  | -- | Represents the JSON value @"standard_chartered"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumStandardChartered
  | -- | Represents the JSON value @"uob"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumUob
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank']
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
-> Value
toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'Other Value
val) = Value
val
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumAffinBank) = Value
"affin_bank"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumAllianceBank) = Value
"alliance_bank"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumAmbank) = Value
"ambank"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumBankIslam) = Value
"bank_islam"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumBankMuamalat) = Value
"bank_muamalat"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumBankRakyat) = Value
"bank_rakyat"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumBsn) = Value
"bsn"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumCimb) = Value
"cimb"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumDeutscheBank) = Value
"deutsche_bank"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumHongLeongBank) = Value
"hong_leong_bank"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumHsbc) = Value
"hsbc"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumKfh) = Value
"kfh"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumMaybank2e) = Value
"maybank2e"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumMaybank2u) = Value
"maybank2u"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumOcbc) = Value
"ocbc"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumPbEnterprise) = Value
"pb_enterprise"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumPublicBank) = Value
"public_bank"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumRhb) = Value
"rhb"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumStandardChartered) = Value
"standard_chartered"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumUob) = Value
"uob"

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank' where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
parseJSON Value
val =
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'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" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumAffinBank
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"alliance_bank" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumAllianceBank
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ambank" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumAmbank
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bank_islam" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumBankIslam
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bank_muamalat" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumBankMuamalat
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bank_rakyat" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumBankRakyat
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bsn" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumBsn
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"cimb" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumCimb
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"deutsche_bank" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumDeutscheBank
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"hong_leong_bank" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumHongLeongBank
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"hsbc" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumHsbc
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"kfh" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumKfh
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"maybank2e" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumMaybank2e
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"maybank2u" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumMaybank2u
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ocbc" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumOcbc
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"pb_enterprise" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumPbEnterprise
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"public_bank" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumPublicBank
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"rhb" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumRhb
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"standard_chartered" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumStandardChartered
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"uob" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'EnumUob
            | Bool
GHC.Base.otherwise -> Value
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Fpx'Bank'Other Value
val
      )

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_data.properties.ideal@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal' = PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
  { -- | bank
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank')
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal']
    -> String -> String)
-> Show PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
    -> Bool)
-> Eq PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
-> Value
toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"bank" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
-> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs (Text
"bank" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
obj)

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal' where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
parseJSON = String
-> (Object
    -> Parser
         PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal')
-> Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'" (\Object
obj -> (Maybe
   PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal' Parser
  (Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank')
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"bank"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'' with all required fields.
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal' :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal' :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal' = PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal' :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal' {postPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
forall a. Maybe a
GHC.Maybe.Nothing}

-- | Defines the enum schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_data.properties.ideal.properties.bank@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'Other Data.Aeson.Types.Internal.Value
  | -- | This constructor can be used to send values to the server which are not present in the specification yet.
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"abn_amro"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumAbnAmro
  | -- | Represents the JSON value @"asn_bank"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumAsnBank
  | -- | Represents the JSON value @"bunq"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumBunq
  | -- | Represents the JSON value @"handelsbanken"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumHandelsbanken
  | -- | Represents the JSON value @"ing"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumIng
  | -- | Represents the JSON value @"knab"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumKnab
  | -- | Represents the JSON value @"moneyou"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumMoneyou
  | -- | Represents the JSON value @"rabobank"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumRabobank
  | -- | Represents the JSON value @"regiobank"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumRegiobank
  | -- | Represents the JSON value @"revolut"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumRevolut
  | -- | Represents the JSON value @"sns_bank"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumSnsBank
  | -- | Represents the JSON value @"triodos_bank"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumTriodosBank
  | -- | Represents the JSON value @"van_lanschot"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumVanLanschot
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank']
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
-> Value
toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'Other Value
val) = Value
val
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumAbnAmro) = Value
"abn_amro"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumAsnBank) = Value
"asn_bank"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumBunq) = Value
"bunq"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumHandelsbanken) = Value
"handelsbanken"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumIng) = Value
"ing"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumKnab) = Value
"knab"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumMoneyou) = Value
"moneyou"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumRabobank) = Value
"rabobank"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumRegiobank) = Value
"regiobank"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumRevolut) = Value
"revolut"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumSnsBank) = Value
"sns_bank"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumTriodosBank) = Value
"triodos_bank"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumVanLanschot) = Value
"van_lanschot"

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank' where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
parseJSON Value
val =
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'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" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumAbnAmro
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"asn_bank" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumAsnBank
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bunq" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumBunq
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"handelsbanken" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumHandelsbanken
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ing" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumIng
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"knab" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumKnab
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"moneyou" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumMoneyou
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"rabobank" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumRabobank
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"regiobank" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumRegiobank
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"revolut" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumRevolut
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"sns_bank" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumSnsBank
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"triodos_bank" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumTriodosBank
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"van_lanschot" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'EnumVanLanschot
            | Bool
GHC.Base.otherwise -> Value
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Ideal'Bank'Other Value
val
      )

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_data.properties.p24@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24' = PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
  { -- | bank
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
postPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank')
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24' -> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24']
    -> String -> String)
-> Show PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24' -> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24' -> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
    -> Bool)
-> Eq PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24' -> Value
toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"bank" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
postPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
-> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs (Text
"bank" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
postPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
obj)

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24' where
  parseJSON :: Value
-> Parser PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
parseJSON = String
-> (Object
    -> Parser
         PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24')
-> Value
-> Parser PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'" (\Object
obj -> (Maybe
   PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24' Parser
  (Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank')
-> Parser PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"bank"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'' with all required fields.
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'P24' :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'P24' :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'P24' = PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24' :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24' {postPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
postPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
forall a. Maybe a
GHC.Maybe.Nothing}

-- | Defines the enum schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_data.properties.p24.properties.bank@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'Other Data.Aeson.Types.Internal.Value
  | -- | This constructor can be used to send values to the server which are not present in the specification yet.
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"alior_bank"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumAliorBank
  | -- | Represents the JSON value @"bank_millennium"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumBankMillennium
  | -- | Represents the JSON value @"bank_nowy_bfg_sa"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumBankNowyBfgSa
  | -- | Represents the JSON value @"bank_pekao_sa"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumBankPekaoSa
  | -- | Represents the JSON value @"banki_spbdzielcze"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumBankiSpbdzielcze
  | -- | Represents the JSON value @"blik"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumBlik
  | -- | Represents the JSON value @"bnp_paribas"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumBnpParibas
  | -- | Represents the JSON value @"boz"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumBoz
  | -- | Represents the JSON value @"citi_handlowy"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumCitiHandlowy
  | -- | Represents the JSON value @"credit_agricole"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumCreditAgricole
  | -- | Represents the JSON value @"envelobank"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumEnvelobank
  | -- | Represents the JSON value @"etransfer_pocztowy24"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumEtransferPocztowy24
  | -- | Represents the JSON value @"getin_bank"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumGetinBank
  | -- | Represents the JSON value @"ideabank"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumIdeabank
  | -- | Represents the JSON value @"ing"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumIng
  | -- | Represents the JSON value @"inteligo"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumInteligo
  | -- | Represents the JSON value @"mbank_mtransfer"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumMbankMtransfer
  | -- | Represents the JSON value @"nest_przelew"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumNestPrzelew
  | -- | Represents the JSON value @"noble_pay"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumNoblePay
  | -- | Represents the JSON value @"pbac_z_ipko"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumPbacZIpko
  | -- | Represents the JSON value @"plus_bank"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumPlusBank
  | -- | Represents the JSON value @"santander_przelew24"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumSantanderPrzelew24
  | -- | Represents the JSON value @"tmobile_usbugi_bankowe"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumTmobileUsbugiBankowe
  | -- | Represents the JSON value @"toyota_bank"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumToyotaBank
  | -- | Represents the JSON value @"volkswagen_bank"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumVolkswagenBank
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank']
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
-> Value
toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'Other Value
val) = Value
val
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumAliorBank) = Value
"alior_bank"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumBankMillennium) = Value
"bank_millennium"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumBankNowyBfgSa) = Value
"bank_nowy_bfg_sa"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumBankPekaoSa) = Value
"bank_pekao_sa"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumBankiSpbdzielcze) = Value
"banki_spbdzielcze"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumBlik) = Value
"blik"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumBnpParibas) = Value
"bnp_paribas"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumBoz) = Value
"boz"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumCitiHandlowy) = Value
"citi_handlowy"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumCreditAgricole) = Value
"credit_agricole"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumEnvelobank) = Value
"envelobank"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumEtransferPocztowy24) = Value
"etransfer_pocztowy24"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumGetinBank) = Value
"getin_bank"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumIdeabank) = Value
"ideabank"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumIng) = Value
"ing"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumInteligo) = Value
"inteligo"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumMbankMtransfer) = Value
"mbank_mtransfer"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumNestPrzelew) = Value
"nest_przelew"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumNoblePay) = Value
"noble_pay"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumPbacZIpko) = Value
"pbac_z_ipko"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumPlusBank) = Value
"plus_bank"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumSantanderPrzelew24) = Value
"santander_przelew24"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumTmobileUsbugiBankowe) = Value
"tmobile_usbugi_bankowe"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumToyotaBank) = Value
"toyota_bank"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumVolkswagenBank) = Value
"volkswagen_bank"

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank' where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
parseJSON Value
val =
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'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" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumAliorBank
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bank_millennium" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumBankMillennium
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bank_nowy_bfg_sa" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumBankNowyBfgSa
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bank_pekao_sa" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumBankPekaoSa
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"banki_spbdzielcze" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumBankiSpbdzielcze
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"blik" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumBlik
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bnp_paribas" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumBnpParibas
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"boz" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumBoz
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"citi_handlowy" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumCitiHandlowy
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"credit_agricole" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumCreditAgricole
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"envelobank" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumEnvelobank
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"etransfer_pocztowy24" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumEtransferPocztowy24
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"getin_bank" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumGetinBank
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ideabank" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumIdeabank
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ing" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumIng
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"inteligo" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumInteligo
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"mbank_mtransfer" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumMbankMtransfer
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"nest_przelew" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumNestPrzelew
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"noble_pay" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumNoblePay
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"pbac_z_ipko" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumPbacZIpko
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"plus_bank" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumPlusBank
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"santander_przelew24" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumSantanderPrzelew24
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"tmobile_usbugi_bankowe" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumTmobileUsbugiBankowe
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"toyota_bank" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumToyotaBank
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"volkswagen_bank" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'EnumVolkswagenBank
            | Bool
GHC.Base.otherwise -> Value
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'P24'Bank'Other Value
val
      )

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_data.properties.sepa_debit@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit' = PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
  { -- | iban
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
-> Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'Iban :: Data.Text.Internal.Text
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit']
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
-> Value
toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
-> Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'Iban PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
-> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyPaymentMethodData'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
-> Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'Iban PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
obj)

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit' where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
parseJSON = String
-> (Object
    -> Parser
         PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit')
-> Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'" (\Object
obj -> (Text
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit')
-> Parser
     (Text
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Text
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit' Parser
  (Text
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit')
-> Parser Text
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'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"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'' with all required fields.
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit' ::
  -- | 'postPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'Iban'
  Data.Text.Internal.Text ->
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit' :: Text
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit' Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'Iban = PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit' :: Text
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit' {postPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'Iban :: Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'Iban = Text
postPaymentIntentsIntentRequestBodyPaymentMethodData'SepaDebit'Iban}

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_data.properties.sofort@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort' = PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
  { -- | country
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort']
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
    -> Bool)
-> Eq PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
-> Value
toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"country" Text
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
-> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs (Text
"country" Text
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
obj)

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort' where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
parseJSON = String
-> (Object
    -> Parser
         PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort')
-> Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'" (\Object
obj -> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort')
-> Parser
     (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort' Parser
  (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort')
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"country"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'' with all required fields.
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort' ::
  -- | 'postPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country' ->
  PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort' :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort' PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country = PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort' :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort' {postPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country = PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
postPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country}

-- | Defines the enum schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_data.properties.sofort.properties.country@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'Other Data.Aeson.Types.Internal.Value
  | -- | This constructor can be used to send values to the server which are not present in the specification yet.
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"AT"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'EnumAT
  | -- | Represents the JSON value @"BE"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'EnumBE
  | -- | Represents the JSON value @"DE"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'EnumDE
  | -- | Represents the JSON value @"ES"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'EnumES
  | -- | Represents the JSON value @"IT"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'EnumIT
  | -- | Represents the JSON value @"NL"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'EnumNL
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country']
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
-> Value
toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'Other Value
val) = Value
val
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'EnumAT) = Value
"AT"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'EnumBE) = Value
"BE"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'EnumDE) = Value
"DE"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'EnumES) = Value
"ES"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'EnumIT) = Value
"IT"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'EnumNL) = Value
"NL"

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country' where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
parseJSON Value
val =
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'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" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'EnumAT
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"BE" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'EnumBE
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"DE" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'EnumDE
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ES" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'EnumES
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"IT" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'EnumIT
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"NL" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'EnumNL
            | Bool
GHC.Base.otherwise -> Value
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Sofort'Country'Other Value
val
      )

-- | Defines the enum schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_data.properties.type@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'Other Data.Aeson.Types.Internal.Value
  | -- | This constructor can be used to send values to the server which are not present in the specification yet.
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"acss_debit"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumAcssDebit
  | -- | Represents the JSON value @"afterpay_clearpay"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumAfterpayClearpay
  | -- | Represents the JSON value @"alipay"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumAlipay
  | -- | Represents the JSON value @"au_becs_debit"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumAuBecsDebit
  | -- | Represents the JSON value @"bacs_debit"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumBacsDebit
  | -- | Represents the JSON value @"bancontact"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumBancontact
  | -- | Represents the JSON value @"boleto"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumBoleto
  | -- | Represents the JSON value @"eps"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumEps
  | -- | Represents the JSON value @"fpx"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumFpx
  | -- | Represents the JSON value @"giropay"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumGiropay
  | -- | Represents the JSON value @"grabpay"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumGrabpay
  | -- | Represents the JSON value @"ideal"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumIdeal
  | -- | Represents the JSON value @"oxxo"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumOxxo
  | -- | Represents the JSON value @"p24"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumP24
  | -- | Represents the JSON value @"sepa_debit"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumSepaDebit
  | -- | Represents the JSON value @"sofort"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumSofort
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type']
    -> String -> String)
-> Show PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
    -> Bool)
-> Eq PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type' -> Value
toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'Other Value
val) = Value
val
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumAcssDebit) = Value
"acss_debit"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumAfterpayClearpay) = Value
"afterpay_clearpay"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumAlipay) = Value
"alipay"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumAuBecsDebit) = Value
"au_becs_debit"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumBacsDebit) = Value
"bacs_debit"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumBancontact) = Value
"bancontact"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumBoleto) = Value
"boleto"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumEps) = Value
"eps"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumFpx) = Value
"fpx"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumGiropay) = Value
"giropay"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumGrabpay) = Value
"grabpay"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumIdeal) = Value
"ideal"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumOxxo) = Value
"oxxo"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumP24) = Value
"p24"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumSepaDebit) = Value
"sepa_debit"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumSofort) = Value
"sofort"

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type' where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
parseJSON Value
val =
    PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodData'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" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumAcssDebit
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"afterpay_clearpay" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumAfterpayClearpay
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"alipay" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumAlipay
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"au_becs_debit" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumAuBecsDebit
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bacs_debit" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumBacsDebit
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bancontact" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumBancontact
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"boleto" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumBoleto
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"eps" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumEps
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"fpx" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumFpx
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"giropay" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumGiropay
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"grabpay" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumGrabpay
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ideal" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumIdeal
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"oxxo" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumOxxo
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"p24" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumP24
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"sepa_debit" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumSepaDebit
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"sofort" -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'EnumSofort
            | Bool
GHC.Base.otherwise -> Value -> PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'
PostPaymentIntentsIntentRequestBodyPaymentMethodData'Type'Other Value
val
      )

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options@ in the specification.
--
-- Payment-method-specific configuration for this PaymentIntent.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions' = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
  { -- | acss_debit
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants),
    -- | afterpay_clearpay
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants),
    -- | alipay
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants),
    -- | bancontact
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants),
    -- | boleto
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants),
    -- | card
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants),
    -- | card_present
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants),
    -- | oxxo
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants),
    -- | p24
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24 :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants),
    -- | sepa_debit
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants),
    -- | sofort
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants)
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions' -> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions']
    -> String -> String)
-> Show PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions' -> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions' -> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions' -> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
    -> Bool)
-> Eq PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions' -> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions' -> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions' -> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions' -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions' -> Value
toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"acss_debit" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"afterpay_clearpay" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"alipay" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"bancontact" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"boleto" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"card" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"card_present" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"oxxo" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"p24" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24 PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"sepa_debit" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"sofort" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"acss_debit" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"afterpay_clearpay" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"alipay" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"bancontact" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"boleto" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"card" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"card_present" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"oxxo" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"p24" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24 PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"sepa_debit" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"sofort" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
obj)))))))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions' where
  parseJSON :: Value
-> Parser PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
parseJSON = String
-> (Object
    -> Parser PostPaymentIntentsIntentRequestBodyPaymentMethodOptions')
-> Value
-> Parser PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'" (\Object
obj -> (((((((((((Maybe
   PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
 -> Maybe
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
 -> Maybe
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
 -> Maybe
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
 -> Maybe
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
 -> Maybe
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
 -> Maybe
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
 -> Maybe
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
 -> Maybe
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
 -> Maybe
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
 -> Maybe
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions' Parser
  (Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants)
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"acss_debit")) Parser
  (Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants)
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"afterpay_clearpay")) Parser
  (Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants)
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"alipay")) Parser
  (Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants)
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"bancontact")) Parser
  (Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants)
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"boleto")) Parser
  (Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants)
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"card")) Parser
  (Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants)
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"card_present")) Parser
  (Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants)
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"oxxo")) Parser
  (Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants)
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"p24")) Parser
  (Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants)
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"sepa_debit")) Parser
  (Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants)
-> Parser PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"sofort"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'' with all required fields.
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions' :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions' :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions' =
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions' :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'
    { postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24 :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24 = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.acss_debit.anyOf@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1 = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
  { -- | mandate_options
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'),
    -- | verification_method
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod')
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1]
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1]
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1 where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Value
toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"mandate_options" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"verification_method" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"mandate_options" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"verification_method" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
obj))

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1 where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
parseJSON = String
-> (Object
    -> Parser
         PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1)
-> Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1" (\Object
obj -> ((Maybe
   PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
 -> Maybe
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1)
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1 Parser
  (Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1)
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"mandate_options")) Parser
  (Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1)
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod')
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"verification_method"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1' with all required fields.
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1 :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1 :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1 =
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1 :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
    { postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.acss_debit.anyOf.properties.mandate_options@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions' = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
  { -- | custom_mandate_url
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants),
    -- | interval_description
    --
    -- Constraints:
    --
    -- * Maximum length of 500
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'IntervalDescription :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | payment_schedule
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'),
    -- | transaction_type
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType')
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions']
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Value
toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"custom_mandate_url" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'IntervalDescription PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"payment_schedule" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"transaction_type" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"custom_mandate_url" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'IntervalDescription PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"payment_schedule" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"transaction_type" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
obj))))

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions' where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
parseJSON = String
-> (Object
    -> Parser
         PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions')
-> Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'" (\Object
obj -> ((((Maybe
   PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
 -> Maybe Text
 -> Maybe
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
 -> Maybe
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
      -> Maybe Text
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Maybe Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions' Parser
  (Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
   -> Maybe Text
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants)
-> Parser
     (Maybe Text
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions')
-> Parser (Maybe Text)
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"payment_schedule")) Parser
  (Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType')
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"transaction_type"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'' with all required fields.
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions' :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions' :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions' =
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions' :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Maybe Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'
    { postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'IntervalDescription :: Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'IntervalDescription = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the oneOf schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.acss_debit.anyOf.properties.mandate_options.properties.custom_mandate_url.anyOf@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
  = -- | Represents the JSON value @""@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'EmptyString
  | PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Text Data.Text.Internal.Text
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants]
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants]
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Value
toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Text Text
a) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
a
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'EmptyString) = Value
""

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'EmptyString
        | Bool
GHC.Base.otherwise -> case (Text
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Text (Text
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants)
-> Result Text
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
a -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'CustomMandateUrl'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a

-- | Defines the enum schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.acss_debit.anyOf.properties.mandate_options.properties.payment_schedule@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'Other Data.Aeson.Types.Internal.Value
  | -- | This constructor can be used to send values to the server which are not present in the specification yet.
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"combined"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'EnumCombined
  | -- | Represents the JSON value @"interval"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'EnumInterval
  | -- | Represents the JSON value @"sporadic"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'EnumSporadic
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule']
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Value
toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'Other Value
val) = Value
val
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'EnumCombined) = Value
"combined"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'EnumInterval) = Value
"interval"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'EnumSporadic) = Value
"sporadic"

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule' where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
parseJSON Value
val =
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'EnumCombined
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"interval" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'EnumInterval
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"sporadic" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'EnumSporadic
            | Bool
GHC.Base.otherwise -> Value
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'PaymentSchedule'Other Value
val
      )

-- | Defines the enum schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.acss_debit.anyOf.properties.mandate_options.properties.transaction_type@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'Other Data.Aeson.Types.Internal.Value
  | -- | This constructor can be used to send values to the server which are not present in the specification yet.
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"business"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'EnumBusiness
  | -- | Represents the JSON value @"personal"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'EnumPersonal
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType']
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> Value
toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'Other Value
val) = Value
val
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'EnumBusiness) = Value
"business"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'EnumPersonal) = Value
"personal"

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType' where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
parseJSON Value
val =
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'EnumBusiness
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"personal" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'EnumPersonal
            | Bool
GHC.Base.otherwise -> Value
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1MandateOptions'TransactionType'Other Value
val
      )

-- | Defines the enum schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.acss_debit.anyOf.properties.verification_method@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'Other Data.Aeson.Types.Internal.Value
  | -- | This constructor can be used to send values to the server which are not present in the specification yet.
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"automatic"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'EnumAutomatic
  | -- | Represents the JSON value @"instant"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'EnumInstant
  | -- | Represents the JSON value @"microdeposits"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'EnumMicrodeposits
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod']
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> Value
toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'Other Value
val) = Value
val
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'EnumAutomatic) = Value
"automatic"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'EnumInstant) = Value
"instant"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'EnumMicrodeposits) = Value
"microdeposits"

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod' where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
parseJSON Value
val =
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'EnumAutomatic
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"instant" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'EnumInstant
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"microdeposits" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'EnumMicrodeposits
            | Bool
GHC.Base.otherwise -> Value
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1VerificationMethod'Other Value
val
      )

-- | Defines the oneOf schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.acss_debit.anyOf@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
  = -- | Represents the JSON value @""@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'EmptyString
  | PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1 PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants]
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants]
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Value
toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1 PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
a) = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
a
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'EmptyString) = Value
""

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'EmptyString
        | Bool
GHC.Base.otherwise -> case (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1 (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants)
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
a -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AcssDebit'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.afterpay_clearpay.anyOf@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1 = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
  { -- | reference
    --
    -- Constraints:
    --
    -- * Maximum length of 128
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1Reference :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1]
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1]
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1 where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> Value
toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1Reference PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1Reference PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
obj)

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1 where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
parseJSON = String
-> (Object
    -> Parser
         PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1)
-> Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1" (\Object
obj -> (Maybe Text
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1)
-> Parser
     (Maybe Text
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1 Parser
  (Maybe Text
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1)
-> Parser (Maybe Text)
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1' with all required fields.
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1 :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1 :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1 = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1 :: Maybe Text
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1 {postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1Reference :: Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1Reference = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing}

-- | Defines the oneOf schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.afterpay_clearpay.anyOf@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
  = -- | Represents the JSON value @""@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'EmptyString
  | PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1 PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants]
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants]
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Value
toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1 PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
a) = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
a
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'EmptyString) = Value
""

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'EmptyString
        | Bool
GHC.Base.otherwise -> case (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1 (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants)
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
a -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'AfterpayClearpay'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a

-- | Defines the oneOf schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.alipay.anyOf@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
  = -- | Represents the JSON value @""@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'EmptyString
  | PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Object Data.Aeson.Types.Internal.Object
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants]
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants]
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
-> Value
toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Object Object
a) = Object -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Object
a
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'EmptyString) = Value
""

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'EmptyString
        | Bool
GHC.Base.otherwise -> case (Object
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Object (Object
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants)
-> Result Object
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
a -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Alipay'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.bancontact.anyOf@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1 = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
  { -- | preferred_language
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage')
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1]
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1]
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1 where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> Value
toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"preferred_language" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs (Text
"preferred_language" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
obj)

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1 where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
parseJSON = String
-> (Object
    -> Parser
         PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1)
-> Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1" (\Object
obj -> (Maybe
   PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1)
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1 Parser
  (Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1)
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage')
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"preferred_language"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1' with all required fields.
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1 :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1 :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1 = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1 :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1 {postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
forall a. Maybe a
GHC.Maybe.Nothing}

-- | Defines the enum schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.bancontact.anyOf.properties.preferred_language@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'Other Data.Aeson.Types.Internal.Value
  | -- | This constructor can be used to send values to the server which are not present in the specification yet.
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"de"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'EnumDe
  | -- | Represents the JSON value @"en"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'EnumEn
  | -- | Represents the JSON value @"fr"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'EnumFr
  | -- | Represents the JSON value @"nl"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'EnumNl
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage']
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> Value
toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'Other Value
val) = Value
val
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'EnumDe) = Value
"de"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'EnumEn) = Value
"en"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'EnumFr) = Value
"fr"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'EnumNl) = Value
"nl"

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage' where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
parseJSON Value
val =
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'EnumDe
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"en" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'EnumEn
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"fr" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'EnumFr
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"nl" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'EnumNl
            | Bool
GHC.Base.otherwise -> Value
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1PreferredLanguage'Other Value
val
      )

-- | Defines the oneOf schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.bancontact.anyOf@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
  = -- | Represents the JSON value @""@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'EmptyString
  | PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1 PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants]
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants]
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Value
toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1 PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
a) = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
a
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'EmptyString) = Value
""

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'EmptyString
        | Bool
GHC.Base.otherwise -> case (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1 (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants)
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
a -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Bancontact'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.boleto.anyOf@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1 = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
  { -- | expires_after_days
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> Maybe Int
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1ExpiresAfterDays :: (GHC.Maybe.Maybe GHC.Types.Int)
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1]
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1]
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1 where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> Value
toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> Maybe Int
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1ExpiresAfterDays PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> Maybe Int
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1ExpiresAfterDays PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
obj)

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1 where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
parseJSON = String
-> (Object
    -> Parser
         PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1)
-> Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1" (\Object
obj -> (Maybe Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1)
-> Parser
     (Maybe Int
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1 Parser
  (Maybe Int
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1)
-> Parser (Maybe Int)
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1' with all required fields.
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1 :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1 :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1 = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1 :: Maybe Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1 {postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1ExpiresAfterDays :: Maybe Int
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1ExpiresAfterDays = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing}

-- | Defines the oneOf schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.boleto.anyOf@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
  = -- | Represents the JSON value @""@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'EmptyString
  | PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1 PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants]
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants]
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
-> Value
toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1 PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
a) = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
a
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'EmptyString) = Value
""

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'EmptyString
        | Bool
GHC.Base.otherwise -> case (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1 (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants)
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
a -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Boleto'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.card.anyOf@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1 = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
  { -- | cvc_token
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1CvcToken :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | installments
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'),
    -- | network
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'),
    -- | request_three_d_secure
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure')
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1]
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1]
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1 where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> Value
toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1CvcToken PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"installments" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"network" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"request_three_d_secure" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1CvcToken PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"installments" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"network" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"request_three_d_secure" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
obj))))

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1 where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
parseJSON = String
-> (Object
    -> Parser
         PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1)
-> Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1" (\Object
obj -> ((((Maybe Text
 -> Maybe
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
 -> Maybe
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
 -> Maybe
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1)
-> Parser
     (Maybe Text
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1 Parser
  (Maybe Text
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1)
-> Parser (Maybe Text)
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1)
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"installments")) Parser
  (Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1)
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"network")) Parser
  (Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1)
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure')
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"request_three_d_secure"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1' with all required fields.
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1 :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1 :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1 =
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1 :: Maybe Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
    { postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1CvcToken :: Maybe Text
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1CvcToken = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.card.anyOf.properties.installments@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments' = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
  { -- | enabled
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Maybe Bool
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Enabled :: (GHC.Maybe.Maybe GHC.Types.Bool),
    -- | plan
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants)
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments']
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Value
toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Maybe Bool
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Enabled PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"plan" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Maybe Bool
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Enabled PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"plan" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
obj))

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments' where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
parseJSON = String
-> (Object
    -> Parser
         PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments')
-> Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'" (\Object
obj -> ((Maybe Bool
 -> Maybe
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments')
-> Parser
     (Maybe Bool
      -> Maybe
           PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Bool
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments' Parser
  (Maybe Bool
   -> Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments')
-> Parser (Maybe Bool)
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments')
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants)
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"plan"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'' with all required fields.
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments' :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments' :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments' =
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments' :: Maybe Bool
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'
    { postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Enabled :: Maybe Bool
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Enabled = Maybe Bool
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.card.anyOf.properties.installments.properties.plan.anyOf@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1 = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
  { -- | count
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> Int
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1Count :: GHC.Types.Int
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1]
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1]
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1 where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> Value
toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> Int
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1Count PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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 :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> Int
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1Count PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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 PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1 where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
parseJSON = String
-> (Object
    -> Parser
         PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1)
-> Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1" (\Object
obj -> (Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1)
-> Parser
     (Int
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1 Parser
  (Int
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1)
-> Parser Int
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1' with all required fields.
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1 ::
  -- | 'postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1Count'
  GHC.Types.Int ->
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1 :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1 Int
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1Count = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1 :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1 {postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1Count :: Int
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1Count = Int
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1Count}

-- | Defines the oneOf schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.card.anyOf.properties.installments.properties.plan.anyOf@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
  = -- | Represents the JSON value @""@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'EmptyString
  | PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1 PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants]
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants]
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> Value
toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1 PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
a) = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
a
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'EmptyString) = Value
""

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'EmptyString
        | Bool
GHC.Base.otherwise -> case (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1 (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants)
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
a -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Installments'Plan'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a

-- | Defines the enum schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.card.anyOf.properties.network@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'Other Data.Aeson.Types.Internal.Value
  | -- | This constructor can be used to send values to the server which are not present in the specification yet.
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"amex"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumAmex
  | -- | Represents the JSON value @"cartes_bancaires"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumCartesBancaires
  | -- | Represents the JSON value @"diners"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumDiners
  | -- | Represents the JSON value @"discover"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumDiscover
  | -- | Represents the JSON value @"interac"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumInterac
  | -- | Represents the JSON value @"jcb"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumJcb
  | -- | Represents the JSON value @"mastercard"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumMastercard
  | -- | Represents the JSON value @"unionpay"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumUnionpay
  | -- | Represents the JSON value @"unknown"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumUnknown
  | -- | Represents the JSON value @"visa"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumVisa
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network']
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Value
toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'Other Value
val) = Value
val
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumAmex) = Value
"amex"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumCartesBancaires) = Value
"cartes_bancaires"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumDiners) = Value
"diners"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumDiscover) = Value
"discover"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumInterac) = Value
"interac"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumJcb) = Value
"jcb"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumMastercard) = Value
"mastercard"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumUnionpay) = Value
"unionpay"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumUnknown) = Value
"unknown"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumVisa) = Value
"visa"

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network' where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
parseJSON Value
val =
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumAmex
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"cartes_bancaires" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumCartesBancaires
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"diners" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumDiners
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"discover" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumDiscover
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"interac" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumInterac
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"jcb" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumJcb
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"mastercard" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumMastercard
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"unionpay" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumUnionpay
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"unknown" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumUnknown
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"visa" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'EnumVisa
            | Bool
GHC.Base.otherwise -> Value
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1Network'Other Value
val
      )

-- | Defines the enum schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.card.anyOf.properties.request_three_d_secure@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'Other Data.Aeson.Types.Internal.Value
  | -- | This constructor can be used to send values to the server which are not present in the specification yet.
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"any"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'EnumAny
  | -- | Represents the JSON value @"automatic"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'EnumAutomatic
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure']
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> Value
toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'Other Value
val) = Value
val
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'EnumAny) = Value
"any"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'EnumAutomatic) = Value
"automatic"

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure' where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
parseJSON Value
val =
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'EnumAny
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"automatic" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'EnumAutomatic
            | Bool
GHC.Base.otherwise -> Value
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1RequestThreeDSecure'Other Value
val
      )

-- | Defines the oneOf schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.card.anyOf@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
  = -- | Represents the JSON value @""@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'EmptyString
  | PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1 PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants]
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants]
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
-> Value
toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1 PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
a) = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
a
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'EmptyString) = Value
""

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'EmptyString
        | Bool
GHC.Base.otherwise -> case (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1 (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants)
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
a -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Card'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a

-- | Defines the oneOf schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.card_present.anyOf@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
  = -- | Represents the JSON value @""@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'EmptyString
  | PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Object Data.Aeson.Types.Internal.Object
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants]
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants]
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Value
toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Object Object
a) = Object -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Object
a
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'EmptyString) = Value
""

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'EmptyString
        | Bool
GHC.Base.otherwise -> case (Object
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Object (Object
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants)
-> Result Object
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
a -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'CardPresent'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.oxxo.anyOf@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1 = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
  { -- | expires_after_days
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> Maybe Int
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1ExpiresAfterDays :: (GHC.Maybe.Maybe GHC.Types.Int)
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1]
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1]
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1 where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> Value
toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> Maybe Int
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1ExpiresAfterDays PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> Maybe Int
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1ExpiresAfterDays PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
obj)

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1 where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
parseJSON = String
-> (Object
    -> Parser
         PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1)
-> Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1" (\Object
obj -> (Maybe Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1)
-> Parser
     (Maybe Int
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1 Parser
  (Maybe Int
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1)
-> Parser (Maybe Int)
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1' with all required fields.
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1 :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1 :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1 = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1 :: Maybe Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1 {postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1ExpiresAfterDays :: Maybe Int
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1ExpiresAfterDays = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing}

-- | Defines the oneOf schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.oxxo.anyOf@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
  = -- | Represents the JSON value @""@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'EmptyString
  | PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1 PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants]
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants]
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Value
toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1 PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
a) = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
a
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'EmptyString) = Value
""

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'EmptyString
        | Bool
GHC.Base.otherwise -> case (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1 (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants)
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
a -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Oxxo'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.p24.anyOf@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1 = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
  { -- | tos_shown_and_accepted
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
-> Maybe Bool
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1TosShownAndAccepted :: (GHC.Maybe.Maybe GHC.Types.Bool)
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1]
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1]
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1 where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
-> Value
toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
-> Maybe Bool
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1TosShownAndAccepted PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
-> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
-> Maybe Bool
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1TosShownAndAccepted PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
obj)

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1 where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
parseJSON = String
-> (Object
    -> Parser
         PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1)
-> Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1" (\Object
obj -> (Maybe Bool
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1)
-> Parser
     (Maybe Bool
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Bool
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1 Parser
  (Maybe Bool
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1)
-> Parser (Maybe Bool)
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1' with all required fields.
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1 :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1 :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1 = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1 :: Maybe Bool
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1 {postPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1TosShownAndAccepted :: Maybe Bool
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1TosShownAndAccepted = Maybe Bool
forall a. Maybe a
GHC.Maybe.Nothing}

-- | Defines the oneOf schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.p24.anyOf@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
  = -- | Represents the JSON value @""@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'EmptyString
  | PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1 PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants]
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants]
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
-> Value
toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1 PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
a) = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
a
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'EmptyString) = Value
""

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'EmptyString
        | Bool
GHC.Base.otherwise -> case (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1 (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants)
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
a -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'P24'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.sepa_debit.anyOf@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1 = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
  { -- | mandate_options
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1MandateOptions :: (GHC.Maybe.Maybe Data.Aeson.Types.Internal.Object)
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1]
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1]
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1 where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> Value
toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1MandateOptions PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1MandateOptions PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
obj)

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1 where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
parseJSON = String
-> (Object
    -> Parser
         PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1)
-> Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1" (\Object
obj -> (Maybe Object
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1)
-> Parser
     (Maybe Object
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Object
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1 Parser
  (Maybe Object
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1)
-> Parser (Maybe Object)
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1' with all required fields.
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1 :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1 :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1 = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1 :: Maybe Object
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1 {postPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1MandateOptions :: Maybe Object
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1MandateOptions = Maybe Object
forall a. Maybe a
GHC.Maybe.Nothing}

-- | Defines the oneOf schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.sepa_debit.anyOf@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
  = -- | Represents the JSON value @""@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'EmptyString
  | PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1 PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants]
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants]
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Value
toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1 PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
a) = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
a
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'EmptyString) = Value
""

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'EmptyString
        | Bool
GHC.Base.otherwise -> case (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1 (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants)
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
a -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'SepaDebit'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.sofort.anyOf@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1 = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
  { -- | preferred_language
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage :: (GHC.Maybe.Maybe PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage')
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1]
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1]
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1 where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> Value
toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"preferred_language" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs (Text
"preferred_language" Text
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
obj)

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1 where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
parseJSON = String
-> (Object
    -> Parser
         PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1)
-> Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1" (\Object
obj -> (Maybe
   PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1)
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
      -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1 Parser
  (Maybe
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
   -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1)
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage')
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"preferred_language"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1' with all required fields.
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1 :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1 :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
mkPostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1 = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1 :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1 {postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage :: Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
postPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage = Maybe
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
forall a. Maybe a
GHC.Maybe.Nothing}

-- | Defines the enum schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.sofort.anyOf.properties.preferred_language@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'Other Data.Aeson.Types.Internal.Value
  | -- | This constructor can be used to send values to the server which are not present in the specification yet.
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"de"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumDe
  | -- | Represents the JSON value @"en"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumEn
  | -- | Represents the JSON value @"es"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumEs
  | -- | Represents the JSON value @"fr"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumFr
  | -- | Represents the JSON value @"it"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumIt
  | -- | Represents the JSON value @"nl"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumNl
  | -- | Represents the JSON value @"pl"@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumPl
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage']
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage']
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage' where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> Value
toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'Other Value
val) = Value
val
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumDe) = Value
"de"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumEn) = Value
"en"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumEs) = Value
"es"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumFr) = Value
"fr"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumIt) = Value
"it"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumNl) = Value
"nl"
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumPl) = Value
"pl"

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage' where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
parseJSON Value
val =
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'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" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumDe
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"en" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumEn
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"es" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumEs
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"fr" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumFr
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"it" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumIt
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"nl" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumNl
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"pl" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'EnumPl
            | Bool
GHC.Base.otherwise -> Value
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1PreferredLanguage'Other Value
val
      )

-- | Defines the oneOf schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.payment_method_options.properties.sofort.anyOf@ in the specification.
data PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
  = -- | Represents the JSON value @""@
    PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'EmptyString
  | PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1 PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
-> String
-> String
[PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants]
-> String -> String
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants]
    -> String -> String)
-> Show
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
-> Bool
(PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
    -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
    -> Bool)
-> Eq
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
-> Bool
== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants where
  toJSON :: PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
-> Value
toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1 PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
a) = PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
a
  toJSON (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'EmptyString) = Value
""

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'EmptyString
        | Bool
GHC.Base.otherwise -> case (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1 (PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
 -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants)
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
  PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
a -> PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
     PostPaymentIntentsIntentRequestBodyPaymentMethodOptions'Sofort'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a

-- | Defines the oneOf schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.receipt_email.anyOf@ in the specification.
--
-- Email address that the receipt for the resulting payment will be sent to. If \`receipt_email\` is specified for a payment in live mode, a receipt will be sent regardless of your [email settings](https:\/\/dashboard.stripe.com\/account\/emails).
data PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
  = -- | Represents the JSON value @""@
    PostPaymentIntentsIntentRequestBodyReceiptEmail'EmptyString
  | PostPaymentIntentsIntentRequestBodyReceiptEmail'Text Data.Text.Internal.Text
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
-> String
-> String
[PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants]
-> String -> String
PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants -> String
(Int
 -> PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants]
    -> String -> String)
-> Show PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants -> String
$cshow :: PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants -> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
-> PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants -> Bool
(PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
 -> PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
    -> PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
    -> Bool)
-> Eq PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
-> PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants -> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
-> PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants -> Bool
== :: PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
-> PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants -> Bool
$c== :: PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
-> PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants where
  toJSON :: PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants -> Value
toJSON (PostPaymentIntentsIntentRequestBodyReceiptEmail'Text Text
a) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
a
  toJSON (PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
PostPaymentIntentsIntentRequestBodyReceiptEmail'EmptyString) = Value
""

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants where
  parseJSON :: Value
-> Parser PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
-> Parser PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
PostPaymentIntentsIntentRequestBodyReceiptEmail'EmptyString
        | Bool
GHC.Base.otherwise -> case (Text -> PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
PostPaymentIntentsIntentRequestBodyReceiptEmail'Text (Text -> PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants)
-> Result Text
-> Result PostPaymentIntentsIntentRequestBodyReceiptEmail'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 PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
-> Result PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
-> Result PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
a -> PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
-> Parser PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String
-> Parser PostPaymentIntentsIntentRequestBodyReceiptEmail'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a

-- | Defines the enum schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.setup_future_usage@ in the specification.
--
-- Indicates that you intend to make future payments with this PaymentIntent\'s payment method.
--
-- Providing this parameter will [attach the payment method](https:\/\/stripe.com\/docs\/payments\/save-during-payment) to the PaymentIntent\'s Customer, if present, after the PaymentIntent is confirmed and any required actions from the user are complete. If no Customer was provided, the payment method can still be [attached](https:\/\/stripe.com\/docs\/api\/payment_methods\/attach) to a Customer after the transaction completes.
--
-- When processing card payments, Stripe also uses \`setup_future_usage\` to dynamically optimize your payment flow and comply with regional legislation and network rules, such as [SCA](https:\/\/stripe.com\/docs\/strong-customer-authentication).
--
-- If \`setup_future_usage\` is already set and you are performing a request using a publishable key, you may only update the value from \`on_session\` to \`off_session\`.
data PostPaymentIntentsIntentRequestBodySetupFutureUsage'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostPaymentIntentsIntentRequestBodySetupFutureUsage'Other Data.Aeson.Types.Internal.Value
  | -- | This constructor can be used to send values to the server which are not present in the specification yet.
    PostPaymentIntentsIntentRequestBodySetupFutureUsage'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @""@
    PostPaymentIntentsIntentRequestBodySetupFutureUsage'EnumEmptyString
  | -- | Represents the JSON value @"off_session"@
    PostPaymentIntentsIntentRequestBodySetupFutureUsage'EnumOffSession
  | -- | Represents the JSON value @"on_session"@
    PostPaymentIntentsIntentRequestBodySetupFutureUsage'EnumOnSession
  deriving (Int
-> PostPaymentIntentsIntentRequestBodySetupFutureUsage'
-> String
-> String
[PostPaymentIntentsIntentRequestBodySetupFutureUsage']
-> String -> String
PostPaymentIntentsIntentRequestBodySetupFutureUsage' -> String
(Int
 -> PostPaymentIntentsIntentRequestBodySetupFutureUsage'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodySetupFutureUsage' -> String)
-> ([PostPaymentIntentsIntentRequestBodySetupFutureUsage']
    -> String -> String)
-> Show PostPaymentIntentsIntentRequestBodySetupFutureUsage'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodySetupFutureUsage']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodySetupFutureUsage']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodySetupFutureUsage' -> String
$cshow :: PostPaymentIntentsIntentRequestBodySetupFutureUsage' -> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodySetupFutureUsage'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodySetupFutureUsage'
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodySetupFutureUsage'
-> PostPaymentIntentsIntentRequestBodySetupFutureUsage' -> Bool
(PostPaymentIntentsIntentRequestBodySetupFutureUsage'
 -> PostPaymentIntentsIntentRequestBodySetupFutureUsage' -> Bool)
-> (PostPaymentIntentsIntentRequestBodySetupFutureUsage'
    -> PostPaymentIntentsIntentRequestBodySetupFutureUsage' -> Bool)
-> Eq PostPaymentIntentsIntentRequestBodySetupFutureUsage'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodySetupFutureUsage'
-> PostPaymentIntentsIntentRequestBodySetupFutureUsage' -> Bool
$c/= :: PostPaymentIntentsIntentRequestBodySetupFutureUsage'
-> PostPaymentIntentsIntentRequestBodySetupFutureUsage' -> Bool
== :: PostPaymentIntentsIntentRequestBodySetupFutureUsage'
-> PostPaymentIntentsIntentRequestBodySetupFutureUsage' -> Bool
$c== :: PostPaymentIntentsIntentRequestBodySetupFutureUsage'
-> PostPaymentIntentsIntentRequestBodySetupFutureUsage' -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodySetupFutureUsage' where
  toJSON :: PostPaymentIntentsIntentRequestBodySetupFutureUsage' -> Value
toJSON (PostPaymentIntentsIntentRequestBodySetupFutureUsage'Other Value
val) = Value
val
  toJSON (PostPaymentIntentsIntentRequestBodySetupFutureUsage'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (PostPaymentIntentsIntentRequestBodySetupFutureUsage'
PostPaymentIntentsIntentRequestBodySetupFutureUsage'EnumEmptyString) = Value
""
  toJSON (PostPaymentIntentsIntentRequestBodySetupFutureUsage'
PostPaymentIntentsIntentRequestBodySetupFutureUsage'EnumOffSession) = Value
"off_session"
  toJSON (PostPaymentIntentsIntentRequestBodySetupFutureUsage'
PostPaymentIntentsIntentRequestBodySetupFutureUsage'EnumOnSession) = Value
"on_session"

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodySetupFutureUsage' where
  parseJSON :: Value
-> Parser PostPaymentIntentsIntentRequestBodySetupFutureUsage'
parseJSON Value
val =
    PostPaymentIntentsIntentRequestBodySetupFutureUsage'
-> Parser PostPaymentIntentsIntentRequestBodySetupFutureUsage'
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
"" -> PostPaymentIntentsIntentRequestBodySetupFutureUsage'
PostPaymentIntentsIntentRequestBodySetupFutureUsage'EnumEmptyString
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"off_session" -> PostPaymentIntentsIntentRequestBodySetupFutureUsage'
PostPaymentIntentsIntentRequestBodySetupFutureUsage'EnumOffSession
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"on_session" -> PostPaymentIntentsIntentRequestBodySetupFutureUsage'
PostPaymentIntentsIntentRequestBodySetupFutureUsage'EnumOnSession
            | Bool
GHC.Base.otherwise -> Value -> PostPaymentIntentsIntentRequestBodySetupFutureUsage'
PostPaymentIntentsIntentRequestBodySetupFutureUsage'Other Value
val
      )

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.shipping.anyOf@ in the specification.
data PostPaymentIntentsIntentRequestBodyShipping'OneOf1 = PostPaymentIntentsIntentRequestBodyShipping'OneOf1
  { -- | address
    PostPaymentIntentsIntentRequestBodyShipping'OneOf1
-> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address :: PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address',
    -- | carrier
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyShipping'OneOf1 -> Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Carrier :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | name
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyShipping'OneOf1 -> Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Name :: Data.Text.Internal.Text,
    -- | phone
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyShipping'OneOf1 -> Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Phone :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | tracking_number
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyShipping'OneOf1 -> Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1TrackingNumber :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyShipping'OneOf1
-> String
-> String
[PostPaymentIntentsIntentRequestBodyShipping'OneOf1]
-> String -> String
PostPaymentIntentsIntentRequestBodyShipping'OneOf1 -> String
(Int
 -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyShipping'OneOf1 -> String)
-> ([PostPaymentIntentsIntentRequestBodyShipping'OneOf1]
    -> String -> String)
-> Show PostPaymentIntentsIntentRequestBodyShipping'OneOf1
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyShipping'OneOf1]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyShipping'OneOf1]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyShipping'OneOf1 -> String
$cshow :: PostPaymentIntentsIntentRequestBodyShipping'OneOf1 -> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyShipping'OneOf1
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyShipping'OneOf1
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyShipping'OneOf1
-> PostPaymentIntentsIntentRequestBodyShipping'OneOf1 -> Bool
(PostPaymentIntentsIntentRequestBodyShipping'OneOf1
 -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyShipping'OneOf1
    -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1 -> Bool)
-> Eq PostPaymentIntentsIntentRequestBodyShipping'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyShipping'OneOf1
-> PostPaymentIntentsIntentRequestBodyShipping'OneOf1 -> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyShipping'OneOf1
-> PostPaymentIntentsIntentRequestBodyShipping'OneOf1 -> Bool
== :: PostPaymentIntentsIntentRequestBodyShipping'OneOf1
-> PostPaymentIntentsIntentRequestBodyShipping'OneOf1 -> Bool
$c== :: PostPaymentIntentsIntentRequestBodyShipping'OneOf1
-> PostPaymentIntentsIntentRequestBodyShipping'OneOf1 -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyShipping'OneOf1 where
  toJSON :: PostPaymentIntentsIntentRequestBodyShipping'OneOf1 -> Value
toJSON PostPaymentIntentsIntentRequestBodyShipping'OneOf1
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"address" Text
-> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyShipping'OneOf1
-> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address PostPaymentIntentsIntentRequestBodyShipping'OneOf1
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..= PostPaymentIntentsIntentRequestBodyShipping'OneOf1 -> Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Carrier PostPaymentIntentsIntentRequestBodyShipping'OneOf1
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..= PostPaymentIntentsIntentRequestBodyShipping'OneOf1 -> Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Name PostPaymentIntentsIntentRequestBodyShipping'OneOf1
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..= PostPaymentIntentsIntentRequestBodyShipping'OneOf1 -> Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Phone PostPaymentIntentsIntentRequestBodyShipping'OneOf1
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..= PostPaymentIntentsIntentRequestBodyShipping'OneOf1 -> Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1TrackingNumber PostPaymentIntentsIntentRequestBodyShipping'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyShipping'OneOf1 -> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyShipping'OneOf1
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"address" Text
-> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPaymentIntentsIntentRequestBodyShipping'OneOf1
-> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address PostPaymentIntentsIntentRequestBodyShipping'OneOf1
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..= PostPaymentIntentsIntentRequestBodyShipping'OneOf1 -> Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Carrier PostPaymentIntentsIntentRequestBodyShipping'OneOf1
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..= PostPaymentIntentsIntentRequestBodyShipping'OneOf1 -> Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Name PostPaymentIntentsIntentRequestBodyShipping'OneOf1
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..= PostPaymentIntentsIntentRequestBodyShipping'OneOf1 -> Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Phone PostPaymentIntentsIntentRequestBodyShipping'OneOf1
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..= PostPaymentIntentsIntentRequestBodyShipping'OneOf1 -> Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1TrackingNumber PostPaymentIntentsIntentRequestBodyShipping'OneOf1
obj)))))

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyShipping'OneOf1 where
  parseJSON :: Value -> Parser PostPaymentIntentsIntentRequestBodyShipping'OneOf1
parseJSON = String
-> (Object
    -> Parser PostPaymentIntentsIntentRequestBodyShipping'OneOf1)
-> Value
-> Parser PostPaymentIntentsIntentRequestBodyShipping'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyShipping'OneOf1" (\Object
obj -> (((((PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
 -> Maybe Text
 -> Text
 -> Maybe Text
 -> Maybe Text
 -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1)
-> Parser
     (PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
      -> Maybe Text
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> Maybe Text
-> Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsIntentRequestBodyShipping'OneOf1
PostPaymentIntentsIntentRequestBodyShipping'OneOf1 Parser
  (PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
   -> Maybe Text
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1)
-> Parser
     PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> Parser
     (Maybe Text
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"address")) Parser
  (Maybe Text
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1)
-> Parser (Maybe Text)
-> Parser
     (Text
      -> Maybe Text
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBodyShipping'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
"carrier")) Parser
  (Text
   -> Maybe Text
   -> Maybe Text
   -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1)
-> Parser Text
-> Parser
     (Maybe Text
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1)
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
   -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> PostPaymentIntentsIntentRequestBodyShipping'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
"phone")) Parser
  (Maybe Text -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1)
-> Parser (Maybe Text)
-> Parser PostPaymentIntentsIntentRequestBodyShipping'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
"tracking_number"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyShipping'OneOf1' with all required fields.
mkPostPaymentIntentsIntentRequestBodyShipping'OneOf1 ::
  -- | 'postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
  PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address' ->
  -- | 'postPaymentIntentsIntentRequestBodyShipping'OneOf1Name'
  Data.Text.Internal.Text ->
  PostPaymentIntentsIntentRequestBodyShipping'OneOf1
mkPostPaymentIntentsIntentRequestBodyShipping'OneOf1 :: PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> Text -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1
mkPostPaymentIntentsIntentRequestBodyShipping'OneOf1 PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Name =
  PostPaymentIntentsIntentRequestBodyShipping'OneOf1 :: PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> Maybe Text
-> Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsIntentRequestBodyShipping'OneOf1
PostPaymentIntentsIntentRequestBodyShipping'OneOf1
    { postPaymentIntentsIntentRequestBodyShipping'OneOf1Address :: PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address = PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address,
      postPaymentIntentsIntentRequestBodyShipping'OneOf1Carrier :: Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Carrier = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyShipping'OneOf1Name :: Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Name = Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Name,
      postPaymentIntentsIntentRequestBodyShipping'OneOf1Phone :: Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Phone = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyShipping'OneOf1TrackingNumber :: Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1TrackingNumber = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.shipping.anyOf.properties.address@ in the specification.
data PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address' = PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
  { -- | city
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'City :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | country
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'Country :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | line1
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address' -> Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'Line1 :: Data.Text.Internal.Text,
    -- | line2
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'Line2 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | postal_code
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'PostalCode :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | state
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'State :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address']
-> String -> String
PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> String
(Int
 -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
    -> String)
-> ([PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address']
    -> String -> String)
-> Show PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> String
$cshow :: PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> Bool
(PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
 -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
 -> Bool)
-> (PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
    -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
    -> Bool)
-> Eq PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> Bool
== :: PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> Bool
$c== :: PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address' where
  toJSON :: PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address' -> Value
toJSON PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
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..= PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'City PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
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..= PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'Country PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
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..= PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address' -> Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'Line1 PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
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..= PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'Line2 PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
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..= PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'PostalCode PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
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..= PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'State PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
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..= PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'City PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
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..= PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'Country PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
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..= PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address' -> Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'Line1 PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
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..= PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'Line2 PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
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..= PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'PostalCode PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
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..= PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
-> Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'State PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
obj))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address' where
  parseJSON :: Value
-> Parser
     PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
parseJSON = String
-> (Object
    -> Parser
         PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address')
-> Value
-> Parser
     PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'" (\Object
obj -> ((((((Maybe Text
 -> Maybe Text
 -> Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address')
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe Text
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address' Parser
  (Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address')
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
   -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address')
-> Parser (Maybe Text)
-> Parser
     (Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address')
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
   -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address')
-> Parser Text
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address')
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
   -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address')
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
   -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address')
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
   -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address')
-> Parser (Maybe Text)
-> Parser
     PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
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"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'' with all required fields.
mkPostPaymentIntentsIntentRequestBodyShipping'OneOf1Address' ::
  -- | 'postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'Line1'
  Data.Text.Internal.Text ->
  PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
mkPostPaymentIntentsIntentRequestBodyShipping'OneOf1Address' :: Text -> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
mkPostPaymentIntentsIntentRequestBodyShipping'OneOf1Address' Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'Line1 =
  PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address' :: Maybe Text
-> Maybe Text
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
PostPaymentIntentsIntentRequestBodyShipping'OneOf1Address'
    { postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'City :: Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'City = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'Country :: Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'Country = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'Line1 :: Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'Line1 = Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'Line1,
      postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'Line2 :: Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'Line2 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'PostalCode :: Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'PostalCode = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'State :: Maybe Text
postPaymentIntentsIntentRequestBodyShipping'OneOf1Address'State = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the oneOf schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.shipping.anyOf@ in the specification.
--
-- Shipping information for this PaymentIntent.
data PostPaymentIntentsIntentRequestBodyShipping'Variants
  = -- | Represents the JSON value @""@
    PostPaymentIntentsIntentRequestBodyShipping'EmptyString
  | PostPaymentIntentsIntentRequestBodyShipping'PostPaymentIntentsIntentRequestBodyShipping'OneOf1 PostPaymentIntentsIntentRequestBodyShipping'OneOf1
  deriving (Int
-> PostPaymentIntentsIntentRequestBodyShipping'Variants
-> String
-> String
[PostPaymentIntentsIntentRequestBodyShipping'Variants]
-> String -> String
PostPaymentIntentsIntentRequestBodyShipping'Variants -> String
(Int
 -> PostPaymentIntentsIntentRequestBodyShipping'Variants
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyShipping'Variants -> String)
-> ([PostPaymentIntentsIntentRequestBodyShipping'Variants]
    -> String -> String)
-> Show PostPaymentIntentsIntentRequestBodyShipping'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyShipping'Variants]
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyShipping'Variants]
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyShipping'Variants -> String
$cshow :: PostPaymentIntentsIntentRequestBodyShipping'Variants -> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyShipping'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyShipping'Variants
-> String
-> String
GHC.Show.Show, PostPaymentIntentsIntentRequestBodyShipping'Variants
-> PostPaymentIntentsIntentRequestBodyShipping'Variants -> Bool
(PostPaymentIntentsIntentRequestBodyShipping'Variants
 -> PostPaymentIntentsIntentRequestBodyShipping'Variants -> Bool)
-> (PostPaymentIntentsIntentRequestBodyShipping'Variants
    -> PostPaymentIntentsIntentRequestBodyShipping'Variants -> Bool)
-> Eq PostPaymentIntentsIntentRequestBodyShipping'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyShipping'Variants
-> PostPaymentIntentsIntentRequestBodyShipping'Variants -> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyShipping'Variants
-> PostPaymentIntentsIntentRequestBodyShipping'Variants -> Bool
== :: PostPaymentIntentsIntentRequestBodyShipping'Variants
-> PostPaymentIntentsIntentRequestBodyShipping'Variants -> Bool
$c== :: PostPaymentIntentsIntentRequestBodyShipping'Variants
-> PostPaymentIntentsIntentRequestBodyShipping'Variants -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyShipping'Variants where
  toJSON :: PostPaymentIntentsIntentRequestBodyShipping'Variants -> Value
toJSON (PostPaymentIntentsIntentRequestBodyShipping'PostPaymentIntentsIntentRequestBodyShipping'OneOf1 PostPaymentIntentsIntentRequestBodyShipping'OneOf1
a) = PostPaymentIntentsIntentRequestBodyShipping'OneOf1 -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON PostPaymentIntentsIntentRequestBodyShipping'OneOf1
a
  toJSON (PostPaymentIntentsIntentRequestBodyShipping'Variants
PostPaymentIntentsIntentRequestBodyShipping'EmptyString) = Value
""

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyShipping'Variants where
  parseJSON :: Value
-> Parser PostPaymentIntentsIntentRequestBodyShipping'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostPaymentIntentsIntentRequestBodyShipping'Variants
-> Parser PostPaymentIntentsIntentRequestBodyShipping'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyShipping'Variants
PostPaymentIntentsIntentRequestBodyShipping'EmptyString
        | Bool
GHC.Base.otherwise -> case (PostPaymentIntentsIntentRequestBodyShipping'OneOf1
-> PostPaymentIntentsIntentRequestBodyShipping'Variants
PostPaymentIntentsIntentRequestBodyShipping'PostPaymentIntentsIntentRequestBodyShipping'OneOf1 (PostPaymentIntentsIntentRequestBodyShipping'OneOf1
 -> PostPaymentIntentsIntentRequestBodyShipping'Variants)
-> Result PostPaymentIntentsIntentRequestBodyShipping'OneOf1
-> Result PostPaymentIntentsIntentRequestBodyShipping'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value -> Result PostPaymentIntentsIntentRequestBodyShipping'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result PostPaymentIntentsIntentRequestBodyShipping'Variants
-> Result PostPaymentIntentsIntentRequestBodyShipping'Variants
-> Result PostPaymentIntentsIntentRequestBodyShipping'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result PostPaymentIntentsIntentRequestBodyShipping'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostPaymentIntentsIntentRequestBodyShipping'Variants
a -> PostPaymentIntentsIntentRequestBodyShipping'Variants
-> Parser PostPaymentIntentsIntentRequestBodyShipping'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostPaymentIntentsIntentRequestBodyShipping'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String
-> Parser PostPaymentIntentsIntentRequestBodyShipping'Variants
forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
a

-- | Defines the object schema located at @paths.\/v1\/payment_intents\/{intent}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.transfer_data@ in the specification.
--
-- The parameters used to automatically create a Transfer when the payment succeeds. For more information, see the PaymentIntents [use case for connected accounts](https:\/\/stripe.com\/docs\/payments\/connected-accounts).
data PostPaymentIntentsIntentRequestBodyTransferData' = PostPaymentIntentsIntentRequestBodyTransferData'
  { -- | amount
    PostPaymentIntentsIntentRequestBodyTransferData' -> Maybe Int
postPaymentIntentsIntentRequestBodyTransferData'Amount :: (GHC.Maybe.Maybe GHC.Types.Int)
  }
  deriving
    ( Int
-> PostPaymentIntentsIntentRequestBodyTransferData'
-> String
-> String
[PostPaymentIntentsIntentRequestBodyTransferData']
-> String -> String
PostPaymentIntentsIntentRequestBodyTransferData' -> String
(Int
 -> PostPaymentIntentsIntentRequestBodyTransferData'
 -> String
 -> String)
-> (PostPaymentIntentsIntentRequestBodyTransferData' -> String)
-> ([PostPaymentIntentsIntentRequestBodyTransferData']
    -> String -> String)
-> Show PostPaymentIntentsIntentRequestBodyTransferData'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentRequestBodyTransferData']
-> String -> String
$cshowList :: [PostPaymentIntentsIntentRequestBodyTransferData']
-> String -> String
show :: PostPaymentIntentsIntentRequestBodyTransferData' -> String
$cshow :: PostPaymentIntentsIntentRequestBodyTransferData' -> String
showsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyTransferData'
-> String
-> String
$cshowsPrec :: Int
-> PostPaymentIntentsIntentRequestBodyTransferData'
-> String
-> String
GHC.Show.Show,
      PostPaymentIntentsIntentRequestBodyTransferData'
-> PostPaymentIntentsIntentRequestBodyTransferData' -> Bool
(PostPaymentIntentsIntentRequestBodyTransferData'
 -> PostPaymentIntentsIntentRequestBodyTransferData' -> Bool)
-> (PostPaymentIntentsIntentRequestBodyTransferData'
    -> PostPaymentIntentsIntentRequestBodyTransferData' -> Bool)
-> Eq PostPaymentIntentsIntentRequestBodyTransferData'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentRequestBodyTransferData'
-> PostPaymentIntentsIntentRequestBodyTransferData' -> Bool
$c/= :: PostPaymentIntentsIntentRequestBodyTransferData'
-> PostPaymentIntentsIntentRequestBodyTransferData' -> Bool
== :: PostPaymentIntentsIntentRequestBodyTransferData'
-> PostPaymentIntentsIntentRequestBodyTransferData' -> Bool
$c== :: PostPaymentIntentsIntentRequestBodyTransferData'
-> PostPaymentIntentsIntentRequestBodyTransferData' -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPaymentIntentsIntentRequestBodyTransferData' where
  toJSON :: PostPaymentIntentsIntentRequestBodyTransferData' -> Value
toJSON PostPaymentIntentsIntentRequestBodyTransferData'
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..= PostPaymentIntentsIntentRequestBodyTransferData' -> Maybe Int
postPaymentIntentsIntentRequestBodyTransferData'Amount PostPaymentIntentsIntentRequestBodyTransferData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPaymentIntentsIntentRequestBodyTransferData' -> Encoding
toEncoding PostPaymentIntentsIntentRequestBodyTransferData'
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..= PostPaymentIntentsIntentRequestBodyTransferData' -> Maybe Int
postPaymentIntentsIntentRequestBodyTransferData'Amount PostPaymentIntentsIntentRequestBodyTransferData'
obj)

instance Data.Aeson.Types.FromJSON.FromJSON PostPaymentIntentsIntentRequestBodyTransferData' where
  parseJSON :: Value -> Parser PostPaymentIntentsIntentRequestBodyTransferData'
parseJSON = String
-> (Object
    -> Parser PostPaymentIntentsIntentRequestBodyTransferData')
-> Value
-> Parser PostPaymentIntentsIntentRequestBodyTransferData'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPaymentIntentsIntentRequestBodyTransferData'" (\Object
obj -> (Maybe Int -> PostPaymentIntentsIntentRequestBodyTransferData')
-> Parser
     (Maybe Int -> PostPaymentIntentsIntentRequestBodyTransferData')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Int -> PostPaymentIntentsIntentRequestBodyTransferData'
PostPaymentIntentsIntentRequestBodyTransferData' Parser
  (Maybe Int -> PostPaymentIntentsIntentRequestBodyTransferData')
-> Parser (Maybe Int)
-> Parser PostPaymentIntentsIntentRequestBodyTransferData'
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"))

-- | Create a new 'PostPaymentIntentsIntentRequestBodyTransferData'' with all required fields.
mkPostPaymentIntentsIntentRequestBodyTransferData' :: PostPaymentIntentsIntentRequestBodyTransferData'
mkPostPaymentIntentsIntentRequestBodyTransferData' :: PostPaymentIntentsIntentRequestBodyTransferData'
mkPostPaymentIntentsIntentRequestBodyTransferData' = PostPaymentIntentsIntentRequestBodyTransferData' :: Maybe Int -> PostPaymentIntentsIntentRequestBodyTransferData'
PostPaymentIntentsIntentRequestBodyTransferData' {postPaymentIntentsIntentRequestBodyTransferData'Amount :: Maybe Int
postPaymentIntentsIntentRequestBodyTransferData'Amount = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing}

-- | Represents a response of the operation 'postPaymentIntentsIntent'.
--
-- The response constructor is chosen by the status code of the response. If no case matches (no specific case for the response code, no range case, no default case), 'PostPaymentIntentsIntentResponseError' is used.
data PostPaymentIntentsIntentResponse
  = -- | Means either no matching case available or a parse error
    PostPaymentIntentsIntentResponseError GHC.Base.String
  | -- | Successful response.
    PostPaymentIntentsIntentResponse200 PaymentIntent
  | -- | Error response.
    PostPaymentIntentsIntentResponseDefault Error
  deriving (Int -> PostPaymentIntentsIntentResponse -> String -> String
[PostPaymentIntentsIntentResponse] -> String -> String
PostPaymentIntentsIntentResponse -> String
(Int -> PostPaymentIntentsIntentResponse -> String -> String)
-> (PostPaymentIntentsIntentResponse -> String)
-> ([PostPaymentIntentsIntentResponse] -> String -> String)
-> Show PostPaymentIntentsIntentResponse
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostPaymentIntentsIntentResponse] -> String -> String
$cshowList :: [PostPaymentIntentsIntentResponse] -> String -> String
show :: PostPaymentIntentsIntentResponse -> String
$cshow :: PostPaymentIntentsIntentResponse -> String
showsPrec :: Int -> PostPaymentIntentsIntentResponse -> String -> String
$cshowsPrec :: Int -> PostPaymentIntentsIntentResponse -> String -> String
GHC.Show.Show, PostPaymentIntentsIntentResponse
-> PostPaymentIntentsIntentResponse -> Bool
(PostPaymentIntentsIntentResponse
 -> PostPaymentIntentsIntentResponse -> Bool)
-> (PostPaymentIntentsIntentResponse
    -> PostPaymentIntentsIntentResponse -> Bool)
-> Eq PostPaymentIntentsIntentResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPaymentIntentsIntentResponse
-> PostPaymentIntentsIntentResponse -> Bool
$c/= :: PostPaymentIntentsIntentResponse
-> PostPaymentIntentsIntentResponse -> Bool
== :: PostPaymentIntentsIntentResponse
-> PostPaymentIntentsIntentResponse -> Bool
$c== :: PostPaymentIntentsIntentResponse
-> PostPaymentIntentsIntentResponse -> Bool
GHC.Classes.Eq)