{-# 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 SetupAttemptPaymentMethodDetailsIdeal
module StripeAPI.Types.SetupAttemptPaymentMethodDetailsIdeal 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.Mandate
import {-# SOURCE #-} StripeAPI.Types.PaymentMethod
import qualified Prelude as GHC.Integer.Type
import qualified Prelude as GHC.Maybe

-- | Defines the object schema located at @components.schemas.setup_attempt_payment_method_details_ideal@ in the specification.
data SetupAttemptPaymentMethodDetailsIdeal = SetupAttemptPaymentMethodDetailsIdeal
  { -- | bank: The customer\'s bank. Can be one of \`abn_amro\`, \`asn_bank\`, \`bunq\`, \`handelsbanken\`, \`ing\`, \`knab\`, \`moneyou\`, \`rabobank\`, \`regiobank\`, \`revolut\`, \`sns_bank\`, \`triodos_bank\`, or \`van_lanschot\`.
    SetupAttemptPaymentMethodDetailsIdeal
-> Maybe SetupAttemptPaymentMethodDetailsIdealBank'
setupAttemptPaymentMethodDetailsIdealBank :: (GHC.Maybe.Maybe SetupAttemptPaymentMethodDetailsIdealBank'),
    -- | bic: The Bank Identifier Code of the customer\'s bank.
    SetupAttemptPaymentMethodDetailsIdeal
-> Maybe SetupAttemptPaymentMethodDetailsIdealBic'
setupAttemptPaymentMethodDetailsIdealBic :: (GHC.Maybe.Maybe SetupAttemptPaymentMethodDetailsIdealBic'),
    -- | generated_sepa_debit: The ID of the SEPA Direct Debit PaymentMethod which was generated by this SetupAttempt.
    SetupAttemptPaymentMethodDetailsIdeal
-> Maybe
     SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
setupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit :: (GHC.Maybe.Maybe SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants),
    -- | generated_sepa_debit_mandate: The mandate for the SEPA Direct Debit PaymentMethod which was generated by this SetupAttempt.
    SetupAttemptPaymentMethodDetailsIdeal
-> Maybe
     SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
setupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate :: (GHC.Maybe.Maybe SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants),
    -- | iban_last4: Last four characters of the IBAN.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    SetupAttemptPaymentMethodDetailsIdeal -> Maybe Text
setupAttemptPaymentMethodDetailsIdealIbanLast4 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | verified_name: Owner\'s verified full name. Values are verified or provided by iDEAL directly
    -- (if supported) at the time of authorization or settlement. They cannot be set or mutated.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    SetupAttemptPaymentMethodDetailsIdeal -> Maybe Text
setupAttemptPaymentMethodDetailsIdealVerifiedName :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int -> SetupAttemptPaymentMethodDetailsIdeal -> ShowS
[SetupAttemptPaymentMethodDetailsIdeal] -> ShowS
SetupAttemptPaymentMethodDetailsIdeal -> String
(Int -> SetupAttemptPaymentMethodDetailsIdeal -> ShowS)
-> (SetupAttemptPaymentMethodDetailsIdeal -> String)
-> ([SetupAttemptPaymentMethodDetailsIdeal] -> ShowS)
-> Show SetupAttemptPaymentMethodDetailsIdeal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetupAttemptPaymentMethodDetailsIdeal] -> ShowS
$cshowList :: [SetupAttemptPaymentMethodDetailsIdeal] -> ShowS
show :: SetupAttemptPaymentMethodDetailsIdeal -> String
$cshow :: SetupAttemptPaymentMethodDetailsIdeal -> String
showsPrec :: Int -> SetupAttemptPaymentMethodDetailsIdeal -> ShowS
$cshowsPrec :: Int -> SetupAttemptPaymentMethodDetailsIdeal -> ShowS
GHC.Show.Show,
      SetupAttemptPaymentMethodDetailsIdeal
-> SetupAttemptPaymentMethodDetailsIdeal -> Bool
(SetupAttemptPaymentMethodDetailsIdeal
 -> SetupAttemptPaymentMethodDetailsIdeal -> Bool)
-> (SetupAttemptPaymentMethodDetailsIdeal
    -> SetupAttemptPaymentMethodDetailsIdeal -> Bool)
-> Eq SetupAttemptPaymentMethodDetailsIdeal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetupAttemptPaymentMethodDetailsIdeal
-> SetupAttemptPaymentMethodDetailsIdeal -> Bool
$c/= :: SetupAttemptPaymentMethodDetailsIdeal
-> SetupAttemptPaymentMethodDetailsIdeal -> Bool
== :: SetupAttemptPaymentMethodDetailsIdeal
-> SetupAttemptPaymentMethodDetailsIdeal -> Bool
$c== :: SetupAttemptPaymentMethodDetailsIdeal
-> SetupAttemptPaymentMethodDetailsIdeal -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON SetupAttemptPaymentMethodDetailsIdeal where
  toJSON :: SetupAttemptPaymentMethodDetailsIdeal -> Value
toJSON SetupAttemptPaymentMethodDetailsIdeal
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"bank" Text -> Maybe SetupAttemptPaymentMethodDetailsIdealBank' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= SetupAttemptPaymentMethodDetailsIdeal
-> Maybe SetupAttemptPaymentMethodDetailsIdealBank'
setupAttemptPaymentMethodDetailsIdealBank SetupAttemptPaymentMethodDetailsIdeal
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"bic" Text -> Maybe SetupAttemptPaymentMethodDetailsIdealBic' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= SetupAttemptPaymentMethodDetailsIdeal
-> Maybe SetupAttemptPaymentMethodDetailsIdealBic'
setupAttemptPaymentMethodDetailsIdealBic SetupAttemptPaymentMethodDetailsIdeal
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"generated_sepa_debit" Text
-> Maybe
     SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= SetupAttemptPaymentMethodDetailsIdeal
-> Maybe
     SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
setupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit SetupAttemptPaymentMethodDetailsIdeal
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"generated_sepa_debit_mandate" Text
-> Maybe
     SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= SetupAttemptPaymentMethodDetailsIdeal
-> Maybe
     SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
setupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate SetupAttemptPaymentMethodDetailsIdeal
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"iban_last4" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= SetupAttemptPaymentMethodDetailsIdeal -> Maybe Text
setupAttemptPaymentMethodDetailsIdealIbanLast4 SetupAttemptPaymentMethodDetailsIdeal
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"verified_name" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= SetupAttemptPaymentMethodDetailsIdeal -> Maybe Text
setupAttemptPaymentMethodDetailsIdealVerifiedName SetupAttemptPaymentMethodDetailsIdeal
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: SetupAttemptPaymentMethodDetailsIdeal -> Encoding
toEncoding SetupAttemptPaymentMethodDetailsIdeal
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"bank" Text -> Maybe SetupAttemptPaymentMethodDetailsIdealBank' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= SetupAttemptPaymentMethodDetailsIdeal
-> Maybe SetupAttemptPaymentMethodDetailsIdealBank'
setupAttemptPaymentMethodDetailsIdealBank SetupAttemptPaymentMethodDetailsIdeal
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"bic" Text -> Maybe SetupAttemptPaymentMethodDetailsIdealBic' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= SetupAttemptPaymentMethodDetailsIdeal
-> Maybe SetupAttemptPaymentMethodDetailsIdealBic'
setupAttemptPaymentMethodDetailsIdealBic SetupAttemptPaymentMethodDetailsIdeal
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"generated_sepa_debit" Text
-> Maybe
     SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= SetupAttemptPaymentMethodDetailsIdeal
-> Maybe
     SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
setupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit SetupAttemptPaymentMethodDetailsIdeal
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"generated_sepa_debit_mandate" Text
-> Maybe
     SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= SetupAttemptPaymentMethodDetailsIdeal
-> Maybe
     SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
setupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate SetupAttemptPaymentMethodDetailsIdeal
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"iban_last4" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= SetupAttemptPaymentMethodDetailsIdeal -> Maybe Text
setupAttemptPaymentMethodDetailsIdealIbanLast4 SetupAttemptPaymentMethodDetailsIdeal
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"verified_name" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= SetupAttemptPaymentMethodDetailsIdeal -> Maybe Text
setupAttemptPaymentMethodDetailsIdealVerifiedName SetupAttemptPaymentMethodDetailsIdeal
obj))))))

