{-# 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 types generated from the schema PaymentIntentPaymentMethodOptions
module StripeAPI.Types.PaymentIntentPaymentMethodOptions where

import qualified Control.Monad.Fail
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.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 GHC.Base
import qualified GHC.Classes
import qualified GHC.Int
import qualified GHC.Show
import qualified GHC.Types
import qualified StripeAPI.Common
import StripeAPI.TypeAlias
import {-# SOURCE #-} StripeAPI.Types.PaymentIntentPaymentMethodOptionsAcssDebit
import {-# SOURCE #-} StripeAPI.Types.PaymentIntentPaymentMethodOptionsCard
import {-# SOURCE #-} StripeAPI.Types.PaymentIntentPaymentMethodOptionsSepaDebit
import {-# SOURCE #-} StripeAPI.Types.PaymentMethodOptionsAfterpayClearpay
import {-# SOURCE #-} StripeAPI.Types.PaymentMethodOptionsBancontact
import {-# SOURCE #-} StripeAPI.Types.PaymentMethodOptionsBoleto
import {-# SOURCE #-} StripeAPI.Types.PaymentMethodOptionsOxxo
import {-# SOURCE #-} StripeAPI.Types.PaymentMethodOptionsSofort
import qualified Prelude as GHC.Integer.Type
import qualified Prelude as GHC.Maybe

-- | Defines the object schema located at @components.schemas.payment_intent_payment_method_options@ in the specification.
data PaymentIntentPaymentMethodOptions = PaymentIntentPaymentMethodOptions
  { -- | acss_debit:
    PaymentIntentPaymentMethodOptions
-> Maybe PaymentIntentPaymentMethodOptionsAcssDebit
paymentIntentPaymentMethodOptionsAcssDebit :: (GHC.Maybe.Maybe PaymentIntentPaymentMethodOptionsAcssDebit),
    -- | afterpay_clearpay:
    PaymentIntentPaymentMethodOptions
-> Maybe PaymentMethodOptionsAfterpayClearpay
paymentIntentPaymentMethodOptionsAfterpayClearpay :: (GHC.Maybe.Maybe PaymentMethodOptionsAfterpayClearpay),
    -- | alipay:
    PaymentIntentPaymentMethodOptions
-> Maybe PaymentMethodOptionsAlipay
paymentIntentPaymentMethodOptionsAlipay :: (GHC.Maybe.Maybe PaymentMethodOptionsAlipay),
    -- | bancontact:
    PaymentIntentPaymentMethodOptions
-> Maybe PaymentMethodOptionsBancontact
paymentIntentPaymentMethodOptionsBancontact :: (GHC.Maybe.Maybe PaymentMethodOptionsBancontact),
    -- | boleto:
    PaymentIntentPaymentMethodOptions
-> Maybe PaymentMethodOptionsBoleto
paymentIntentPaymentMethodOptionsBoleto :: (GHC.Maybe.Maybe PaymentMethodOptionsBoleto),
    -- | card:
    PaymentIntentPaymentMethodOptions
-> Maybe PaymentIntentPaymentMethodOptionsCard
paymentIntentPaymentMethodOptionsCard :: (GHC.Maybe.Maybe PaymentIntentPaymentMethodOptionsCard),
    -- | card_present:
    PaymentIntentPaymentMethodOptions
-> Maybe PaymentMethodOptionsAlipay
paymentIntentPaymentMethodOptionsCardPresent :: (GHC.Maybe.Maybe PaymentMethodOptionsCardPresent),
    -- | oxxo:
    PaymentIntentPaymentMethodOptions -> Maybe PaymentMethodOptionsOxxo
paymentIntentPaymentMethodOptionsOxxo :: (GHC.Maybe.Maybe PaymentMethodOptionsOxxo),
    -- | p24:
    PaymentIntentPaymentMethodOptions
-> Maybe PaymentMethodOptionsAlipay
paymentIntentPaymentMethodOptionsP24 :: (GHC.Maybe.Maybe PaymentMethodOptionsP24),
    -- | sepa_debit:
    PaymentIntentPaymentMethodOptions
-> Maybe PaymentIntentPaymentMethodOptionsSepaDebit
paymentIntentPaymentMethodOptionsSepaDebit :: (GHC.Maybe.Maybe PaymentIntentPaymentMethodOptionsSepaDebit),
    -- | sofort:
    PaymentIntentPaymentMethodOptions
-> Maybe PaymentMethodOptionsSofort
paymentIntentPaymentMethodOptionsSofort :: (GHC.Maybe.Maybe PaymentMethodOptionsSofort)
  }
  deriving
    ( Int -> PaymentIntentPaymentMethodOptions -> ShowS
[PaymentIntentPaymentMethodOptions] -> ShowS
PaymentIntentPaymentMethodOptions -> String
(Int -> PaymentIntentPaymentMethodOptions -> ShowS)
-> (PaymentIntentPaymentMethodOptions -> String)
-> ([PaymentIntentPaymentMethodOptions] -> ShowS)
-> Show PaymentIntentPaymentMethodOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PaymentIntentPaymentMethodOptions] -> ShowS
$cshowList :: [PaymentIntentPaymentMethodOptions] -> ShowS
show :: PaymentIntentPaymentMethodOptions -> String
$cshow :: PaymentIntentPaymentMethodOptions -> String
showsPrec :: Int -> PaymentIntentPaymentMethodOptions -> ShowS
$cshowsPrec :: Int -> PaymentIntentPaymentMethodOptions -> ShowS
GHC.Show.Show,
      PaymentIntentPaymentMethodOptions
-> PaymentIntentPaymentMethodOptions -> Bool
(PaymentIntentPaymentMethodOptions
 -> PaymentIntentPaymentMethodOptions -> Bool)
-> (PaymentIntentPaymentMethodOptions
    -> PaymentIntentPaymentMethodOptions -> Bool)
-> Eq PaymentIntentPaymentMethodOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PaymentIntentPaymentMethodOptions
-> PaymentIntentPaymentMethodOptions -> Bool
$c/= :: PaymentIntentPaymentMethodOptions
-> PaymentIntentPaymentMethodOptions -> Bool
== :: PaymentIntentPaymentMethodOptions
-> PaymentIntentPaymentMethodOptions -> Bool
$c== :: PaymentIntentPaymentMethodOptions
-> PaymentIntentPaymentMethodOptions -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PaymentIntentPaymentMethodOptions where
  toJSON :: PaymentIntentPaymentMethodOptions -> Value
toJSON PaymentIntentPaymentMethodOptions
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"acss_debit" Text -> Maybe PaymentIntentPaymentMethodOptionsAcssDebit -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PaymentIntentPaymentMethodOptions
-> Maybe PaymentIntentPaymentMethodOptionsAcssDebit
paymentIntentPaymentMethodOptionsAcssDebit PaymentIntentPaymentMethodOptions
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"afterpay_clearpay" Text -> Maybe PaymentMethodOptionsAfterpayClearpay -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PaymentIntentPaymentMethodOptions
-> Maybe PaymentMethodOptionsAfterpayClearpay
paymentIntentPaymentMethodOptionsAfterpayClearpay PaymentIntentPaymentMethodOptions
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"alipay" Text -> Maybe PaymentMethodOptionsAlipay -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PaymentIntentPaymentMethodOptions
-> Maybe PaymentMethodOptionsAlipay
paymentIntentPaymentMethodOptionsAlipay PaymentIntentPaymentMethodOptions
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"bancontact" Text -> Maybe PaymentMethodOptionsBancontact -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PaymentIntentPaymentMethodOptions
-> Maybe PaymentMethodOptionsBancontact
paymentIntentPaymentMethodOptionsBancontact PaymentIntentPaymentMethodOptions
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"boleto" Text -> Maybe PaymentMethodOptionsBoleto -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PaymentIntentPaymentMethodOptions
-> Maybe PaymentMethodOptionsBoleto
paymentIntentPaymentMethodOptionsBoleto PaymentIntentPaymentMethodOptions
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"card" Text -> Maybe PaymentIntentPaymentMethodOptionsCard -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PaymentIntentPaymentMethodOptions
-> Maybe PaymentIntentPaymentMethodOptionsCard
paymentIntentPaymentMethodOptionsCard PaymentIntentPaymentMethodOptions
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"card_present" Text -> Maybe PaymentMethodOptionsAlipay -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PaymentIntentPaymentMethodOptions
-> Maybe PaymentMethodOptionsAlipay
paymentIntentPaymentMethodOptionsCardPresent PaymentIntentPaymentMethodOptions
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"oxxo" Text -> Maybe PaymentMethodOptionsOxxo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PaymentIntentPaymentMethodOptions -> Maybe PaymentMethodOptionsOxxo
paymentIntentPaymentMethodOptionsOxxo PaymentIntentPaymentMethodOptions
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"p24" Text -> Maybe PaymentMethodOptionsAlipay -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PaymentIntentPaymentMethodOptions
-> Maybe PaymentMethodOptionsAlipay
paymentIntentPaymentMethodOptionsP24 PaymentIntentPaymentMethodOptions
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"sepa_debit" Text -> Maybe PaymentIntentPaymentMethodOptionsSepaDebit -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PaymentIntentPaymentMethodOptions
-> Maybe PaymentIntentPaymentMethodOptionsSepaDebit
paymentIntentPaymentMethodOptionsSepaDebit PaymentIntentPaymentMethodOptions
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"sofort" Text -> Maybe PaymentMethodOptionsSofort -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PaymentIntentPaymentMethodOptions
-> Maybe PaymentMethodOptionsSofort
paymentIntentPaymentMethodOptionsSofort PaymentIntentPaymentMethodOptions
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PaymentIntentPaymentMethodOptions -> Encoding
toEncoding PaymentIntentPaymentMethodOptions
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"acss_debit" Text -> Maybe PaymentIntentPaymentMethodOptionsAcssDebit -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PaymentIntentPaymentMethodOptions
-> Maybe PaymentIntentPaymentMethodOptionsAcssDebit
paymentIntentPaymentMethodOptionsAcssDebit PaymentIntentPaymentMethodOptions
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"afterpay_clearpay" Text -> Maybe PaymentMethodOptionsAfterpayClearpay -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PaymentIntentPaymentMethodOptions
-> Maybe PaymentMethodOptionsAfterpayClearpay
paymentIntentPaymentMethodOptionsAfterpayClearpay PaymentIntentPaymentMethodOptions
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"alipay" Text -> Maybe PaymentMethodOptionsAlipay -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PaymentIntentPaymentMethodOptions
-> Maybe PaymentMethodOptionsAlipay
paymentIntentPaymentMethodOptionsAlipay PaymentIntentPaymentMethodOptions
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"bancontact" Text -> Maybe PaymentMethodOptionsBancontact -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PaymentIntentPaymentMethodOptions
-> Maybe PaymentMethodOptionsBancontact
paymentIntentPaymentMethodOptionsBancontact PaymentIntentPaymentMethodOptions
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"boleto" Text -> Maybe PaymentMethodOptionsBoleto -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PaymentIntentPaymentMethodOptions
-> Maybe PaymentMethodOptionsBoleto
paymentIntentPaymentMethodOptionsBoleto PaymentIntentPaymentMethodOptions
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"card" Text -> Maybe PaymentIntentPaymentMethodOptionsCard -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PaymentIntentPaymentMethodOptions
-> Maybe PaymentIntentPaymentMethodOptionsCard
paymentIntentPaymentMethodOptionsCard PaymentIntentPaymentMethodOptions
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"card_present" Text -> Maybe PaymentMethodOptionsAlipay -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PaymentIntentPaymentMethodOptions
-> Maybe PaymentMethodOptionsAlipay
paymentIntentPaymentMethodOptionsCardPresent PaymentIntentPaymentMethodOptions
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"oxxo" Text -> Maybe PaymentMethodOptionsOxxo -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PaymentIntentPaymentMethodOptions -> Maybe PaymentMethodOptionsOxxo
paymentIntentPaymentMethodOptionsOxxo PaymentIntentPaymentMethodOptions
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"p24" Text -> Maybe PaymentMethodOptionsAlipay -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PaymentIntentPaymentMethodOptions
-> Maybe PaymentMethodOptionsAlipay
paymentIntentPaymentMethodOptionsP24 PaymentIntentPaymentMethodOptions
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"sepa_debit" Text -> Maybe PaymentIntentPaymentMethodOptionsSepaDebit -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PaymentIntentPaymentMethodOptions
-> Maybe PaymentIntentPaymentMethodOptionsSepaDebit
paymentIntentPaymentMethodOptionsSepaDebit PaymentIntentPaymentMethodOptions
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"sofort" Text -> Maybe PaymentMethodOptionsSofort -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PaymentIntentPaymentMethodOptions
-> Maybe PaymentMethodOptionsSofort
paymentIntentPaymentMethodOptionsSofort PaymentIntentPaymentMethodOptions
obj)))))))))))