instance Data.Aeson.Types.FromJSON.FromJSON SetupAttemptPaymentMethodDetailsIdeal where
  parseJSON :: Value -> Parser SetupAttemptPaymentMethodDetailsIdeal
parseJSON = String
-> (Object -> Parser SetupAttemptPaymentMethodDetailsIdeal)
-> Value
-> Parser SetupAttemptPaymentMethodDetailsIdeal
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"SetupAttemptPaymentMethodDetailsIdeal" (\Object
obj -> ((((((Maybe SetupAttemptPaymentMethodDetailsIdealBank'
 -> Maybe SetupAttemptPaymentMethodDetailsIdealBic'
 -> Maybe
      SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
 -> Maybe
      SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
 -> Maybe Text
 -> Maybe Text
 -> SetupAttemptPaymentMethodDetailsIdeal)
-> Parser
     (Maybe SetupAttemptPaymentMethodDetailsIdealBank'
      -> Maybe SetupAttemptPaymentMethodDetailsIdealBic'
      -> Maybe
           SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
      -> Maybe
           SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
      -> Maybe Text
      -> Maybe Text
      -> SetupAttemptPaymentMethodDetailsIdeal)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe SetupAttemptPaymentMethodDetailsIdealBank'
-> Maybe SetupAttemptPaymentMethodDetailsIdealBic'
-> Maybe
     SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
-> Maybe
     SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
-> Maybe Text
-> Maybe Text
-> SetupAttemptPaymentMethodDetailsIdeal
SetupAttemptPaymentMethodDetailsIdeal Parser
  (Maybe SetupAttemptPaymentMethodDetailsIdealBank'
   -> Maybe SetupAttemptPaymentMethodDetailsIdealBic'
   -> Maybe
        SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
   -> Maybe
        SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
   -> Maybe Text
   -> Maybe Text
   -> SetupAttemptPaymentMethodDetailsIdeal)
-> Parser (Maybe SetupAttemptPaymentMethodDetailsIdealBank')
-> Parser
     (Maybe SetupAttemptPaymentMethodDetailsIdealBic'
      -> Maybe
           SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
      -> Maybe
           SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
      -> Maybe Text
      -> Maybe Text
      -> SetupAttemptPaymentMethodDetailsIdeal)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe SetupAttemptPaymentMethodDetailsIdealBank')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"bank")) Parser
  (Maybe SetupAttemptPaymentMethodDetailsIdealBic'
   -> Maybe
        SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
   -> Maybe
        SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
   -> Maybe Text
   -> Maybe Text
   -> SetupAttemptPaymentMethodDetailsIdeal)
-> Parser (Maybe SetupAttemptPaymentMethodDetailsIdealBic')
-> Parser
     (Maybe
        SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
      -> Maybe
           SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
      -> Maybe Text
      -> Maybe Text
      -> SetupAttemptPaymentMethodDetailsIdeal)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe SetupAttemptPaymentMethodDetailsIdealBic')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"bic")) Parser
  (Maybe
     SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
   -> Maybe
        SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
   -> Maybe Text
   -> Maybe Text
   -> SetupAttemptPaymentMethodDetailsIdeal)
-> Parser
     (Maybe
        SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants)
-> Parser
     (Maybe
        SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
      -> Maybe Text
      -> Maybe Text
      -> SetupAttemptPaymentMethodDetailsIdeal)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"generated_sepa_debit")) Parser
  (Maybe
     SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
   -> Maybe Text
   -> Maybe Text
   -> SetupAttemptPaymentMethodDetailsIdeal)
-> Parser
     (Maybe
        SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants)
-> Parser
     (Maybe Text -> Maybe Text -> SetupAttemptPaymentMethodDetailsIdeal)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"generated_sepa_debit_mandate")) Parser
  (Maybe Text -> Maybe Text -> SetupAttemptPaymentMethodDetailsIdeal)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> SetupAttemptPaymentMethodDetailsIdeal)
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
"iban_last4")) Parser (Maybe Text -> SetupAttemptPaymentMethodDetailsIdeal)
-> Parser (Maybe Text)
-> Parser SetupAttemptPaymentMethodDetailsIdeal
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
"verified_name"))