instance Data.Aeson.Types.FromJSON.FromJSON PaymentIntentPaymentMethodOptions where
  parseJSON :: Value -> Parser PaymentIntentPaymentMethodOptions
parseJSON = String
-> (PaymentMethodOptionsAlipay
    -> Parser PaymentIntentPaymentMethodOptions)
-> Value
-> Parser PaymentIntentPaymentMethodOptions
forall a.
String
-> (PaymentMethodOptionsAlipay -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PaymentIntentPaymentMethodOptions" (\PaymentMethodOptionsAlipay
obj -> (((((((((((Maybe PaymentIntentPaymentMethodOptionsAcssDebit
 -> Maybe PaymentMethodOptionsAfterpayClearpay
 -> Maybe PaymentMethodOptionsAlipay
 -> Maybe PaymentMethodOptionsBancontact
 -> Maybe PaymentMethodOptionsBoleto
 -> Maybe PaymentIntentPaymentMethodOptionsCard
 -> Maybe PaymentMethodOptionsAlipay
 -> Maybe PaymentMethodOptionsOxxo
 -> Maybe PaymentMethodOptionsAlipay
 -> Maybe PaymentIntentPaymentMethodOptionsSepaDebit
 -> Maybe PaymentMethodOptionsSofort
 -> PaymentIntentPaymentMethodOptions)
-> Parser
     (Maybe PaymentIntentPaymentMethodOptionsAcssDebit
      -> Maybe PaymentMethodOptionsAfterpayClearpay
      -> Maybe PaymentMethodOptionsAlipay
      -> Maybe PaymentMethodOptionsBancontact
      -> Maybe PaymentMethodOptionsBoleto
      -> Maybe PaymentIntentPaymentMethodOptionsCard
      -> Maybe PaymentMethodOptionsAlipay
      -> Maybe PaymentMethodOptionsOxxo
      -> Maybe PaymentMethodOptionsAlipay
      -> Maybe PaymentIntentPaymentMethodOptionsSepaDebit
      -> Maybe PaymentMethodOptionsSofort
      -> PaymentIntentPaymentMethodOptions)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe PaymentIntentPaymentMethodOptionsAcssDebit
-> Maybe PaymentMethodOptionsAfterpayClearpay
-> Maybe PaymentMethodOptionsAlipay
-> Maybe PaymentMethodOptionsBancontact
-> Maybe PaymentMethodOptionsBoleto
-> Maybe PaymentIntentPaymentMethodOptionsCard
-> Maybe PaymentMethodOptionsAlipay
-> Maybe PaymentMethodOptionsOxxo
-> Maybe PaymentMethodOptionsAlipay
-> Maybe PaymentIntentPaymentMethodOptionsSepaDebit
-> Maybe PaymentMethodOptionsSofort
-> PaymentIntentPaymentMethodOptions
PaymentIntentPaymentMethodOptions Parser
  (Maybe PaymentIntentPaymentMethodOptionsAcssDebit
   -> Maybe PaymentMethodOptionsAfterpayClearpay
   -> Maybe PaymentMethodOptionsAlipay
   -> Maybe PaymentMethodOptionsBancontact
   -> Maybe PaymentMethodOptionsBoleto
   -> Maybe PaymentIntentPaymentMethodOptionsCard
   -> Maybe PaymentMethodOptionsAlipay
   -> Maybe PaymentMethodOptionsOxxo
   -> Maybe PaymentMethodOptionsAlipay
   -> Maybe PaymentIntentPaymentMethodOptionsSepaDebit
   -> Maybe PaymentMethodOptionsSofort
   -> PaymentIntentPaymentMethodOptions)
-> Parser (Maybe PaymentIntentPaymentMethodOptionsAcssDebit)
-> Parser
     (Maybe PaymentMethodOptionsAfterpayClearpay
      -> Maybe PaymentMethodOptionsAlipay
      -> Maybe PaymentMethodOptionsBancontact
      -> Maybe PaymentMethodOptionsBoleto
      -> Maybe PaymentIntentPaymentMethodOptionsCard
      -> Maybe PaymentMethodOptionsAlipay
      -> Maybe PaymentMethodOptionsOxxo
      -> Maybe PaymentMethodOptionsAlipay
      -> Maybe PaymentIntentPaymentMethodOptionsSepaDebit
      -> Maybe PaymentMethodOptionsSofort
      -> PaymentIntentPaymentMethodOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (PaymentMethodOptionsAlipay
obj PaymentMethodOptionsAlipay
-> Text
-> Parser (Maybe PaymentIntentPaymentMethodOptionsAcssDebit)
forall a.
FromJSON a =>
PaymentMethodOptionsAlipay -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"acss_debit")) Parser
  (Maybe PaymentMethodOptionsAfterpayClearpay
   -> Maybe PaymentMethodOptionsAlipay
   -> Maybe PaymentMethodOptionsBancontact
   -> Maybe PaymentMethodOptionsBoleto
   -> Maybe PaymentIntentPaymentMethodOptionsCard
   -> Maybe PaymentMethodOptionsAlipay
   -> Maybe PaymentMethodOptionsOxxo
   -> Maybe PaymentMethodOptionsAlipay
   -> Maybe PaymentIntentPaymentMethodOptionsSepaDebit
   -> Maybe PaymentMethodOptionsSofort
   -> PaymentIntentPaymentMethodOptions)
-> Parser (Maybe PaymentMethodOptionsAfterpayClearpay)
-> Parser
     (Maybe PaymentMethodOptionsAlipay
      -> Maybe PaymentMethodOptionsBancontact
      -> Maybe PaymentMethodOptionsBoleto
      -> Maybe PaymentIntentPaymentMethodOptionsCard
      -> Maybe PaymentMethodOptionsAlipay
      -> Maybe PaymentMethodOptionsOxxo
      -> Maybe PaymentMethodOptionsAlipay
      -> Maybe PaymentIntentPaymentMethodOptionsSepaDebit
      -> Maybe PaymentMethodOptionsSofort
      -> PaymentIntentPaymentMethodOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (PaymentMethodOptionsAlipay
obj PaymentMethodOptionsAlipay
-> Text -> Parser (Maybe PaymentMethodOptionsAfterpayClearpay)
forall a.
FromJSON a =>
PaymentMethodOptionsAlipay -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"afterpay_clearpay")) Parser
  (Maybe PaymentMethodOptionsAlipay
   -> Maybe PaymentMethodOptionsBancontact
   -> Maybe PaymentMethodOptionsBoleto
   -> Maybe PaymentIntentPaymentMethodOptionsCard
   -> Maybe PaymentMethodOptionsAlipay
   -> Maybe PaymentMethodOptionsOxxo
   -> Maybe PaymentMethodOptionsAlipay
   -> Maybe PaymentIntentPaymentMethodOptionsSepaDebit
   -> Maybe PaymentMethodOptionsSofort
   -> PaymentIntentPaymentMethodOptions)
-> Parser (Maybe PaymentMethodOptionsAlipay)
-> Parser
     (Maybe PaymentMethodOptionsBancontact
      -> Maybe PaymentMethodOptionsBoleto
      -> Maybe PaymentIntentPaymentMethodOptionsCard
      -> Maybe PaymentMethodOptionsAlipay
      -> Maybe PaymentMethodOptionsOxxo
      -> Maybe PaymentMethodOptionsAlipay
      -> Maybe PaymentIntentPaymentMethodOptionsSepaDebit
      -> Maybe PaymentMethodOptionsSofort
      -> PaymentIntentPaymentMethodOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (PaymentMethodOptionsAlipay
obj PaymentMethodOptionsAlipay
-> Text -> Parser (Maybe PaymentMethodOptionsAlipay)
forall a.
FromJSON a =>
PaymentMethodOptionsAlipay -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"alipay")) Parser
  (Maybe PaymentMethodOptionsBancontact
   -> Maybe PaymentMethodOptionsBoleto
   -> Maybe PaymentIntentPaymentMethodOptionsCard
   -> Maybe PaymentMethodOptionsAlipay
   -> Maybe PaymentMethodOptionsOxxo
   -> Maybe PaymentMethodOptionsAlipay
   -> Maybe PaymentIntentPaymentMethodOptionsSepaDebit
   -> Maybe PaymentMethodOptionsSofort
   -> PaymentIntentPaymentMethodOptions)
-> Parser (Maybe PaymentMethodOptionsBancontact)
-> Parser
     (Maybe PaymentMethodOptionsBoleto
      -> Maybe PaymentIntentPaymentMethodOptionsCard
      -> Maybe PaymentMethodOptionsAlipay
      -> Maybe PaymentMethodOptionsOxxo
      -> Maybe PaymentMethodOptionsAlipay
      -> Maybe PaymentIntentPaymentMethodOptionsSepaDebit
      -> Maybe PaymentMethodOptionsSofort
      -> PaymentIntentPaymentMethodOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (PaymentMethodOptionsAlipay
obj PaymentMethodOptionsAlipay
-> Text -> Parser (Maybe PaymentMethodOptionsBancontact)
forall a.
FromJSON a =>
PaymentMethodOptionsAlipay -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"bancontact")) Parser
  (Maybe PaymentMethodOptionsBoleto
   -> Maybe PaymentIntentPaymentMethodOptionsCard
   -> Maybe PaymentMethodOptionsAlipay
   -> Maybe PaymentMethodOptionsOxxo
   -> Maybe PaymentMethodOptionsAlipay
   -> Maybe PaymentIntentPaymentMethodOptionsSepaDebit
   -> Maybe PaymentMethodOptionsSofort
   -> PaymentIntentPaymentMethodOptions)
-> Parser (Maybe PaymentMethodOptionsBoleto)
-> Parser
     (Maybe PaymentIntentPaymentMethodOptionsCard
      -> Maybe PaymentMethodOptionsAlipay
      -> Maybe PaymentMethodOptionsOxxo
      -> Maybe PaymentMethodOptionsAlipay
      -> Maybe PaymentIntentPaymentMethodOptionsSepaDebit
      -> Maybe PaymentMethodOptionsSofort
      -> PaymentIntentPaymentMethodOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (PaymentMethodOptionsAlipay
obj PaymentMethodOptionsAlipay
-> Text -> Parser (Maybe PaymentMethodOptionsBoleto)
forall a.
FromJSON a =>
PaymentMethodOptionsAlipay -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"boleto")) Parser
  (Maybe PaymentIntentPaymentMethodOptionsCard
   -> Maybe PaymentMethodOptionsAlipay
   -> Maybe PaymentMethodOptionsOxxo
   -> Maybe PaymentMethodOptionsAlipay
   -> Maybe PaymentIntentPaymentMethodOptionsSepaDebit
   -> Maybe PaymentMethodOptionsSofort
   -> PaymentIntentPaymentMethodOptions)
-> Parser (Maybe PaymentIntentPaymentMethodOptionsCard)
-> Parser
     (Maybe PaymentMethodOptionsAlipay
      -> Maybe PaymentMethodOptionsOxxo
      -> Maybe PaymentMethodOptionsAlipay
      -> Maybe PaymentIntentPaymentMethodOptionsSepaDebit
      -> Maybe PaymentMethodOptionsSofort
      -> PaymentIntentPaymentMethodOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (PaymentMethodOptionsAlipay
obj PaymentMethodOptionsAlipay
-> Text -> Parser (Maybe PaymentIntentPaymentMethodOptionsCard)
forall a.
FromJSON a =>
PaymentMethodOptionsAlipay -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"card")) Parser
  (Maybe PaymentMethodOptionsAlipay
   -> Maybe PaymentMethodOptionsOxxo
   -> Maybe PaymentMethodOptionsAlipay
   -> Maybe PaymentIntentPaymentMethodOptionsSepaDebit
   -> Maybe PaymentMethodOptionsSofort
   -> PaymentIntentPaymentMethodOptions)
-> Parser (Maybe PaymentMethodOptionsAlipay)
-> Parser
     (Maybe PaymentMethodOptionsOxxo
      -> Maybe PaymentMethodOptionsAlipay
      -> Maybe PaymentIntentPaymentMethodOptionsSepaDebit
      -> Maybe PaymentMethodOptionsSofort
      -> PaymentIntentPaymentMethodOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (PaymentMethodOptionsAlipay
obj PaymentMethodOptionsAlipay
-> Text -> Parser (Maybe PaymentMethodOptionsAlipay)
forall a.
FromJSON a =>
PaymentMethodOptionsAlipay -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"card_present")) Parser
  (Maybe PaymentMethodOptionsOxxo
   -> Maybe PaymentMethodOptionsAlipay
   -> Maybe PaymentIntentPaymentMethodOptionsSepaDebit
   -> Maybe PaymentMethodOptionsSofort
   -> PaymentIntentPaymentMethodOptions)
-> Parser (Maybe PaymentMethodOptionsOxxo)
-> Parser
     (Maybe PaymentMethodOptionsAlipay
      -> Maybe PaymentIntentPaymentMethodOptionsSepaDebit
      -> Maybe PaymentMethodOptionsSofort
      -> PaymentIntentPaymentMethodOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (PaymentMethodOptionsAlipay
obj PaymentMethodOptionsAlipay
-> Text -> Parser (Maybe PaymentMethodOptionsOxxo)
forall a.
FromJSON a =>
PaymentMethodOptionsAlipay -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"oxxo")) Parser
  (Maybe PaymentMethodOptionsAlipay
   -> Maybe PaymentIntentPaymentMethodOptionsSepaDebit
   -> Maybe PaymentMethodOptionsSofort
   -> PaymentIntentPaymentMethodOptions)
-> Parser (Maybe PaymentMethodOptionsAlipay)
-> Parser
     (Maybe PaymentIntentPaymentMethodOptionsSepaDebit
      -> Maybe PaymentMethodOptionsSofort
      -> PaymentIntentPaymentMethodOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (PaymentMethodOptionsAlipay
obj PaymentMethodOptionsAlipay
-> Text -> Parser (Maybe PaymentMethodOptionsAlipay)
forall a.
FromJSON a =>
PaymentMethodOptionsAlipay -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"p24")) Parser
  (Maybe PaymentIntentPaymentMethodOptionsSepaDebit
   -> Maybe PaymentMethodOptionsSofort
   -> PaymentIntentPaymentMethodOptions)
-> Parser (Maybe PaymentIntentPaymentMethodOptionsSepaDebit)
-> Parser
     (Maybe PaymentMethodOptionsSofort
      -> PaymentIntentPaymentMethodOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (PaymentMethodOptionsAlipay
obj PaymentMethodOptionsAlipay
-> Text
-> Parser (Maybe PaymentIntentPaymentMethodOptionsSepaDebit)
forall a.
FromJSON a =>
PaymentMethodOptionsAlipay -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"sepa_debit")) Parser
  (Maybe PaymentMethodOptionsSofort
   -> PaymentIntentPaymentMethodOptions)
-> Parser (Maybe PaymentMethodOptionsSofort)
-> Parser PaymentIntentPaymentMethodOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (PaymentMethodOptionsAlipay
obj PaymentMethodOptionsAlipay
-> Text -> Parser (Maybe PaymentMethodOptionsSofort)
forall a.
FromJSON a =>
PaymentMethodOptionsAlipay -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"sofort"))

-- | Create a new 'PaymentIntentPaymentMethodOptions' with all required fields.
mkPaymentIntentPaymentMethodOptions :: PaymentIntentPaymentMethodOptions
mkPaymentIntentPaymentMethodOptions :: PaymentIntentPaymentMethodOptions
mkPaymentIntentPaymentMethodOptions =
  PaymentIntentPaymentMethodOptions :: Maybe PaymentIntentPaymentMethodOptionsAcssDebit
-> Maybe PaymentMethodOptionsAfterpayClearpay
-> Maybe PaymentMethodOptionsAlipay
-> Maybe PaymentMethodOptionsBancontact
-> Maybe PaymentMethodOptionsBoleto
-> Maybe PaymentIntentPaymentMethodOptionsCard
-> Maybe PaymentMethodOptionsAlipay
-> Maybe PaymentMethodOptionsOxxo
-> Maybe PaymentMethodOptionsAlipay
-> Maybe PaymentIntentPaymentMethodOptionsSepaDebit
-> Maybe PaymentMethodOptionsSofort
-> PaymentIntentPaymentMethodOptions
PaymentIntentPaymentMethodOptions
    { paymentIntentPaymentMethodOptionsAcssDebit :: Maybe PaymentIntentPaymentMethodOptionsAcssDebit
paymentIntentPaymentMethodOptionsAcssDebit = Maybe PaymentIntentPaymentMethodOptionsAcssDebit
forall a. Maybe a
GHC.Maybe.Nothing,
      paymentIntentPaymentMethodOptionsAfterpayClearpay :: Maybe PaymentMethodOptionsAfterpayClearpay
paymentIntentPaymentMethodOptionsAfterpayClearpay = Maybe PaymentMethodOptionsAfterpayClearpay
forall a. Maybe a
GHC.Maybe.Nothing,
      paymentIntentPaymentMethodOptionsAlipay :: Maybe PaymentMethodOptionsAlipay
paymentIntentPaymentMethodOptionsAlipay = Maybe PaymentMethodOptionsAlipay
forall a. Maybe a
GHC.Maybe.Nothing,
      paymentIntentPaymentMethodOptionsBancontact :: Maybe PaymentMethodOptionsBancontact
paymentIntentPaymentMethodOptionsBancontact = Maybe PaymentMethodOptionsBancontact
forall a. Maybe a
GHC.Maybe.Nothing,
      paymentIntentPaymentMethodOptionsBoleto :: Maybe PaymentMethodOptionsBoleto
paymentIntentPaymentMethodOptionsBoleto = Maybe PaymentMethodOptionsBoleto
forall a. Maybe a
GHC.Maybe.Nothing,
      paymentIntentPaymentMethodOptionsCard :: Maybe PaymentIntentPaymentMethodOptionsCard
paymentIntentPaymentMethodOptionsCard = Maybe PaymentIntentPaymentMethodOptionsCard
forall a. Maybe a
GHC.Maybe.Nothing,
      paymentIntentPaymentMethodOptionsCardPresent :: Maybe PaymentMethodOptionsAlipay
paymentIntentPaymentMethodOptionsCardPresent = Maybe PaymentMethodOptionsAlipay
forall a. Maybe a
GHC.Maybe.Nothing,
      paymentIntentPaymentMethodOptionsOxxo :: Maybe PaymentMethodOptionsOxxo
paymentIntentPaymentMethodOptionsOxxo = Maybe PaymentMethodOptionsOxxo
forall a. Maybe a
GHC.Maybe.Nothing,
      paymentIntentPaymentMethodOptionsP24 :: Maybe PaymentMethodOptionsAlipay
paymentIntentPaymentMethodOptionsP24 = Maybe PaymentMethodOptionsAlipay
forall a. Maybe a
GHC.Maybe.Nothing,
      paymentIntentPaymentMethodOptionsSepaDebit :: Maybe PaymentIntentPaymentMethodOptionsSepaDebit
paymentIntentPaymentMethodOptionsSepaDebit = Maybe PaymentIntentPaymentMethodOptionsSepaDebit
forall a. Maybe a
GHC.Maybe.Nothing,
      paymentIntentPaymentMethodOptionsSofort :: Maybe PaymentMethodOptionsSofort
paymentIntentPaymentMethodOptionsSofort = Maybe PaymentMethodOptionsSofort
forall a. Maybe a
GHC.Maybe.Nothing
    }