-- | Create a new 'SetupAttemptPaymentMethodDetailsIdeal' with all required fields.
mkSetupAttemptPaymentMethodDetailsIdeal :: SetupAttemptPaymentMethodDetailsIdeal
mkSetupAttemptPaymentMethodDetailsIdeal :: SetupAttemptPaymentMethodDetailsIdeal
mkSetupAttemptPaymentMethodDetailsIdeal =
  SetupAttemptPaymentMethodDetailsIdeal :: Maybe SetupAttemptPaymentMethodDetailsIdealBank'
-> Maybe SetupAttemptPaymentMethodDetailsIdealBic'
-> Maybe
     SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
-> Maybe
     SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
-> Maybe Text
-> Maybe Text
-> SetupAttemptPaymentMethodDetailsIdeal
SetupAttemptPaymentMethodDetailsIdeal
    { setupAttemptPaymentMethodDetailsIdealBank :: Maybe SetupAttemptPaymentMethodDetailsIdealBank'
setupAttemptPaymentMethodDetailsIdealBank = Maybe SetupAttemptPaymentMethodDetailsIdealBank'
forall a. Maybe a
GHC.Maybe.Nothing,
      setupAttemptPaymentMethodDetailsIdealBic :: Maybe SetupAttemptPaymentMethodDetailsIdealBic'
setupAttemptPaymentMethodDetailsIdealBic = Maybe SetupAttemptPaymentMethodDetailsIdealBic'
forall a. Maybe a
GHC.Maybe.Nothing,
      setupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit :: Maybe
  SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
setupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit = Maybe
  SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      setupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate :: Maybe
  SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
setupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate = Maybe
  SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      setupAttemptPaymentMethodDetailsIdealIbanLast4 :: Maybe Text
setupAttemptPaymentMethodDetailsIdealIbanLast4 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      setupAttemptPaymentMethodDetailsIdealVerifiedName :: Maybe Text
setupAttemptPaymentMethodDetailsIdealVerifiedName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the enum schema located at @components.schemas.setup_attempt_payment_method_details_ideal.properties.bank@ in the specification.
--
-- The customer\'s bank. Can be one of \`abn_amro\`, \`asn_bank\`, \`bunq\`, \`handelsbanken\`, \`ing\`, \`knab\`, \`moneyou\`, \`rabobank\`, \`regiobank\`, \`revolut\`, \`sns_bank\`, \`triodos_bank\`, or \`van_lanschot\`.
data SetupAttemptPaymentMethodDetailsIdealBank'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    SetupAttemptPaymentMethodDetailsIdealBank'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.
    SetupAttemptPaymentMethodDetailsIdealBank'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"abn_amro"@
    SetupAttemptPaymentMethodDetailsIdealBank'EnumAbnAmro
  | -- | Represents the JSON value @"asn_bank"@
    SetupAttemptPaymentMethodDetailsIdealBank'EnumAsnBank
  | -- | Represents the JSON value @"bunq"@
    SetupAttemptPaymentMethodDetailsIdealBank'EnumBunq
  | -- | Represents the JSON value @"handelsbanken"@
    SetupAttemptPaymentMethodDetailsIdealBank'EnumHandelsbanken
  | -- | Represents the JSON value @"ing"@
    SetupAttemptPaymentMethodDetailsIdealBank'EnumIng
  | -- | Represents the JSON value @"knab"@
    SetupAttemptPaymentMethodDetailsIdealBank'EnumKnab
  | -- | Represents the JSON value @"moneyou"@
    SetupAttemptPaymentMethodDetailsIdealBank'EnumMoneyou
  | -- | Represents the JSON value @"rabobank"@
    SetupAttemptPaymentMethodDetailsIdealBank'EnumRabobank
  | -- | Represents the JSON value @"regiobank"@
    SetupAttemptPaymentMethodDetailsIdealBank'EnumRegiobank
  | -- | Represents the JSON value @"revolut"@
    SetupAttemptPaymentMethodDetailsIdealBank'EnumRevolut
  | -- | Represents the JSON value @"sns_bank"@
    SetupAttemptPaymentMethodDetailsIdealBank'EnumSnsBank
  | -- | Represents the JSON value @"triodos_bank"@
    SetupAttemptPaymentMethodDetailsIdealBank'EnumTriodosBank
  | -- | Represents the JSON value @"van_lanschot"@
    SetupAttemptPaymentMethodDetailsIdealBank'EnumVanLanschot
  deriving (Int -> SetupAttemptPaymentMethodDetailsIdealBank' -> ShowS
[SetupAttemptPaymentMethodDetailsIdealBank'] -> ShowS
SetupAttemptPaymentMethodDetailsIdealBank' -> String
(Int -> SetupAttemptPaymentMethodDetailsIdealBank' -> ShowS)
-> (SetupAttemptPaymentMethodDetailsIdealBank' -> String)
-> ([SetupAttemptPaymentMethodDetailsIdealBank'] -> ShowS)
-> Show SetupAttemptPaymentMethodDetailsIdealBank'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetupAttemptPaymentMethodDetailsIdealBank'] -> ShowS
$cshowList :: [SetupAttemptPaymentMethodDetailsIdealBank'] -> ShowS
show :: SetupAttemptPaymentMethodDetailsIdealBank' -> String
$cshow :: SetupAttemptPaymentMethodDetailsIdealBank' -> String
showsPrec :: Int -> SetupAttemptPaymentMethodDetailsIdealBank' -> ShowS
$cshowsPrec :: Int -> SetupAttemptPaymentMethodDetailsIdealBank' -> ShowS
GHC.Show.Show, SetupAttemptPaymentMethodDetailsIdealBank'
-> SetupAttemptPaymentMethodDetailsIdealBank' -> Bool
(SetupAttemptPaymentMethodDetailsIdealBank'
 -> SetupAttemptPaymentMethodDetailsIdealBank' -> Bool)
-> (SetupAttemptPaymentMethodDetailsIdealBank'
    -> SetupAttemptPaymentMethodDetailsIdealBank' -> Bool)
-> Eq SetupAttemptPaymentMethodDetailsIdealBank'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetupAttemptPaymentMethodDetailsIdealBank'
-> SetupAttemptPaymentMethodDetailsIdealBank' -> Bool
$c/= :: SetupAttemptPaymentMethodDetailsIdealBank'
-> SetupAttemptPaymentMethodDetailsIdealBank' -> Bool
== :: SetupAttemptPaymentMethodDetailsIdealBank'
-> SetupAttemptPaymentMethodDetailsIdealBank' -> Bool
$c== :: SetupAttemptPaymentMethodDetailsIdealBank'
-> SetupAttemptPaymentMethodDetailsIdealBank' -> Bool
GHC.Classes.Eq)

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

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

-- | Defines the enum schema located at @components.schemas.setup_attempt_payment_method_details_ideal.properties.bic@ in the specification.
--
-- The Bank Identifier Code of the customer\'s bank.
data SetupAttemptPaymentMethodDetailsIdealBic'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    SetupAttemptPaymentMethodDetailsIdealBic'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.
    SetupAttemptPaymentMethodDetailsIdealBic'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"ABNANL2A"@
    SetupAttemptPaymentMethodDetailsIdealBic'EnumABNANL2A
  | -- | Represents the JSON value @"ASNBNL21"@
    SetupAttemptPaymentMethodDetailsIdealBic'EnumASNBNL21
  | -- | Represents the JSON value @"BUNQNL2A"@
    SetupAttemptPaymentMethodDetailsIdealBic'EnumBUNQNL2A
  | -- | Represents the JSON value @"FVLBNL22"@
    SetupAttemptPaymentMethodDetailsIdealBic'EnumFVLBNL22
  | -- | Represents the JSON value @"HANDNL2A"@
    SetupAttemptPaymentMethodDetailsIdealBic'EnumHANDNL2A
  | -- | Represents the JSON value @"INGBNL2A"@
    SetupAttemptPaymentMethodDetailsIdealBic'EnumINGBNL2A
  | -- | Represents the JSON value @"KNABNL2H"@
    SetupAttemptPaymentMethodDetailsIdealBic'EnumKNABNL2H
  | -- | Represents the JSON value @"MOYONL21"@
    SetupAttemptPaymentMethodDetailsIdealBic'EnumMOYONL21
  | -- | Represents the JSON value @"RABONL2U"@
    SetupAttemptPaymentMethodDetailsIdealBic'EnumRABONL2U
  | -- | Represents the JSON value @"RBRBNL21"@
    SetupAttemptPaymentMethodDetailsIdealBic'EnumRBRBNL21
  | -- | Represents the JSON value @"REVOLT21"@
    SetupAttemptPaymentMethodDetailsIdealBic'EnumREVOLT21
  | -- | Represents the JSON value @"SNSBNL2A"@
    SetupAttemptPaymentMethodDetailsIdealBic'EnumSNSBNL2A
  | -- | Represents the JSON value @"TRIONL2U"@
    SetupAttemptPaymentMethodDetailsIdealBic'EnumTRIONL2U
  deriving (Int -> SetupAttemptPaymentMethodDetailsIdealBic' -> ShowS
[SetupAttemptPaymentMethodDetailsIdealBic'] -> ShowS
SetupAttemptPaymentMethodDetailsIdealBic' -> String
(Int -> SetupAttemptPaymentMethodDetailsIdealBic' -> ShowS)
-> (SetupAttemptPaymentMethodDetailsIdealBic' -> String)
-> ([SetupAttemptPaymentMethodDetailsIdealBic'] -> ShowS)
-> Show SetupAttemptPaymentMethodDetailsIdealBic'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetupAttemptPaymentMethodDetailsIdealBic'] -> ShowS
$cshowList :: [SetupAttemptPaymentMethodDetailsIdealBic'] -> ShowS
show :: SetupAttemptPaymentMethodDetailsIdealBic' -> String
$cshow :: SetupAttemptPaymentMethodDetailsIdealBic' -> String
showsPrec :: Int -> SetupAttemptPaymentMethodDetailsIdealBic' -> ShowS
$cshowsPrec :: Int -> SetupAttemptPaymentMethodDetailsIdealBic' -> ShowS
GHC.Show.Show, SetupAttemptPaymentMethodDetailsIdealBic'
-> SetupAttemptPaymentMethodDetailsIdealBic' -> Bool
(SetupAttemptPaymentMethodDetailsIdealBic'
 -> SetupAttemptPaymentMethodDetailsIdealBic' -> Bool)
-> (SetupAttemptPaymentMethodDetailsIdealBic'
    -> SetupAttemptPaymentMethodDetailsIdealBic' -> Bool)
-> Eq SetupAttemptPaymentMethodDetailsIdealBic'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetupAttemptPaymentMethodDetailsIdealBic'
-> SetupAttemptPaymentMethodDetailsIdealBic' -> Bool
$c/= :: SetupAttemptPaymentMethodDetailsIdealBic'
-> SetupAttemptPaymentMethodDetailsIdealBic' -> Bool
== :: SetupAttemptPaymentMethodDetailsIdealBic'
-> SetupAttemptPaymentMethodDetailsIdealBic' -> Bool
$c== :: SetupAttemptPaymentMethodDetailsIdealBic'
-> SetupAttemptPaymentMethodDetailsIdealBic' -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON SetupAttemptPaymentMethodDetailsIdealBic' where
  toJSON :: SetupAttemptPaymentMethodDetailsIdealBic' -> Value
toJSON (SetupAttemptPaymentMethodDetailsIdealBic'Other Value
val) = Value
val
  toJSON (SetupAttemptPaymentMethodDetailsIdealBic'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (SetupAttemptPaymentMethodDetailsIdealBic'
SetupAttemptPaymentMethodDetailsIdealBic'EnumABNANL2A) = Value
"ABNANL2A"
  toJSON (SetupAttemptPaymentMethodDetailsIdealBic'
SetupAttemptPaymentMethodDetailsIdealBic'EnumASNBNL21) = Value
"ASNBNL21"
  toJSON (SetupAttemptPaymentMethodDetailsIdealBic'
SetupAttemptPaymentMethodDetailsIdealBic'EnumBUNQNL2A) = Value
"BUNQNL2A"
  toJSON (SetupAttemptPaymentMethodDetailsIdealBic'
SetupAttemptPaymentMethodDetailsIdealBic'EnumFVLBNL22) = Value
"FVLBNL22"
  toJSON (SetupAttemptPaymentMethodDetailsIdealBic'
SetupAttemptPaymentMethodDetailsIdealBic'EnumHANDNL2A) = Value
"HANDNL2A"
  toJSON (SetupAttemptPaymentMethodDetailsIdealBic'
SetupAttemptPaymentMethodDetailsIdealBic'EnumINGBNL2A) = Value
"INGBNL2A"
  toJSON (SetupAttemptPaymentMethodDetailsIdealBic'
SetupAttemptPaymentMethodDetailsIdealBic'EnumKNABNL2H) = Value
"KNABNL2H"
  toJSON (SetupAttemptPaymentMethodDetailsIdealBic'
SetupAttemptPaymentMethodDetailsIdealBic'EnumMOYONL21) = Value
"MOYONL21"
  toJSON (SetupAttemptPaymentMethodDetailsIdealBic'
SetupAttemptPaymentMethodDetailsIdealBic'EnumRABONL2U) = Value
"RABONL2U"
  toJSON (SetupAttemptPaymentMethodDetailsIdealBic'
SetupAttemptPaymentMethodDetailsIdealBic'EnumRBRBNL21) = Value
"RBRBNL21"
  toJSON (SetupAttemptPaymentMethodDetailsIdealBic'
SetupAttemptPaymentMethodDetailsIdealBic'EnumREVOLT21) = Value
"REVOLT21"
  toJSON (SetupAttemptPaymentMethodDetailsIdealBic'
SetupAttemptPaymentMethodDetailsIdealBic'EnumSNSBNL2A) = Value
"SNSBNL2A"
  toJSON (SetupAttemptPaymentMethodDetailsIdealBic'
SetupAttemptPaymentMethodDetailsIdealBic'EnumTRIONL2U) = Value
"TRIONL2U"

instance Data.Aeson.Types.FromJSON.FromJSON SetupAttemptPaymentMethodDetailsIdealBic' where
  parseJSON :: Value -> Parser SetupAttemptPaymentMethodDetailsIdealBic'
parseJSON Value
val =
    SetupAttemptPaymentMethodDetailsIdealBic'
-> Parser SetupAttemptPaymentMethodDetailsIdealBic'
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
"ABNANL2A" -> SetupAttemptPaymentMethodDetailsIdealBic'
SetupAttemptPaymentMethodDetailsIdealBic'EnumABNANL2A
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ASNBNL21" -> SetupAttemptPaymentMethodDetailsIdealBic'
SetupAttemptPaymentMethodDetailsIdealBic'EnumASNBNL21
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"BUNQNL2A" -> SetupAttemptPaymentMethodDetailsIdealBic'
SetupAttemptPaymentMethodDetailsIdealBic'EnumBUNQNL2A
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"FVLBNL22" -> SetupAttemptPaymentMethodDetailsIdealBic'
SetupAttemptPaymentMethodDetailsIdealBic'EnumFVLBNL22
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"HANDNL2A" -> SetupAttemptPaymentMethodDetailsIdealBic'
SetupAttemptPaymentMethodDetailsIdealBic'EnumHANDNL2A
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"INGBNL2A" -> SetupAttemptPaymentMethodDetailsIdealBic'
SetupAttemptPaymentMethodDetailsIdealBic'EnumINGBNL2A
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"KNABNL2H" -> SetupAttemptPaymentMethodDetailsIdealBic'
SetupAttemptPaymentMethodDetailsIdealBic'EnumKNABNL2H
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"MOYONL21" -> SetupAttemptPaymentMethodDetailsIdealBic'
SetupAttemptPaymentMethodDetailsIdealBic'EnumMOYONL21
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"RABONL2U" -> SetupAttemptPaymentMethodDetailsIdealBic'
SetupAttemptPaymentMethodDetailsIdealBic'EnumRABONL2U
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"RBRBNL21" -> SetupAttemptPaymentMethodDetailsIdealBic'
SetupAttemptPaymentMethodDetailsIdealBic'EnumRBRBNL21
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"REVOLT21" -> SetupAttemptPaymentMethodDetailsIdealBic'
SetupAttemptPaymentMethodDetailsIdealBic'EnumREVOLT21
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"SNSBNL2A" -> SetupAttemptPaymentMethodDetailsIdealBic'
SetupAttemptPaymentMethodDetailsIdealBic'EnumSNSBNL2A
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"TRIONL2U" -> SetupAttemptPaymentMethodDetailsIdealBic'
SetupAttemptPaymentMethodDetailsIdealBic'EnumTRIONL2U
            | Bool
GHC.Base.otherwise -> Value -> SetupAttemptPaymentMethodDetailsIdealBic'
SetupAttemptPaymentMethodDetailsIdealBic'Other Value
val
      )

-- | Defines the oneOf schema located at @components.schemas.setup_attempt_payment_method_details_ideal.properties.generated_sepa_debit.anyOf@ in the specification.
--
-- The ID of the SEPA Direct Debit PaymentMethod which was generated by this SetupAttempt.
data SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
  = SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Text Data.Text.Internal.Text
  | SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'PaymentMethod PaymentMethod
  deriving (Int
-> SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
-> ShowS
[SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants]
-> ShowS
SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
-> String
(Int
 -> SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
 -> ShowS)
-> (SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
    -> String)
-> ([SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants]
    -> ShowS)
-> Show
     SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants]
-> ShowS
$cshowList :: [SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants]
-> ShowS
show :: SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
-> String
$cshow :: SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
-> String
showsPrec :: Int
-> SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
-> ShowS
$cshowsPrec :: Int
-> SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
-> ShowS
GHC.Show.Show, SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
-> SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
-> Bool
(SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
 -> SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
 -> Bool)
-> (SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
    -> SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
    -> Bool)
-> Eq
     SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
-> SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
-> Bool
$c/= :: SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
-> SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
-> Bool
== :: SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
-> SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
-> Bool
$c== :: SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
-> SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebit'Variants
-> Bool
GHC.Classes.Eq)

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

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

-- | Defines the oneOf schema located at @components.schemas.setup_attempt_payment_method_details_ideal.properties.generated_sepa_debit_mandate.anyOf@ in the specification.
--
-- The mandate for the SEPA Direct Debit PaymentMethod which was generated by this SetupAttempt.
data SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
  = SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Text Data.Text.Internal.Text
  | SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Mandate Mandate
  deriving (Int
-> SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
-> ShowS
[SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants]
-> ShowS
SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
-> String
(Int
 -> SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
 -> ShowS)
-> (SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
    -> String)
-> ([SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants]
    -> ShowS)
-> Show
     SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants]
-> ShowS
$cshowList :: [SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants]
-> ShowS
show :: SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
-> String
$cshow :: SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
-> String
showsPrec :: Int
-> SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
-> ShowS
$cshowsPrec :: Int
-> SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
-> ShowS
GHC.Show.Show, SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
-> SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
-> Bool
(SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
 -> SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
 -> Bool)
-> (SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
    -> SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
    -> Bool)
-> Eq
     SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
-> SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
-> Bool
$c/= :: SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
-> SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
-> Bool
== :: SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
-> SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
-> Bool
$c== :: SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
-> SetupAttemptPaymentMethodDetailsIdealGeneratedSepaDebitMandate'Variants
-> Bool
GHC.Classes.Eq)

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

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