{-# 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 postCustomersCustomerSourcesId
module StripeAPI.Operations.PostCustomersCustomerSourcesId 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/customers/{customer}/sources/{id}
--
-- \<p>Update a specified source for a given customer.\<\/p>
postCustomersCustomerSourcesId ::
  forall m.
  StripeAPI.Common.MonadHTTP m =>
  -- | Contains all available parameters of this operation (query and path parameters)
  PostCustomersCustomerSourcesIdParameters ->
  -- | The request body to send
  GHC.Maybe.Maybe PostCustomersCustomerSourcesIdRequestBody ->
  -- | Monadic computation which returns the result of the operation
  StripeAPI.Common.ClientT m (Network.HTTP.Client.Types.Response PostCustomersCustomerSourcesIdResponse)
postCustomersCustomerSourcesId :: PostCustomersCustomerSourcesIdParameters
-> Maybe PostCustomersCustomerSourcesIdRequestBody
-> ClientT m (Response PostCustomersCustomerSourcesIdResponse)
postCustomersCustomerSourcesId
  PostCustomersCustomerSourcesIdParameters
parameters
  Maybe PostCustomersCustomerSourcesIdRequestBody
body =
    (Response ByteString
 -> Response PostCustomersCustomerSourcesIdResponse)
-> ClientT m (Response ByteString)
-> ClientT m (Response PostCustomersCustomerSourcesIdResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
      ( \Response ByteString
response_0 ->
          (ByteString -> PostCustomersCustomerSourcesIdResponse)
-> Response ByteString
-> Response PostCustomersCustomerSourcesIdResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
            ( (String -> PostCustomersCustomerSourcesIdResponse)
-> (PostCustomersCustomerSourcesIdResponse
    -> PostCustomersCustomerSourcesIdResponse)
-> Either String PostCustomersCustomerSourcesIdResponse
-> PostCustomersCustomerSourcesIdResponse
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Data.Either.either String -> PostCustomersCustomerSourcesIdResponse
PostCustomersCustomerSourcesIdResponseError PostCustomersCustomerSourcesIdResponse
-> PostCustomersCustomerSourcesIdResponse
forall a. a -> a
GHC.Base.id
                (Either String PostCustomersCustomerSourcesIdResponse
 -> PostCustomersCustomerSourcesIdResponse)
-> (ByteString
    -> Either String PostCustomersCustomerSourcesIdResponse)
-> ByteString
-> PostCustomersCustomerSourcesIdResponse
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) ->
                                     PostCustomersCustomerSourcesIdResponseBody200
-> PostCustomersCustomerSourcesIdResponse
PostCustomersCustomerSourcesIdResponse200
                                       (PostCustomersCustomerSourcesIdResponseBody200
 -> PostCustomersCustomerSourcesIdResponse)
-> Either String PostCustomersCustomerSourcesIdResponseBody200
-> Either String PostCustomersCustomerSourcesIdResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> ( ByteString
-> Either String PostCustomersCustomerSourcesIdResponseBody200
forall a. FromJSON a => ByteString -> Either String a
Data.Aeson.eitherDecodeStrict ByteString
body ::
                                                            Data.Either.Either
                                                              GHC.Base.String
                                                              PostCustomersCustomerSourcesIdResponseBody200
                                                        )
                                   | 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 -> PostCustomersCustomerSourcesIdResponse
PostCustomersCustomerSourcesIdResponseDefault
                                       (Error -> PostCustomersCustomerSourcesIdResponse)
-> Either String Error
-> Either String PostCustomersCustomerSourcesIdResponse
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 PostCustomersCustomerSourcesIdResponse
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 PostCustomersCustomerSourcesIdRequestBody
-> 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/customers/" 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 (PostCustomersCustomerSourcesIdParameters -> Text
postCustomersCustomerSourcesIdParametersPathCustomer PostCustomersCustomerSourcesIdParameters
parameters))) String -> String -> String
forall a. [a] -> [a] -> [a]
GHC.Base.++ (String
"/sources/" 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 (PostCustomersCustomerSourcesIdParameters -> Text
postCustomersCustomerSourcesIdParametersPathId PostCustomersCustomerSourcesIdParameters
parameters))) String -> String -> String
forall a. [a] -> [a] -> [a]
GHC.Base.++ String
""))))) [QueryParameter]
forall a. Monoid a => a
GHC.Base.mempty Maybe PostCustomersCustomerSourcesIdRequestBody
body RequestBodyEncoding
StripeAPI.Common.RequestBodyEncodingFormData)

-- | Defines the object schema located at @paths.\/v1\/customers\/{customer}\/sources\/{id}.POST.parameters@ in the specification.
data PostCustomersCustomerSourcesIdParameters = PostCustomersCustomerSourcesIdParameters
  { -- | pathCustomer: Represents the parameter named \'customer\'
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdParameters -> Text
postCustomersCustomerSourcesIdParametersPathCustomer :: Data.Text.Internal.Text,
    -- | pathId: Represents the parameter named \'id\'
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdParameters -> Text
postCustomersCustomerSourcesIdParametersPathId :: Data.Text.Internal.Text
  }
  deriving
    ( Int -> PostCustomersCustomerSourcesIdParameters -> String -> String
[PostCustomersCustomerSourcesIdParameters] -> String -> String
PostCustomersCustomerSourcesIdParameters -> String
(Int
 -> PostCustomersCustomerSourcesIdParameters -> String -> String)
-> (PostCustomersCustomerSourcesIdParameters -> String)
-> ([PostCustomersCustomerSourcesIdParameters] -> String -> String)
-> Show PostCustomersCustomerSourcesIdParameters
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostCustomersCustomerSourcesIdParameters] -> String -> String
$cshowList :: [PostCustomersCustomerSourcesIdParameters] -> String -> String
show :: PostCustomersCustomerSourcesIdParameters -> String
$cshow :: PostCustomersCustomerSourcesIdParameters -> String
showsPrec :: Int -> PostCustomersCustomerSourcesIdParameters -> String -> String
$cshowsPrec :: Int -> PostCustomersCustomerSourcesIdParameters -> String -> String
GHC.Show.Show,
      PostCustomersCustomerSourcesIdParameters
-> PostCustomersCustomerSourcesIdParameters -> Bool
(PostCustomersCustomerSourcesIdParameters
 -> PostCustomersCustomerSourcesIdParameters -> Bool)
-> (PostCustomersCustomerSourcesIdParameters
    -> PostCustomersCustomerSourcesIdParameters -> Bool)
-> Eq PostCustomersCustomerSourcesIdParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersCustomerSourcesIdParameters
-> PostCustomersCustomerSourcesIdParameters -> Bool
$c/= :: PostCustomersCustomerSourcesIdParameters
-> PostCustomersCustomerSourcesIdParameters -> Bool
== :: PostCustomersCustomerSourcesIdParameters
-> PostCustomersCustomerSourcesIdParameters -> Bool
$c== :: PostCustomersCustomerSourcesIdParameters
-> PostCustomersCustomerSourcesIdParameters -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostCustomersCustomerSourcesIdParameters where
  toJSON :: PostCustomersCustomerSourcesIdParameters -> Value
toJSON PostCustomersCustomerSourcesIdParameters
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"pathCustomer" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdParameters -> Text
postCustomersCustomerSourcesIdParametersPathCustomer PostCustomersCustomerSourcesIdParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"pathId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdParameters -> Text
postCustomersCustomerSourcesIdParametersPathId PostCustomersCustomerSourcesIdParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostCustomersCustomerSourcesIdParameters -> Encoding
toEncoding PostCustomersCustomerSourcesIdParameters
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"pathCustomer" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdParameters -> Text
postCustomersCustomerSourcesIdParametersPathCustomer PostCustomersCustomerSourcesIdParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"pathId" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdParameters -> Text
postCustomersCustomerSourcesIdParametersPathId PostCustomersCustomerSourcesIdParameters
obj))

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

-- | Create a new 'PostCustomersCustomerSourcesIdParameters' with all required fields.
mkPostCustomersCustomerSourcesIdParameters ::
  -- | 'postCustomersCustomerSourcesIdParametersPathCustomer'
  Data.Text.Internal.Text ->
  -- | 'postCustomersCustomerSourcesIdParametersPathId'
  Data.Text.Internal.Text ->
  PostCustomersCustomerSourcesIdParameters
mkPostCustomersCustomerSourcesIdParameters :: Text -> Text -> PostCustomersCustomerSourcesIdParameters
mkPostCustomersCustomerSourcesIdParameters Text
postCustomersCustomerSourcesIdParametersPathCustomer Text
postCustomersCustomerSourcesIdParametersPathId =
  PostCustomersCustomerSourcesIdParameters :: Text -> Text -> PostCustomersCustomerSourcesIdParameters
PostCustomersCustomerSourcesIdParameters
    { postCustomersCustomerSourcesIdParametersPathCustomer :: Text
postCustomersCustomerSourcesIdParametersPathCustomer = Text
postCustomersCustomerSourcesIdParametersPathCustomer,
      postCustomersCustomerSourcesIdParametersPathId :: Text
postCustomersCustomerSourcesIdParametersPathId = Text
postCustomersCustomerSourcesIdParametersPathId
    }

-- | Defines the object schema located at @paths.\/v1\/customers\/{customer}\/sources\/{id}.POST.requestBody.content.application\/x-www-form-urlencoded.schema@ in the specification.
data PostCustomersCustomerSourcesIdRequestBody = PostCustomersCustomerSourcesIdRequestBody
  { -- | account_holder_name: The name of the person or business that owns the bank account.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyAccountHolderName :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | account_holder_type: The type of entity that holds the account. This can be either \`individual\` or \`company\`.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdRequestBody
-> Maybe
     PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
postCustomersCustomerSourcesIdRequestBodyAccountHolderType :: (GHC.Maybe.Maybe PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'),
    -- | address_city: City\/District\/Suburb\/Town\/Village.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyAddressCity :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | address_country: Billing address country, if provided when creating card.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyAddressCountry :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | address_line1: Address line 1 (Street address\/PO Box\/Company name).
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyAddressLine1 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | address_line2: Address line 2 (Apartment\/Suite\/Unit\/Building).
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyAddressLine2 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | address_state: State\/County\/Province\/Region.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyAddressState :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | address_zip: ZIP or postal code.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyAddressZip :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | exp_month: Two digit number representing the card’s expiration month.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyExpMonth :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | exp_year: Four digit number representing the card’s expiration year.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyExpYear :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | expand: Specifies which fields in the response should be expanded.
    PostCustomersCustomerSourcesIdRequestBody -> Maybe [Text]
postCustomersCustomerSourcesIdRequestBodyExpand :: (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\`.
    PostCustomersCustomerSourcesIdRequestBody
-> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
postCustomersCustomerSourcesIdRequestBodyMetadata :: (GHC.Maybe.Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants),
    -- | name: Cardholder name.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyName :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | owner
    PostCustomersCustomerSourcesIdRequestBody
-> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
postCustomersCustomerSourcesIdRequestBodyOwner :: (GHC.Maybe.Maybe PostCustomersCustomerSourcesIdRequestBodyOwner')
  }
  deriving
    ( Int
-> PostCustomersCustomerSourcesIdRequestBody -> String -> String
[PostCustomersCustomerSourcesIdRequestBody] -> String -> String
PostCustomersCustomerSourcesIdRequestBody -> String
(Int
 -> PostCustomersCustomerSourcesIdRequestBody -> String -> String)
-> (PostCustomersCustomerSourcesIdRequestBody -> String)
-> ([PostCustomersCustomerSourcesIdRequestBody]
    -> String -> String)
-> Show PostCustomersCustomerSourcesIdRequestBody
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostCustomersCustomerSourcesIdRequestBody] -> String -> String
$cshowList :: [PostCustomersCustomerSourcesIdRequestBody] -> String -> String
show :: PostCustomersCustomerSourcesIdRequestBody -> String
$cshow :: PostCustomersCustomerSourcesIdRequestBody -> String
showsPrec :: Int
-> PostCustomersCustomerSourcesIdRequestBody -> String -> String
$cshowsPrec :: Int
-> PostCustomersCustomerSourcesIdRequestBody -> String -> String
GHC.Show.Show,
      PostCustomersCustomerSourcesIdRequestBody
-> PostCustomersCustomerSourcesIdRequestBody -> Bool
(PostCustomersCustomerSourcesIdRequestBody
 -> PostCustomersCustomerSourcesIdRequestBody -> Bool)
-> (PostCustomersCustomerSourcesIdRequestBody
    -> PostCustomersCustomerSourcesIdRequestBody -> Bool)
-> Eq PostCustomersCustomerSourcesIdRequestBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersCustomerSourcesIdRequestBody
-> PostCustomersCustomerSourcesIdRequestBody -> Bool
$c/= :: PostCustomersCustomerSourcesIdRequestBody
-> PostCustomersCustomerSourcesIdRequestBody -> Bool
== :: PostCustomersCustomerSourcesIdRequestBody
-> PostCustomersCustomerSourcesIdRequestBody -> Bool
$c== :: PostCustomersCustomerSourcesIdRequestBody
-> PostCustomersCustomerSourcesIdRequestBody -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostCustomersCustomerSourcesIdRequestBody where
  toJSON :: PostCustomersCustomerSourcesIdRequestBody -> Value
toJSON PostCustomersCustomerSourcesIdRequestBody
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"account_holder_name" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyAccountHolderName PostCustomersCustomerSourcesIdRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"account_holder_type" Text
-> Maybe
     PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBody
-> Maybe
     PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
postCustomersCustomerSourcesIdRequestBodyAccountHolderType PostCustomersCustomerSourcesIdRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_city" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyAddressCity PostCustomersCustomerSourcesIdRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_country" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyAddressCountry PostCustomersCustomerSourcesIdRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_line1" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyAddressLine1 PostCustomersCustomerSourcesIdRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_line2" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyAddressLine2 PostCustomersCustomerSourcesIdRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_state" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyAddressState PostCustomersCustomerSourcesIdRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_zip" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyAddressZip PostCustomersCustomerSourcesIdRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"exp_month" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyExpMonth PostCustomersCustomerSourcesIdRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"exp_year" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyExpYear PostCustomersCustomerSourcesIdRequestBody
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..= PostCustomersCustomerSourcesIdRequestBody -> Maybe [Text]
postCustomersCustomerSourcesIdRequestBodyExpand PostCustomersCustomerSourcesIdRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"metadata" Text
-> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBody
-> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
postCustomersCustomerSourcesIdRequestBodyMetadata PostCustomersCustomerSourcesIdRequestBody
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..= PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyName PostCustomersCustomerSourcesIdRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"owner" Text
-> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBody
-> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
postCustomersCustomerSourcesIdRequestBodyOwner PostCustomersCustomerSourcesIdRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostCustomersCustomerSourcesIdRequestBody -> Encoding
toEncoding PostCustomersCustomerSourcesIdRequestBody
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"account_holder_name" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyAccountHolderName PostCustomersCustomerSourcesIdRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"account_holder_type" Text
-> Maybe
     PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBody
-> Maybe
     PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
postCustomersCustomerSourcesIdRequestBodyAccountHolderType PostCustomersCustomerSourcesIdRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_city" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyAddressCity PostCustomersCustomerSourcesIdRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_country" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyAddressCountry PostCustomersCustomerSourcesIdRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_line1" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyAddressLine1 PostCustomersCustomerSourcesIdRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_line2" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyAddressLine2 PostCustomersCustomerSourcesIdRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_state" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyAddressState PostCustomersCustomerSourcesIdRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_zip" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyAddressZip PostCustomersCustomerSourcesIdRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"exp_month" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyExpMonth PostCustomersCustomerSourcesIdRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"exp_year" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyExpYear PostCustomersCustomerSourcesIdRequestBody
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..= PostCustomersCustomerSourcesIdRequestBody -> Maybe [Text]
postCustomersCustomerSourcesIdRequestBodyExpand PostCustomersCustomerSourcesIdRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"metadata" Text
-> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBody
-> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
postCustomersCustomerSourcesIdRequestBodyMetadata PostCustomersCustomerSourcesIdRequestBody
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..= PostCustomersCustomerSourcesIdRequestBody -> Maybe Text
postCustomersCustomerSourcesIdRequestBodyName PostCustomersCustomerSourcesIdRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"owner" Text
-> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBody
-> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
postCustomersCustomerSourcesIdRequestBodyOwner PostCustomersCustomerSourcesIdRequestBody
obj))))))))))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersCustomerSourcesIdRequestBody where
  parseJSON :: Value -> Parser PostCustomersCustomerSourcesIdRequestBody
parseJSON = String
-> (Object -> Parser PostCustomersCustomerSourcesIdRequestBody)
-> Value
-> Parser PostCustomersCustomerSourcesIdRequestBody
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostCustomersCustomerSourcesIdRequestBody" (\Object
obj -> ((((((((((((((Maybe Text
 -> Maybe
      PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
 -> Maybe Text
 -> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
 -> PostCustomersCustomerSourcesIdRequestBody)
-> Parser
     (Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
      -> PostCustomersCustomerSourcesIdRequestBody)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe
     PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
-> Maybe Text
-> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
-> PostCustomersCustomerSourcesIdRequestBody
PostCustomersCustomerSourcesIdRequestBody Parser
  (Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
   -> PostCustomersCustomerSourcesIdRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
      -> PostCustomersCustomerSourcesIdRequestBody)
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_holder_name")) Parser
  (Maybe PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
   -> PostCustomersCustomerSourcesIdRequestBody)
-> Parser
     (Maybe PostCustomersCustomerSourcesIdRequestBodyAccountHolderType')
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
      -> PostCustomersCustomerSourcesIdRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostCustomersCustomerSourcesIdRequestBodyAccountHolderType')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"account_holder_type")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
   -> PostCustomersCustomerSourcesIdRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
      -> PostCustomersCustomerSourcesIdRequestBody)
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
"address_city")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
   -> PostCustomersCustomerSourcesIdRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
      -> PostCustomersCustomerSourcesIdRequestBody)
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
"address_country")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
   -> PostCustomersCustomerSourcesIdRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
      -> PostCustomersCustomerSourcesIdRequestBody)
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
"address_line1")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
   -> PostCustomersCustomerSourcesIdRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
      -> PostCustomersCustomerSourcesIdRequestBody)
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
"address_line2")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
   -> PostCustomersCustomerSourcesIdRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
      -> PostCustomersCustomerSourcesIdRequestBody)
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
"address_state")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
   -> PostCustomersCustomerSourcesIdRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
      -> PostCustomersCustomerSourcesIdRequestBody)
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
"address_zip")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
   -> PostCustomersCustomerSourcesIdRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
      -> PostCustomersCustomerSourcesIdRequestBody)
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
"exp_month")) Parser
  (Maybe Text
   -> Maybe [Text]
   -> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
   -> PostCustomersCustomerSourcesIdRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text]
      -> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
      -> PostCustomersCustomerSourcesIdRequestBody)
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
"exp_year")) Parser
  (Maybe [Text]
   -> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
   -> PostCustomersCustomerSourcesIdRequestBody)
-> Parser (Maybe [Text])
-> Parser
     (Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
      -> PostCustomersCustomerSourcesIdRequestBody)
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 PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
   -> PostCustomersCustomerSourcesIdRequestBody)
-> Parser
     (Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants)
-> Parser
     (Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
      -> PostCustomersCustomerSourcesIdRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"metadata")) Parser
  (Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
   -> PostCustomersCustomerSourcesIdRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
      -> PostCustomersCustomerSourcesIdRequestBody)
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 PostCustomersCustomerSourcesIdRequestBodyOwner'
   -> PostCustomersCustomerSourcesIdRequestBody)
-> Parser (Maybe PostCustomersCustomerSourcesIdRequestBodyOwner')
-> Parser PostCustomersCustomerSourcesIdRequestBody
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostCustomersCustomerSourcesIdRequestBodyOwner')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"owner"))

-- | Create a new 'PostCustomersCustomerSourcesIdRequestBody' with all required fields.
mkPostCustomersCustomerSourcesIdRequestBody :: PostCustomersCustomerSourcesIdRequestBody
mkPostCustomersCustomerSourcesIdRequestBody :: PostCustomersCustomerSourcesIdRequestBody
mkPostCustomersCustomerSourcesIdRequestBody =
  PostCustomersCustomerSourcesIdRequestBody :: Maybe Text
-> Maybe
     PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
-> Maybe Text
-> Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
-> PostCustomersCustomerSourcesIdRequestBody
PostCustomersCustomerSourcesIdRequestBody
    { postCustomersCustomerSourcesIdRequestBodyAccountHolderName :: Maybe Text
postCustomersCustomerSourcesIdRequestBodyAccountHolderName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdRequestBodyAccountHolderType :: Maybe PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
postCustomersCustomerSourcesIdRequestBodyAccountHolderType = Maybe PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdRequestBodyAddressCity :: Maybe Text
postCustomersCustomerSourcesIdRequestBodyAddressCity = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdRequestBodyAddressCountry :: Maybe Text
postCustomersCustomerSourcesIdRequestBodyAddressCountry = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdRequestBodyAddressLine1 :: Maybe Text
postCustomersCustomerSourcesIdRequestBodyAddressLine1 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdRequestBodyAddressLine2 :: Maybe Text
postCustomersCustomerSourcesIdRequestBodyAddressLine2 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdRequestBodyAddressState :: Maybe Text
postCustomersCustomerSourcesIdRequestBodyAddressState = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdRequestBodyAddressZip :: Maybe Text
postCustomersCustomerSourcesIdRequestBodyAddressZip = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdRequestBodyExpMonth :: Maybe Text
postCustomersCustomerSourcesIdRequestBodyExpMonth = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdRequestBodyExpYear :: Maybe Text
postCustomersCustomerSourcesIdRequestBodyExpYear = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdRequestBodyExpand :: Maybe [Text]
postCustomersCustomerSourcesIdRequestBodyExpand = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdRequestBodyMetadata :: Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
postCustomersCustomerSourcesIdRequestBodyMetadata = Maybe PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdRequestBodyName :: Maybe Text
postCustomersCustomerSourcesIdRequestBodyName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdRequestBodyOwner :: Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
postCustomersCustomerSourcesIdRequestBodyOwner = Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the enum schema located at @paths.\/v1\/customers\/{customer}\/sources\/{id}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.account_holder_type@ in the specification.
--
-- The type of entity that holds the account. This can be either \`individual\` or \`company\`.
data PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'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.
    PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"company"@
    PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'EnumCompany
  | -- | Represents the JSON value @"individual"@
    PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'EnumIndividual
  deriving (Int
-> PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
-> String
-> String
[PostCustomersCustomerSourcesIdRequestBodyAccountHolderType']
-> String -> String
PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
-> String
(Int
 -> PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
 -> String
 -> String)
-> (PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
    -> String)
-> ([PostCustomersCustomerSourcesIdRequestBodyAccountHolderType']
    -> String -> String)
-> Show PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostCustomersCustomerSourcesIdRequestBodyAccountHolderType']
-> String -> String
$cshowList :: [PostCustomersCustomerSourcesIdRequestBodyAccountHolderType']
-> String -> String
show :: PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
-> String
$cshow :: PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
-> String
showsPrec :: Int
-> PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
-> String
-> String
$cshowsPrec :: Int
-> PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
-> String
-> String
GHC.Show.Show, PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
-> PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
-> Bool
(PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
 -> PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
 -> Bool)
-> (PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
    -> PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
    -> Bool)
-> Eq PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
-> PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
-> Bool
$c/= :: PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
-> PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
-> Bool
== :: PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
-> PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
-> Bool
$c== :: PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
-> PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostCustomersCustomerSourcesIdRequestBodyAccountHolderType' where
  toJSON :: PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
-> Value
toJSON (PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'Other Value
val) = Value
val
  toJSON (PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'EnumCompany) = Value
"company"
  toJSON (PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'EnumIndividual) = Value
"individual"

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersCustomerSourcesIdRequestBodyAccountHolderType' where
  parseJSON :: Value
-> Parser
     PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
parseJSON Value
val =
    PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
-> Parser
     PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
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
"company" -> PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'EnumCompany
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"individual" -> PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'EnumIndividual
            | Bool
GHC.Base.otherwise -> Value
-> PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'
PostCustomersCustomerSourcesIdRequestBodyAccountHolderType'Other Value
val
      )

-- | Defines the oneOf schema located at @paths.\/v1\/customers\/{customer}\/sources\/{id}.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 PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
  = -- | Represents the JSON value @""@
    PostCustomersCustomerSourcesIdRequestBodyMetadata'EmptyString
  | PostCustomersCustomerSourcesIdRequestBodyMetadata'Object Data.Aeson.Types.Internal.Object
  deriving (Int
-> PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
-> String
-> String
[PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants]
-> String -> String
PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
-> String
(Int
 -> PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
 -> String
 -> String)
-> (PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
    -> String)
-> ([PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants]
    -> String -> String)
-> Show PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants]
-> String -> String
$cshowList :: [PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants]
-> String -> String
show :: PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
-> String
$cshow :: PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
-> String
showsPrec :: Int
-> PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
-> String
-> String
GHC.Show.Show, PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
-> PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
-> Bool
(PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
 -> PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
 -> Bool)
-> (PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
    -> PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
    -> Bool)
-> Eq PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
-> PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
-> Bool
$c/= :: PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
-> PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
-> Bool
== :: PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
-> PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
-> Bool
$c== :: PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
-> PostCustomersCustomerSourcesIdRequestBodyMetadata'Variants
-> Bool
GHC.Classes.Eq)

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

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

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

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

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersCustomerSourcesIdRequestBodyOwner' where
  parseJSON :: Value -> Parser PostCustomersCustomerSourcesIdRequestBodyOwner'
parseJSON = String
-> (Object
    -> Parser PostCustomersCustomerSourcesIdRequestBodyOwner')
-> Value
-> Parser PostCustomersCustomerSourcesIdRequestBodyOwner'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostCustomersCustomerSourcesIdRequestBodyOwner'" (\Object
obj -> ((((Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> PostCustomersCustomerSourcesIdRequestBodyOwner')
-> Parser
     (Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostCustomersCustomerSourcesIdRequestBodyOwner')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostCustomersCustomerSourcesIdRequestBodyOwner'
PostCustomersCustomerSourcesIdRequestBodyOwner' Parser
  (Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostCustomersCustomerSourcesIdRequestBodyOwner')
-> Parser
     (Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'Address')
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostCustomersCustomerSourcesIdRequestBodyOwner')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'Address')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostCustomersCustomerSourcesIdRequestBodyOwner')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text -> PostCustomersCustomerSourcesIdRequestBodyOwner')
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 -> PostCustomersCustomerSourcesIdRequestBodyOwner')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> PostCustomersCustomerSourcesIdRequestBodyOwner')
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 -> PostCustomersCustomerSourcesIdRequestBodyOwner')
-> Parser (Maybe Text)
-> Parser PostCustomersCustomerSourcesIdRequestBodyOwner'
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 'PostCustomersCustomerSourcesIdRequestBodyOwner'' with all required fields.
mkPostCustomersCustomerSourcesIdRequestBodyOwner' :: PostCustomersCustomerSourcesIdRequestBodyOwner'
mkPostCustomersCustomerSourcesIdRequestBodyOwner' :: PostCustomersCustomerSourcesIdRequestBodyOwner'
mkPostCustomersCustomerSourcesIdRequestBodyOwner' =
  PostCustomersCustomerSourcesIdRequestBodyOwner' :: Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostCustomersCustomerSourcesIdRequestBodyOwner'
PostCustomersCustomerSourcesIdRequestBodyOwner'
    { postCustomersCustomerSourcesIdRequestBodyOwner'Address :: Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
postCustomersCustomerSourcesIdRequestBodyOwner'Address = Maybe PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdRequestBodyOwner'Email :: Maybe Text
postCustomersCustomerSourcesIdRequestBodyOwner'Email = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdRequestBodyOwner'Name :: Maybe Text
postCustomersCustomerSourcesIdRequestBodyOwner'Name = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdRequestBodyOwner'Phone :: Maybe Text
postCustomersCustomerSourcesIdRequestBodyOwner'Phone = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

instance Data.Aeson.Types.ToJSON.ToJSON PostCustomersCustomerSourcesIdRequestBodyOwner'Address' where
  toJSON :: PostCustomersCustomerSourcesIdRequestBodyOwner'Address' -> Value
toJSON PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"city" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdRequestBodyOwner'Address'City PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"country" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdRequestBodyOwner'Address'Country PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
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..= PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdRequestBodyOwner'Address'Line1 PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"line2" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdRequestBodyOwner'Address'Line2 PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"postal_code" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdRequestBodyOwner'Address'PostalCode PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"state" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdRequestBodyOwner'Address'State PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostCustomersCustomerSourcesIdRequestBodyOwner'Address' -> Encoding
toEncoding PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"city" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdRequestBodyOwner'Address'City PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"country" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdRequestBodyOwner'Address'Country PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
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..= PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdRequestBodyOwner'Address'Line1 PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"line2" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdRequestBodyOwner'Address'Line2 PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"postal_code" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdRequestBodyOwner'Address'PostalCode PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"state" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdRequestBodyOwner'Address'State PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
obj))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersCustomerSourcesIdRequestBodyOwner'Address' where
  parseJSON :: Value
-> Parser PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
parseJSON = String
-> (Object
    -> Parser PostCustomersCustomerSourcesIdRequestBodyOwner'Address')
-> Value
-> Parser PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostCustomersCustomerSourcesIdRequestBodyOwner'Address'" (\Object
obj -> ((((((Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> PostCustomersCustomerSourcesIdRequestBodyOwner'Address')
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostCustomersCustomerSourcesIdRequestBodyOwner'Address')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
PostCustomersCustomerSourcesIdRequestBodyOwner'Address' Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostCustomersCustomerSourcesIdRequestBodyOwner'Address')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostCustomersCustomerSourcesIdRequestBodyOwner'Address')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"city")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostCustomersCustomerSourcesIdRequestBodyOwner'Address')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostCustomersCustomerSourcesIdRequestBodyOwner'Address')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"country")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostCustomersCustomerSourcesIdRequestBodyOwner'Address')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostCustomersCustomerSourcesIdRequestBodyOwner'Address')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"line1")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostCustomersCustomerSourcesIdRequestBodyOwner'Address')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> PostCustomersCustomerSourcesIdRequestBodyOwner'Address')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"line2")) Parser
  (Maybe Text
   -> Maybe Text
   -> PostCustomersCustomerSourcesIdRequestBodyOwner'Address')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> PostCustomersCustomerSourcesIdRequestBodyOwner'Address')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"postal_code")) Parser
  (Maybe Text
   -> PostCustomersCustomerSourcesIdRequestBodyOwner'Address')
-> Parser (Maybe Text)
-> Parser PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"state"))

-- | Create a new 'PostCustomersCustomerSourcesIdRequestBodyOwner'Address'' with all required fields.
mkPostCustomersCustomerSourcesIdRequestBodyOwner'Address' :: PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
mkPostCustomersCustomerSourcesIdRequestBodyOwner'Address' :: PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
mkPostCustomersCustomerSourcesIdRequestBodyOwner'Address' =
  PostCustomersCustomerSourcesIdRequestBodyOwner'Address' :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
PostCustomersCustomerSourcesIdRequestBodyOwner'Address'
    { postCustomersCustomerSourcesIdRequestBodyOwner'Address'City :: Maybe Text
postCustomersCustomerSourcesIdRequestBodyOwner'Address'City = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdRequestBodyOwner'Address'Country :: Maybe Text
postCustomersCustomerSourcesIdRequestBodyOwner'Address'Country = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdRequestBodyOwner'Address'Line1 :: Maybe Text
postCustomersCustomerSourcesIdRequestBodyOwner'Address'Line1 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdRequestBodyOwner'Address'Line2 :: Maybe Text
postCustomersCustomerSourcesIdRequestBodyOwner'Address'Line2 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdRequestBodyOwner'Address'PostalCode :: Maybe Text
postCustomersCustomerSourcesIdRequestBodyOwner'Address'PostalCode = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdRequestBodyOwner'Address'State :: Maybe Text
postCustomersCustomerSourcesIdRequestBodyOwner'Address'State = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Represents a response of the operation 'postCustomersCustomerSourcesId'.
--
-- 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), 'PostCustomersCustomerSourcesIdResponseError' is used.
data PostCustomersCustomerSourcesIdResponse
  = -- | Means either no matching case available or a parse error
    PostCustomersCustomerSourcesIdResponseError GHC.Base.String
  | -- | Successful response.
    PostCustomersCustomerSourcesIdResponse200 PostCustomersCustomerSourcesIdResponseBody200
  | -- | Error response.
    PostCustomersCustomerSourcesIdResponseDefault Error
  deriving (Int -> PostCustomersCustomerSourcesIdResponse -> String -> String
[PostCustomersCustomerSourcesIdResponse] -> String -> String
PostCustomersCustomerSourcesIdResponse -> String
(Int -> PostCustomersCustomerSourcesIdResponse -> String -> String)
-> (PostCustomersCustomerSourcesIdResponse -> String)
-> ([PostCustomersCustomerSourcesIdResponse] -> String -> String)
-> Show PostCustomersCustomerSourcesIdResponse
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostCustomersCustomerSourcesIdResponse] -> String -> String
$cshowList :: [PostCustomersCustomerSourcesIdResponse] -> String -> String
show :: PostCustomersCustomerSourcesIdResponse -> String
$cshow :: PostCustomersCustomerSourcesIdResponse -> String
showsPrec :: Int -> PostCustomersCustomerSourcesIdResponse -> String -> String
$cshowsPrec :: Int -> PostCustomersCustomerSourcesIdResponse -> String -> String
GHC.Show.Show, PostCustomersCustomerSourcesIdResponse
-> PostCustomersCustomerSourcesIdResponse -> Bool
(PostCustomersCustomerSourcesIdResponse
 -> PostCustomersCustomerSourcesIdResponse -> Bool)
-> (PostCustomersCustomerSourcesIdResponse
    -> PostCustomersCustomerSourcesIdResponse -> Bool)
-> Eq PostCustomersCustomerSourcesIdResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersCustomerSourcesIdResponse
-> PostCustomersCustomerSourcesIdResponse -> Bool
$c/= :: PostCustomersCustomerSourcesIdResponse
-> PostCustomersCustomerSourcesIdResponse -> Bool
== :: PostCustomersCustomerSourcesIdResponse
-> PostCustomersCustomerSourcesIdResponse -> Bool
$c== :: PostCustomersCustomerSourcesIdResponse
-> PostCustomersCustomerSourcesIdResponse -> Bool
GHC.Classes.Eq)

-- | Defines the object schema located at @paths.\/v1\/customers\/{customer}\/sources\/{id}.POST.responses.200.content.application\/json.schema.anyOf@ in the specification.
data PostCustomersCustomerSourcesIdResponseBody200 = PostCustomersCustomerSourcesIdResponseBody200
  { -- | account: The account this card belongs to. This attribute will not be in the card object if the card belongs to a customer or recipient instead.
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Account'Variants
postCustomersCustomerSourcesIdResponseBody200Account :: (GHC.Maybe.Maybe PostCustomersCustomerSourcesIdResponseBody200Account'Variants),
    -- | account_holder_name: The name of the person or business that owns the bank account.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AccountHolderName :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | account_holder_type: The type of entity that holds the account. This can be either \`individual\` or \`company\`.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AccountHolderType :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | ach_credit_transfer
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeAchCreditTransfer
postCustomersCustomerSourcesIdResponseBody200AchCreditTransfer :: (GHC.Maybe.Maybe SourceTypeAchCreditTransfer),
    -- | ach_debit
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeAchDebit
postCustomersCustomerSourcesIdResponseBody200AchDebit :: (GHC.Maybe.Maybe SourceTypeAchDebit),
    -- | acss_debit
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeAcssDebit
postCustomersCustomerSourcesIdResponseBody200AcssDebit :: (GHC.Maybe.Maybe SourceTypeAcssDebit),
    -- | address_city: City\/District\/Suburb\/Town\/Village.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressCity :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | address_country: Billing address country, if provided when creating card.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressCountry :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | address_line1: Address line 1 (Street address\/PO Box\/Company name).
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressLine1 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | address_line1_check: If \`address_line1\` was provided, results of the check: \`pass\`, \`fail\`, \`unavailable\`, or \`unchecked\`.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressLine1Check :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | address_line2: Address line 2 (Apartment\/Suite\/Unit\/Building).
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressLine2 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | address_state: State\/County\/Province\/Region.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressState :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | address_zip: ZIP or postal code.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressZip :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | address_zip_check: If \`address_zip\` was provided, results of the check: \`pass\`, \`fail\`, \`unavailable\`, or \`unchecked\`.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressZipCheck :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | alipay
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeAlipay
postCustomersCustomerSourcesIdResponseBody200Alipay :: (GHC.Maybe.Maybe SourceTypeAlipay),
    -- | amount: A positive integer in the smallest currency unit (that is, 100 cents for \$1.00, or 1 for ¥1, Japanese Yen being a zero-decimal currency) representing the total amount associated with the source. This is the amount for which the source will be chargeable once ready. Required for \`single_use\` sources.
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Int
postCustomersCustomerSourcesIdResponseBody200Amount :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | au_becs_debit
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeAuBecsDebit
postCustomersCustomerSourcesIdResponseBody200AuBecsDebit :: (GHC.Maybe.Maybe SourceTypeAuBecsDebit),
    -- | available_payout_methods: A set of available payout methods for this card. Only values from this set should be passed as the \`method\` when creating a payout.
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe
     [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
postCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods :: (GHC.Maybe.Maybe ([PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'])),
    -- | bancontact
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeBancontact
postCustomersCustomerSourcesIdResponseBody200Bancontact :: (GHC.Maybe.Maybe SourceTypeBancontact),
    -- | bank_name: Name of the bank associated with the routing number (e.g., \`WELLS FARGO\`).
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200BankName :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | brand: Card brand. Can be \`American Express\`, \`Diners Club\`, \`Discover\`, \`JCB\`, \`MasterCard\`, \`UnionPay\`, \`Visa\`, or \`Unknown\`.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Brand :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | card
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeCard
postCustomersCustomerSourcesIdResponseBody200Card :: (GHC.Maybe.Maybe SourceTypeCard),
    -- | card_present
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeCardPresent
postCustomersCustomerSourcesIdResponseBody200CardPresent :: (GHC.Maybe.Maybe SourceTypeCardPresent),
    -- | client_secret: The client secret of the source. Used for client-side retrieval using a publishable key.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200ClientSecret :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | code_verification:
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceCodeVerificationFlow
postCustomersCustomerSourcesIdResponseBody200CodeVerification :: (GHC.Maybe.Maybe SourceCodeVerificationFlow),
    -- | country: Two-letter ISO code representing the country of the card. You could use this attribute to get a sense of the international breakdown of cards you\'ve collected.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Country :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | created: Time at which the object was created. Measured in seconds since the Unix epoch.
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Int
postCustomersCustomerSourcesIdResponseBody200Created :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | currency: Three-letter [ISO code for currency](https:\/\/stripe.com\/docs\/payouts). Only applicable on accounts (not customers or recipients). The card can be used as a transfer destination for funds in this currency.
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Currency :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | customer: The customer that this card belongs to. This attribute will not be in the card object if the card belongs to an account or recipient instead.
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
postCustomersCustomerSourcesIdResponseBody200Customer :: (GHC.Maybe.Maybe PostCustomersCustomerSourcesIdResponseBody200Customer'Variants),
    -- | cvc_check: If a CVC was provided, results of the check: \`pass\`, \`fail\`, \`unavailable\`, or \`unchecked\`. A result of unchecked indicates that CVC was provided but hasn\'t been checked yet. Checks are typically performed when attaching a card to a Customer object, or when creating a charge. For more details, see [Check if a card is valid without a charge](https:\/\/support.stripe.com\/questions\/check-if-a-card-is-valid-without-a-charge).
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200CvcCheck :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | default_for_currency: Whether this card is the default external account for its currency.
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Bool
postCustomersCustomerSourcesIdResponseBody200DefaultForCurrency :: (GHC.Maybe.Maybe GHC.Types.Bool),
    -- | dynamic_last4: (For tokenized numbers only.) The last four digits of the device account number.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200DynamicLast4 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | eps
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeEps
postCustomersCustomerSourcesIdResponseBody200Eps :: (GHC.Maybe.Maybe SourceTypeEps),
    -- | exp_month: Two-digit number representing the card\'s expiration month.
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Int
postCustomersCustomerSourcesIdResponseBody200ExpMonth :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | exp_year: Four-digit number representing the card\'s expiration year.
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Int
postCustomersCustomerSourcesIdResponseBody200ExpYear :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | fingerprint: Uniquely identifies this particular card number. You can use this attribute to check whether two customers who’ve signed up with you are using the same card number, for example. For payment methods that tokenize card information (Apple Pay, Google Pay), the tokenized number might be provided instead of the underlying card number.
    --
    -- *Starting May 1, 2021, card fingerprint in India for Connect will change to allow two fingerprints for the same card --- one for India and one for the rest of the world.*
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Fingerprint :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | flow: The authentication \`flow\` of the source. \`flow\` is one of \`redirect\`, \`receiver\`, \`code_verification\`, \`none\`.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Flow :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | funding: Card funding type. Can be \`credit\`, \`debit\`, \`prepaid\`, or \`unknown\`.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Funding :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | giropay
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeGiropay
postCustomersCustomerSourcesIdResponseBody200Giropay :: (GHC.Maybe.Maybe SourceTypeGiropay),
    -- | id: Unique identifier for the object.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Id :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | ideal
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeIdeal
postCustomersCustomerSourcesIdResponseBody200Ideal :: (GHC.Maybe.Maybe SourceTypeIdeal),
    -- | klarna
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeKlarna
postCustomersCustomerSourcesIdResponseBody200Klarna :: (GHC.Maybe.Maybe SourceTypeKlarna),
    -- | last4: The last four digits of the card.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Last4 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | livemode: Has the value \`true\` if the object exists in live mode or the value \`false\` if the object exists in test mode.
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Bool
postCustomersCustomerSourcesIdResponseBody200Livemode :: (GHC.Maybe.Maybe GHC.Types.Bool),
    -- | 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.
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Object
postCustomersCustomerSourcesIdResponseBody200Metadata :: (GHC.Maybe.Maybe Data.Aeson.Types.Internal.Object),
    -- | multibanco
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeMultibanco
postCustomersCustomerSourcesIdResponseBody200Multibanco :: (GHC.Maybe.Maybe SourceTypeMultibanco),
    -- | name: Cardholder name.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Name :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | object: String representing the object\'s type. Objects of the same type share the same value.
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
postCustomersCustomerSourcesIdResponseBody200Object :: (GHC.Maybe.Maybe PostCustomersCustomerSourcesIdResponseBody200Object'),
    -- | owner: Information about the owner of the payment instrument that may be used or required by particular source types.
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
postCustomersCustomerSourcesIdResponseBody200Owner :: (GHC.Maybe.Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'),
    -- | p24
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeP24
postCustomersCustomerSourcesIdResponseBody200P24 :: (GHC.Maybe.Maybe SourceTypeP24),
    -- | receiver:
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceReceiverFlow
postCustomersCustomerSourcesIdResponseBody200Receiver :: (GHC.Maybe.Maybe SourceReceiverFlow),
    -- | recipient: The recipient that this card belongs to. This attribute will not be in the card object if the card belongs to a customer or account instead.
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
postCustomersCustomerSourcesIdResponseBody200Recipient :: (GHC.Maybe.Maybe PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants),
    -- | redirect:
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceRedirectFlow
postCustomersCustomerSourcesIdResponseBody200Redirect :: (GHC.Maybe.Maybe SourceRedirectFlow),
    -- | routing_number: The routing transit number for the bank account.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200RoutingNumber :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | sepa_debit
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeSepaDebit
postCustomersCustomerSourcesIdResponseBody200SepaDebit :: (GHC.Maybe.Maybe SourceTypeSepaDebit),
    -- | sofort
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeSofort
postCustomersCustomerSourcesIdResponseBody200Sofort :: (GHC.Maybe.Maybe SourceTypeSofort),
    -- | source_order:
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe SourceOrder
postCustomersCustomerSourcesIdResponseBody200SourceOrder :: (GHC.Maybe.Maybe SourceOrder),
    -- | statement_descriptor: Extra information about a source. This will appear on your customer\'s statement every time you charge the source.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200StatementDescriptor :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | status: For bank accounts, possible values are \`new\`, \`validated\`, \`verified\`, \`verification_failed\`, or \`errored\`. A bank account that hasn\'t had any activity or validation performed is \`new\`. If Stripe can determine that the bank account exists, its status will be \`validated\`. Note that there often isn’t enough information to know (e.g., for smaller credit unions), and the validation is not always run. If customer bank account verification has succeeded, the bank account status will be \`verified\`. If the verification failed for any reason, such as microdeposit failure, the status will be \`verification_failed\`. If a transfer sent to this bank account fails, we\'ll set the status to \`errored\` and will not continue to send transfers until the bank details are updated.
    --
    -- For external accounts, possible values are \`new\` and \`errored\`. Validations aren\'t run against external accounts because they\'re only used for payouts. This means the other statuses don\'t apply. If a transfer fails, the status is set to \`errored\` and transfers are stopped until account details are updated.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Status :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | three_d_secure
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeThreeDSecure
postCustomersCustomerSourcesIdResponseBody200ThreeDSecure :: (GHC.Maybe.Maybe SourceTypeThreeDSecure),
    -- | tokenization_method: If the card number is tokenized, this is the method that was used. Can be \`android_pay\` (includes Google Pay), \`apple_pay\`, \`masterpass\`, \`visa_checkout\`, or null.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200TokenizationMethod :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | type: The \`type\` of the source. The \`type\` is a payment method, one of \`ach_credit_transfer\`, \`ach_debit\`, \`alipay\`, \`bancontact\`, \`card\`, \`card_present\`, \`eps\`, \`giropay\`, \`ideal\`, \`multibanco\`, \`klarna\`, \`p24\`, \`sepa_debit\`, \`sofort\`, \`three_d_secure\`, or \`wechat\`. An additional hash is included on the source with a name matching this value. It contains additional information specific to the [payment method](https:\/\/stripe.com\/docs\/sources) used.
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
postCustomersCustomerSourcesIdResponseBody200Type :: (GHC.Maybe.Maybe PostCustomersCustomerSourcesIdResponseBody200Type'),
    -- | usage: Either \`reusable\` or \`single_use\`. Whether this source should be reusable or not. Some source types may or may not be reusable by construction, while others may leave the option at creation. If an incompatible value is passed, an error will be returned.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Usage :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | wechat
    PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeWechat
postCustomersCustomerSourcesIdResponseBody200Wechat :: (GHC.Maybe.Maybe SourceTypeWechat)
  }
  deriving
    ( Int
-> PostCustomersCustomerSourcesIdResponseBody200
-> String
-> String
[PostCustomersCustomerSourcesIdResponseBody200] -> String -> String
PostCustomersCustomerSourcesIdResponseBody200 -> String
(Int
 -> PostCustomersCustomerSourcesIdResponseBody200
 -> String
 -> String)
-> (PostCustomersCustomerSourcesIdResponseBody200 -> String)
-> ([PostCustomersCustomerSourcesIdResponseBody200]
    -> String -> String)
-> Show PostCustomersCustomerSourcesIdResponseBody200
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostCustomersCustomerSourcesIdResponseBody200] -> String -> String
$cshowList :: [PostCustomersCustomerSourcesIdResponseBody200] -> String -> String
show :: PostCustomersCustomerSourcesIdResponseBody200 -> String
$cshow :: PostCustomersCustomerSourcesIdResponseBody200 -> String
showsPrec :: Int
-> PostCustomersCustomerSourcesIdResponseBody200
-> String
-> String
$cshowsPrec :: Int
-> PostCustomersCustomerSourcesIdResponseBody200
-> String
-> String
GHC.Show.Show,
      PostCustomersCustomerSourcesIdResponseBody200
-> PostCustomersCustomerSourcesIdResponseBody200 -> Bool
(PostCustomersCustomerSourcesIdResponseBody200
 -> PostCustomersCustomerSourcesIdResponseBody200 -> Bool)
-> (PostCustomersCustomerSourcesIdResponseBody200
    -> PostCustomersCustomerSourcesIdResponseBody200 -> Bool)
-> Eq PostCustomersCustomerSourcesIdResponseBody200
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersCustomerSourcesIdResponseBody200
-> PostCustomersCustomerSourcesIdResponseBody200 -> Bool
$c/= :: PostCustomersCustomerSourcesIdResponseBody200
-> PostCustomersCustomerSourcesIdResponseBody200 -> Bool
== :: PostCustomersCustomerSourcesIdResponseBody200
-> PostCustomersCustomerSourcesIdResponseBody200 -> Bool
$c== :: PostCustomersCustomerSourcesIdResponseBody200
-> PostCustomersCustomerSourcesIdResponseBody200 -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostCustomersCustomerSourcesIdResponseBody200 where
  toJSON :: PostCustomersCustomerSourcesIdResponseBody200 -> Value
toJSON PostCustomersCustomerSourcesIdResponseBody200
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"account" Text
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Account'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Account'Variants
postCustomersCustomerSourcesIdResponseBody200Account PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"account_holder_name" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AccountHolderName PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"account_holder_type" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AccountHolderType PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"ach_credit_transfer" Text -> Maybe SourceTypeAchCreditTransfer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeAchCreditTransfer
postCustomersCustomerSourcesIdResponseBody200AchCreditTransfer PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"ach_debit" Text -> Maybe SourceTypeAchDebit -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeAchDebit
postCustomersCustomerSourcesIdResponseBody200AchDebit PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"acss_debit" Text -> Maybe SourceTypeAcssDebit -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeAcssDebit
postCustomersCustomerSourcesIdResponseBody200AcssDebit PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_city" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressCity PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_country" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressCountry PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_line1" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressLine1 PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_line1_check" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressLine1Check PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_line2" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressLine2 PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_state" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressState PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_zip" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressZip PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"address_zip_check" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressZipCheck PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"alipay" Text -> Maybe SourceTypeAlipay -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeAlipay
postCustomersCustomerSourcesIdResponseBody200Alipay PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"amount" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Int
postCustomersCustomerSourcesIdResponseBody200Amount PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"au_becs_debit" Text -> Maybe SourceTypeAuBecsDebit -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeAuBecsDebit
postCustomersCustomerSourcesIdResponseBody200AuBecsDebit PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"available_payout_methods" Text
-> Maybe
     [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe
     [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
postCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"bancontact" Text -> Maybe SourceTypeBancontact -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeBancontact
postCustomersCustomerSourcesIdResponseBody200Bancontact PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"bank_name" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200BankName PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"brand" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Brand PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"card" Text -> Maybe SourceTypeCard -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeCard
postCustomersCustomerSourcesIdResponseBody200Card PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"card_present" Text -> Maybe SourceTypeCardPresent -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeCardPresent
postCustomersCustomerSourcesIdResponseBody200CardPresent PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"client_secret" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200ClientSecret PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"code_verification" Text -> Maybe SourceCodeVerificationFlow -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceCodeVerificationFlow
postCustomersCustomerSourcesIdResponseBody200CodeVerification PostCustomersCustomerSourcesIdResponseBody200
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..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Country PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"created" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Int
postCustomersCustomerSourcesIdResponseBody200Created PostCustomersCustomerSourcesIdResponseBody200
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..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Currency PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"customer" Text
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
postCustomersCustomerSourcesIdResponseBody200Customer PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"cvc_check" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200CvcCheck PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"default_for_currency" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Bool
postCustomersCustomerSourcesIdResponseBody200DefaultForCurrency PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"dynamic_last4" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200DynamicLast4 PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"eps" Text -> Maybe SourceTypeEps -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeEps
postCustomersCustomerSourcesIdResponseBody200Eps PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"exp_month" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Int
postCustomersCustomerSourcesIdResponseBody200ExpMonth PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"exp_year" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Int
postCustomersCustomerSourcesIdResponseBody200ExpYear PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"fingerprint" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Fingerprint PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"flow" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Flow PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"funding" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Funding PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"giropay" Text -> Maybe SourceTypeGiropay -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeGiropay
postCustomersCustomerSourcesIdResponseBody200Giropay PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"id" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Id PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"ideal" Text -> Maybe SourceTypeIdeal -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeIdeal
postCustomersCustomerSourcesIdResponseBody200Ideal PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"klarna" Text -> Maybe SourceTypeKlarna -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeKlarna
postCustomersCustomerSourcesIdResponseBody200Klarna PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"last4" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Last4 PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"livemode" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Bool
postCustomersCustomerSourcesIdResponseBody200Livemode PostCustomersCustomerSourcesIdResponseBody200
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..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Object
postCustomersCustomerSourcesIdResponseBody200Metadata PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"multibanco" Text -> Maybe SourceTypeMultibanco -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeMultibanco
postCustomersCustomerSourcesIdResponseBody200Multibanco PostCustomersCustomerSourcesIdResponseBody200
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..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Name PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"object" Text
-> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
postCustomersCustomerSourcesIdResponseBody200Object PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"owner" Text
-> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
postCustomersCustomerSourcesIdResponseBody200Owner PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"p24" Text -> Maybe SourceTypeP24 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeP24
postCustomersCustomerSourcesIdResponseBody200P24 PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"receiver" Text -> Maybe SourceReceiverFlow -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceReceiverFlow
postCustomersCustomerSourcesIdResponseBody200Receiver PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"recipient" Text
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
postCustomersCustomerSourcesIdResponseBody200Recipient PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"redirect" Text -> Maybe SourceRedirectFlow -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceRedirectFlow
postCustomersCustomerSourcesIdResponseBody200Redirect PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"routing_number" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200RoutingNumber PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"sepa_debit" Text -> Maybe SourceTypeSepaDebit -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeSepaDebit
postCustomersCustomerSourcesIdResponseBody200SepaDebit PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"sofort" Text -> Maybe SourceTypeSofort -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeSofort
postCustomersCustomerSourcesIdResponseBody200Sofort PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"source_order" Text -> Maybe SourceOrder -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe SourceOrder
postCustomersCustomerSourcesIdResponseBody200SourceOrder PostCustomersCustomerSourcesIdResponseBody200
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..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200StatementDescriptor PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"status" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Status PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"three_d_secure" Text -> Maybe SourceTypeThreeDSecure -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeThreeDSecure
postCustomersCustomerSourcesIdResponseBody200ThreeDSecure PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"tokenization_method" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200TokenizationMethod PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"type" Text
-> Maybe PostCustomersCustomerSourcesIdResponseBody200Type' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
postCustomersCustomerSourcesIdResponseBody200Type PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"usage" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Usage PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"wechat" Text -> Maybe SourceTypeWechat -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeWechat
postCustomersCustomerSourcesIdResponseBody200Wechat PostCustomersCustomerSourcesIdResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostCustomersCustomerSourcesIdResponseBody200 -> Encoding
toEncoding PostCustomersCustomerSourcesIdResponseBody200
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"account" Text
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Account'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Account'Variants
postCustomersCustomerSourcesIdResponseBody200Account PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"account_holder_name" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AccountHolderName PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"account_holder_type" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AccountHolderType PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"ach_credit_transfer" Text -> Maybe SourceTypeAchCreditTransfer -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeAchCreditTransfer
postCustomersCustomerSourcesIdResponseBody200AchCreditTransfer PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"ach_debit" Text -> Maybe SourceTypeAchDebit -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeAchDebit
postCustomersCustomerSourcesIdResponseBody200AchDebit PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"acss_debit" Text -> Maybe SourceTypeAcssDebit -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeAcssDebit
postCustomersCustomerSourcesIdResponseBody200AcssDebit PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_city" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressCity PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_country" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressCountry PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_line1" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressLine1 PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_line1_check" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressLine1Check PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_line2" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressLine2 PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_state" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressState PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_zip" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressZip PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"address_zip_check" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressZipCheck PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"alipay" Text -> Maybe SourceTypeAlipay -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeAlipay
postCustomersCustomerSourcesIdResponseBody200Alipay PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"amount" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Int
postCustomersCustomerSourcesIdResponseBody200Amount PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"au_becs_debit" Text -> Maybe SourceTypeAuBecsDebit -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeAuBecsDebit
postCustomersCustomerSourcesIdResponseBody200AuBecsDebit PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"available_payout_methods" Text
-> Maybe
     [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe
     [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
postCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"bancontact" Text -> Maybe SourceTypeBancontact -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeBancontact
postCustomersCustomerSourcesIdResponseBody200Bancontact PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"bank_name" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200BankName PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"brand" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Brand PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"card" Text -> Maybe SourceTypeCard -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeCard
postCustomersCustomerSourcesIdResponseBody200Card PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"card_present" Text -> Maybe SourceTypeCardPresent -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeCardPresent
postCustomersCustomerSourcesIdResponseBody200CardPresent PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"client_secret" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200ClientSecret PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"code_verification" Text -> Maybe SourceCodeVerificationFlow -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceCodeVerificationFlow
postCustomersCustomerSourcesIdResponseBody200CodeVerification PostCustomersCustomerSourcesIdResponseBody200
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..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Country PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"created" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Int
postCustomersCustomerSourcesIdResponseBody200Created PostCustomersCustomerSourcesIdResponseBody200
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..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Currency PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"customer" Text
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
postCustomersCustomerSourcesIdResponseBody200Customer PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"cvc_check" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200CvcCheck PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"default_for_currency" Text -> Maybe Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Bool
postCustomersCustomerSourcesIdResponseBody200DefaultForCurrency PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"dynamic_last4" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200DynamicLast4 PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"eps" Text -> Maybe SourceTypeEps -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeEps
postCustomersCustomerSourcesIdResponseBody200Eps PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"exp_month" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Int
postCustomersCustomerSourcesIdResponseBody200ExpMonth PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"exp_year" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Int
postCustomersCustomerSourcesIdResponseBody200ExpYear PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"fingerprint" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Fingerprint PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"flow" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Flow PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"funding" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Funding PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"giropay" Text -> Maybe SourceTypeGiropay -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeGiropay
postCustomersCustomerSourcesIdResponseBody200Giropay PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"id" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Id PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"ideal" Text -> Maybe SourceTypeIdeal -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeIdeal
postCustomersCustomerSourcesIdResponseBody200Ideal PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"klarna" Text -> Maybe SourceTypeKlarna -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeKlarna
postCustomersCustomerSourcesIdResponseBody200Klarna PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"last4" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Last4 PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"livemode" Text -> Maybe Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Bool
postCustomersCustomerSourcesIdResponseBody200Livemode PostCustomersCustomerSourcesIdResponseBody200
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..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Object
postCustomersCustomerSourcesIdResponseBody200Metadata PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"multibanco" Text -> Maybe SourceTypeMultibanco -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeMultibanco
postCustomersCustomerSourcesIdResponseBody200Multibanco PostCustomersCustomerSourcesIdResponseBody200
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..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Name PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"object" Text
-> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
postCustomersCustomerSourcesIdResponseBody200Object PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"owner" Text
-> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
postCustomersCustomerSourcesIdResponseBody200Owner PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"p24" Text -> Maybe SourceTypeP24 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeP24
postCustomersCustomerSourcesIdResponseBody200P24 PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"receiver" Text -> Maybe SourceReceiverFlow -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceReceiverFlow
postCustomersCustomerSourcesIdResponseBody200Receiver PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"recipient" Text
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
postCustomersCustomerSourcesIdResponseBody200Recipient PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"redirect" Text -> Maybe SourceRedirectFlow -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceRedirectFlow
postCustomersCustomerSourcesIdResponseBody200Redirect PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"routing_number" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200RoutingNumber PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"sepa_debit" Text -> Maybe SourceTypeSepaDebit -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeSepaDebit
postCustomersCustomerSourcesIdResponseBody200SepaDebit PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"sofort" Text -> Maybe SourceTypeSofort -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeSofort
postCustomersCustomerSourcesIdResponseBody200Sofort PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"source_order" Text -> Maybe SourceOrder -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe SourceOrder
postCustomersCustomerSourcesIdResponseBody200SourceOrder PostCustomersCustomerSourcesIdResponseBody200
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..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200StatementDescriptor PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"status" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Status PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"three_d_secure" Text -> Maybe SourceTypeThreeDSecure -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeThreeDSecure
postCustomersCustomerSourcesIdResponseBody200ThreeDSecure PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"tokenization_method" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200TokenizationMethod PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"type" Text
-> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
postCustomersCustomerSourcesIdResponseBody200Type PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"usage" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200 -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Usage PostCustomersCustomerSourcesIdResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"wechat" Text -> Maybe SourceTypeWechat -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200
-> Maybe SourceTypeWechat
postCustomersCustomerSourcesIdResponseBody200Wechat PostCustomersCustomerSourcesIdResponseBody200
obj))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersCustomerSourcesIdResponseBody200 where
  parseJSON :: Value -> Parser PostCustomersCustomerSourcesIdResponseBody200
parseJSON = String
-> (Object -> Parser PostCustomersCustomerSourcesIdResponseBody200)
-> Value
-> Parser PostCustomersCustomerSourcesIdResponseBody200
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostCustomersCustomerSourcesIdResponseBody200" (\Object
obj -> ((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((Maybe
   PostCustomersCustomerSourcesIdResponseBody200Account'Variants
 -> Maybe Text
 -> Maybe Text
 -> Maybe SourceTypeAchCreditTransfer
 -> Maybe SourceTypeAchDebit
 -> Maybe SourceTypeAcssDebit
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe SourceTypeAlipay
 -> Maybe Int
 -> Maybe SourceTypeAuBecsDebit
 -> Maybe
      [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
 -> Maybe SourceTypeBancontact
 -> Maybe Text
 -> Maybe Text
 -> Maybe SourceTypeCard
 -> Maybe SourceTypeCardPresent
 -> Maybe Text
 -> Maybe SourceCodeVerificationFlow
 -> Maybe Text
 -> Maybe Int
 -> Maybe Text
 -> Maybe
      PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Text
 -> Maybe SourceTypeEps
 -> Maybe Int
 -> Maybe Int
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe SourceTypeGiropay
 -> Maybe Text
 -> Maybe SourceTypeIdeal
 -> Maybe SourceTypeKlarna
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Object
 -> Maybe SourceTypeMultibanco
 -> Maybe Text
 -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
 -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
 -> Maybe SourceTypeP24
 -> Maybe SourceReceiverFlow
 -> Maybe
      PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
 -> Maybe SourceRedirectFlow
 -> Maybe Text
 -> Maybe SourceTypeSepaDebit
 -> Maybe SourceTypeSofort
 -> Maybe SourceOrder
 -> Maybe Text
 -> Maybe Text
 -> Maybe SourceTypeThreeDSecure
 -> Maybe Text
 -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
 -> Maybe Text
 -> Maybe SourceTypeWechat
 -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser
     (Maybe
        PostCustomersCustomerSourcesIdResponseBody200Account'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeAchCreditTransfer
      -> Maybe SourceTypeAchDebit
      -> Maybe SourceTypeAcssDebit
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeAlipay
      -> Maybe Int
      -> Maybe SourceTypeAuBecsDebit
      -> Maybe
           [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
      -> Maybe SourceTypeBancontact
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeCard
      -> Maybe SourceTypeCardPresent
      -> Maybe Text
      -> Maybe SourceCodeVerificationFlow
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe PostCustomersCustomerSourcesIdResponseBody200Account'Variants
-> Maybe Text
-> Maybe Text
-> Maybe SourceTypeAchCreditTransfer
-> Maybe SourceTypeAchDebit
-> Maybe SourceTypeAcssDebit
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe SourceTypeAlipay
-> Maybe Int
-> Maybe SourceTypeAuBecsDebit
-> Maybe
     [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
-> Maybe SourceTypeBancontact
-> Maybe Text
-> Maybe Text
-> Maybe SourceTypeCard
-> Maybe SourceTypeCardPresent
-> Maybe Text
-> Maybe SourceCodeVerificationFlow
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe SourceTypeEps
-> Maybe Int
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe SourceTypeGiropay
-> Maybe Text
-> Maybe SourceTypeIdeal
-> Maybe SourceTypeKlarna
-> Maybe Text
-> Maybe Bool
-> Maybe Object
-> Maybe SourceTypeMultibanco
-> Maybe Text
-> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
-> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
-> Maybe SourceTypeP24
-> Maybe SourceReceiverFlow
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
-> Maybe SourceRedirectFlow
-> Maybe Text
-> Maybe SourceTypeSepaDebit
-> Maybe SourceTypeSofort
-> Maybe SourceOrder
-> Maybe Text
-> Maybe Text
-> Maybe SourceTypeThreeDSecure
-> Maybe Text
-> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
-> Maybe Text
-> Maybe SourceTypeWechat
-> PostCustomersCustomerSourcesIdResponseBody200
PostCustomersCustomerSourcesIdResponseBody200 Parser
  (Maybe
     PostCustomersCustomerSourcesIdResponseBody200Account'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeAchCreditTransfer
   -> Maybe SourceTypeAchDebit
   -> Maybe SourceTypeAcssDebit
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeAlipay
   -> Maybe Int
   -> Maybe SourceTypeAuBecsDebit
   -> Maybe
        [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
   -> Maybe SourceTypeBancontact
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeCard
   -> Maybe SourceTypeCardPresent
   -> Maybe Text
   -> Maybe SourceCodeVerificationFlow
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser
     (Maybe
        PostCustomersCustomerSourcesIdResponseBody200Account'Variants)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeAchCreditTransfer
      -> Maybe SourceTypeAchDebit
      -> Maybe SourceTypeAcssDebit
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeAlipay
      -> Maybe Int
      -> Maybe SourceTypeAuBecsDebit
      -> Maybe
           [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
      -> Maybe SourceTypeBancontact
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeCard
      -> Maybe SourceTypeCardPresent
      -> Maybe Text
      -> Maybe SourceCodeVerificationFlow
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostCustomersCustomerSourcesIdResponseBody200Account'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"account")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeAchCreditTransfer
   -> Maybe SourceTypeAchDebit
   -> Maybe SourceTypeAcssDebit
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeAlipay
   -> Maybe Int
   -> Maybe SourceTypeAuBecsDebit
   -> Maybe
        [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
   -> Maybe SourceTypeBancontact
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeCard
   -> Maybe SourceTypeCardPresent
   -> Maybe Text
   -> Maybe SourceCodeVerificationFlow
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe SourceTypeAchCreditTransfer
      -> Maybe SourceTypeAchDebit
      -> Maybe SourceTypeAcssDebit
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeAlipay
      -> Maybe Int
      -> Maybe SourceTypeAuBecsDebit
      -> Maybe
           [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
      -> Maybe SourceTypeBancontact
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeCard
      -> Maybe SourceTypeCardPresent
      -> Maybe Text
      -> Maybe SourceCodeVerificationFlow
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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_holder_name")) Parser
  (Maybe Text
   -> Maybe SourceTypeAchCreditTransfer
   -> Maybe SourceTypeAchDebit
   -> Maybe SourceTypeAcssDebit
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeAlipay
   -> Maybe Int
   -> Maybe SourceTypeAuBecsDebit
   -> Maybe
        [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
   -> Maybe SourceTypeBancontact
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeCard
   -> Maybe SourceTypeCardPresent
   -> Maybe Text
   -> Maybe SourceCodeVerificationFlow
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe SourceTypeAchCreditTransfer
      -> Maybe SourceTypeAchDebit
      -> Maybe SourceTypeAcssDebit
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeAlipay
      -> Maybe Int
      -> Maybe SourceTypeAuBecsDebit
      -> Maybe
           [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
      -> Maybe SourceTypeBancontact
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeCard
      -> Maybe SourceTypeCardPresent
      -> Maybe Text
      -> Maybe SourceCodeVerificationFlow
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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_holder_type")) Parser
  (Maybe SourceTypeAchCreditTransfer
   -> Maybe SourceTypeAchDebit
   -> Maybe SourceTypeAcssDebit
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeAlipay
   -> Maybe Int
   -> Maybe SourceTypeAuBecsDebit
   -> Maybe
        [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
   -> Maybe SourceTypeBancontact
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeCard
   -> Maybe SourceTypeCardPresent
   -> Maybe Text
   -> Maybe SourceCodeVerificationFlow
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe SourceTypeAchCreditTransfer)
-> Parser
     (Maybe SourceTypeAchDebit
      -> Maybe SourceTypeAcssDebit
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeAlipay
      -> Maybe Int
      -> Maybe SourceTypeAuBecsDebit
      -> Maybe
           [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
      -> Maybe SourceTypeBancontact
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeCard
      -> Maybe SourceTypeCardPresent
      -> Maybe Text
      -> Maybe SourceCodeVerificationFlow
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe SourceTypeAchCreditTransfer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"ach_credit_transfer")) Parser
  (Maybe SourceTypeAchDebit
   -> Maybe SourceTypeAcssDebit
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeAlipay
   -> Maybe Int
   -> Maybe SourceTypeAuBecsDebit
   -> Maybe
        [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
   -> Maybe SourceTypeBancontact
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeCard
   -> Maybe SourceTypeCardPresent
   -> Maybe Text
   -> Maybe SourceCodeVerificationFlow
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe SourceTypeAchDebit)
-> Parser
     (Maybe SourceTypeAcssDebit
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeAlipay
      -> Maybe Int
      -> Maybe SourceTypeAuBecsDebit
      -> Maybe
           [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
      -> Maybe SourceTypeBancontact
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeCard
      -> Maybe SourceTypeCardPresent
      -> Maybe Text
      -> Maybe SourceCodeVerificationFlow
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe SourceTypeAchDebit)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"ach_debit")) Parser
  (Maybe SourceTypeAcssDebit
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeAlipay
   -> Maybe Int
   -> Maybe SourceTypeAuBecsDebit
   -> Maybe
        [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
   -> Maybe SourceTypeBancontact
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeCard
   -> Maybe SourceTypeCardPresent
   -> Maybe Text
   -> Maybe SourceCodeVerificationFlow
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe SourceTypeAcssDebit)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeAlipay
      -> Maybe Int
      -> Maybe SourceTypeAuBecsDebit
      -> Maybe
           [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
      -> Maybe SourceTypeBancontact
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeCard
      -> Maybe SourceTypeCardPresent
      -> Maybe Text
      -> Maybe SourceCodeVerificationFlow
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe SourceTypeAcssDebit)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"acss_debit")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeAlipay
   -> Maybe Int
   -> Maybe SourceTypeAuBecsDebit
   -> Maybe
        [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
   -> Maybe SourceTypeBancontact
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeCard
   -> Maybe SourceTypeCardPresent
   -> Maybe Text
   -> Maybe SourceCodeVerificationFlow
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeAlipay
      -> Maybe Int
      -> Maybe SourceTypeAuBecsDebit
      -> Maybe
           [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
      -> Maybe SourceTypeBancontact
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeCard
      -> Maybe SourceTypeCardPresent
      -> Maybe Text
      -> Maybe SourceCodeVerificationFlow
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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
"address_city")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeAlipay
   -> Maybe Int
   -> Maybe SourceTypeAuBecsDebit
   -> Maybe
        [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
   -> Maybe SourceTypeBancontact
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeCard
   -> Maybe SourceTypeCardPresent
   -> Maybe Text
   -> Maybe SourceCodeVerificationFlow
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeAlipay
      -> Maybe Int
      -> Maybe SourceTypeAuBecsDebit
      -> Maybe
           [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
      -> Maybe SourceTypeBancontact
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeCard
      -> Maybe SourceTypeCardPresent
      -> Maybe Text
      -> Maybe SourceCodeVerificationFlow
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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
"address_country")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeAlipay
   -> Maybe Int
   -> Maybe SourceTypeAuBecsDebit
   -> Maybe
        [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
   -> Maybe SourceTypeBancontact
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeCard
   -> Maybe SourceTypeCardPresent
   -> Maybe Text
   -> Maybe SourceCodeVerificationFlow
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeAlipay
      -> Maybe Int
      -> Maybe SourceTypeAuBecsDebit
      -> Maybe
           [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
      -> Maybe SourceTypeBancontact
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeCard
      -> Maybe SourceTypeCardPresent
      -> Maybe Text
      -> Maybe SourceCodeVerificationFlow
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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
"address_line1")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeAlipay
   -> Maybe Int
   -> Maybe SourceTypeAuBecsDebit
   -> Maybe
        [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
   -> Maybe SourceTypeBancontact
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeCard
   -> Maybe SourceTypeCardPresent
   -> Maybe Text
   -> Maybe SourceCodeVerificationFlow
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeAlipay
      -> Maybe Int
      -> Maybe SourceTypeAuBecsDebit
      -> Maybe
           [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
      -> Maybe SourceTypeBancontact
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeCard
      -> Maybe SourceTypeCardPresent
      -> Maybe Text
      -> Maybe SourceCodeVerificationFlow
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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
"address_line1_check")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeAlipay
   -> Maybe Int
   -> Maybe SourceTypeAuBecsDebit
   -> Maybe
        [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
   -> Maybe SourceTypeBancontact
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeCard
   -> Maybe SourceTypeCardPresent
   -> Maybe Text
   -> Maybe SourceCodeVerificationFlow
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeAlipay
      -> Maybe Int
      -> Maybe SourceTypeAuBecsDebit
      -> Maybe
           [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
      -> Maybe SourceTypeBancontact
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeCard
      -> Maybe SourceTypeCardPresent
      -> Maybe Text
      -> Maybe SourceCodeVerificationFlow
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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
"address_line2")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeAlipay
   -> Maybe Int
   -> Maybe SourceTypeAuBecsDebit
   -> Maybe
        [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
   -> Maybe SourceTypeBancontact
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeCard
   -> Maybe SourceTypeCardPresent
   -> Maybe Text
   -> Maybe SourceCodeVerificationFlow
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeAlipay
      -> Maybe Int
      -> Maybe SourceTypeAuBecsDebit
      -> Maybe
           [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
      -> Maybe SourceTypeBancontact
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeCard
      -> Maybe SourceTypeCardPresent
      -> Maybe Text
      -> Maybe SourceCodeVerificationFlow
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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
"address_state")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeAlipay
   -> Maybe Int
   -> Maybe SourceTypeAuBecsDebit
   -> Maybe
        [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
   -> Maybe SourceTypeBancontact
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeCard
   -> Maybe SourceTypeCardPresent
   -> Maybe Text
   -> Maybe SourceCodeVerificationFlow
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe SourceTypeAlipay
      -> Maybe Int
      -> Maybe SourceTypeAuBecsDebit
      -> Maybe
           [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
      -> Maybe SourceTypeBancontact
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeCard
      -> Maybe SourceTypeCardPresent
      -> Maybe Text
      -> Maybe SourceCodeVerificationFlow
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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
"address_zip")) Parser
  (Maybe Text
   -> Maybe SourceTypeAlipay
   -> Maybe Int
   -> Maybe SourceTypeAuBecsDebit
   -> Maybe
        [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
   -> Maybe SourceTypeBancontact
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeCard
   -> Maybe SourceTypeCardPresent
   -> Maybe Text
   -> Maybe SourceCodeVerificationFlow
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe SourceTypeAlipay
      -> Maybe Int
      -> Maybe SourceTypeAuBecsDebit
      -> Maybe
           [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
      -> Maybe SourceTypeBancontact
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeCard
      -> Maybe SourceTypeCardPresent
      -> Maybe Text
      -> Maybe SourceCodeVerificationFlow
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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
"address_zip_check")) Parser
  (Maybe SourceTypeAlipay
   -> Maybe Int
   -> Maybe SourceTypeAuBecsDebit
   -> Maybe
        [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
   -> Maybe SourceTypeBancontact
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeCard
   -> Maybe SourceTypeCardPresent
   -> Maybe Text
   -> Maybe SourceCodeVerificationFlow
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe SourceTypeAlipay)
-> Parser
     (Maybe Int
      -> Maybe SourceTypeAuBecsDebit
      -> Maybe
           [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
      -> Maybe SourceTypeBancontact
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeCard
      -> Maybe SourceTypeCardPresent
      -> Maybe Text
      -> Maybe SourceCodeVerificationFlow
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe SourceTypeAlipay)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"alipay")) Parser
  (Maybe Int
   -> Maybe SourceTypeAuBecsDebit
   -> Maybe
        [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
   -> Maybe SourceTypeBancontact
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeCard
   -> Maybe SourceTypeCardPresent
   -> Maybe Text
   -> Maybe SourceCodeVerificationFlow
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Int)
-> Parser
     (Maybe SourceTypeAuBecsDebit
      -> Maybe
           [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
      -> Maybe SourceTypeBancontact
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeCard
      -> Maybe SourceTypeCardPresent
      -> Maybe Text
      -> Maybe SourceCodeVerificationFlow
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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 SourceTypeAuBecsDebit
   -> Maybe
        [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
   -> Maybe SourceTypeBancontact
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeCard
   -> Maybe SourceTypeCardPresent
   -> Maybe Text
   -> Maybe SourceCodeVerificationFlow
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe SourceTypeAuBecsDebit)
-> Parser
     (Maybe
        [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
      -> Maybe SourceTypeBancontact
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeCard
      -> Maybe SourceTypeCardPresent
      -> Maybe Text
      -> Maybe SourceCodeVerificationFlow
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe SourceTypeAuBecsDebit)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"au_becs_debit")) Parser
  (Maybe
     [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
   -> Maybe SourceTypeBancontact
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeCard
   -> Maybe SourceTypeCardPresent
   -> Maybe Text
   -> Maybe SourceCodeVerificationFlow
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser
     (Maybe
        [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'])
-> Parser
     (Maybe SourceTypeBancontact
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeCard
      -> Maybe SourceTypeCardPresent
      -> Maybe Text
      -> Maybe SourceCodeVerificationFlow
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"available_payout_methods")) Parser
  (Maybe SourceTypeBancontact
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeCard
   -> Maybe SourceTypeCardPresent
   -> Maybe Text
   -> Maybe SourceCodeVerificationFlow
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe SourceTypeBancontact)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeCard
      -> Maybe SourceTypeCardPresent
      -> Maybe Text
      -> Maybe SourceCodeVerificationFlow
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe SourceTypeBancontact)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"bancontact")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeCard
   -> Maybe SourceTypeCardPresent
   -> Maybe Text
   -> Maybe SourceCodeVerificationFlow
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe SourceTypeCard
      -> Maybe SourceTypeCardPresent
      -> Maybe Text
      -> Maybe SourceCodeVerificationFlow
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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
"bank_name")) Parser
  (Maybe Text
   -> Maybe SourceTypeCard
   -> Maybe SourceTypeCardPresent
   -> Maybe Text
   -> Maybe SourceCodeVerificationFlow
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe SourceTypeCard
      -> Maybe SourceTypeCardPresent
      -> Maybe Text
      -> Maybe SourceCodeVerificationFlow
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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
"brand")) Parser
  (Maybe SourceTypeCard
   -> Maybe SourceTypeCardPresent
   -> Maybe Text
   -> Maybe SourceCodeVerificationFlow
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe SourceTypeCard)
-> Parser
     (Maybe SourceTypeCardPresent
      -> Maybe Text
      -> Maybe SourceCodeVerificationFlow
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe SourceTypeCard)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"card")) Parser
  (Maybe SourceTypeCardPresent
   -> Maybe Text
   -> Maybe SourceCodeVerificationFlow
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe SourceTypeCardPresent)
-> Parser
     (Maybe Text
      -> Maybe SourceCodeVerificationFlow
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe SourceTypeCardPresent)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"card_present")) Parser
  (Maybe Text
   -> Maybe SourceCodeVerificationFlow
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe SourceCodeVerificationFlow
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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
"client_secret")) Parser
  (Maybe SourceCodeVerificationFlow
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe SourceCodeVerificationFlow)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe SourceCodeVerificationFlow)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"code_verification")) Parser
  (Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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 Int
   -> Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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
"created")) Parser
  (Maybe Text
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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
     PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser
     (Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostCustomersCustomerSourcesIdResponseBody200Customer'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"customer")) Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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_check")) Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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
"default_for_currency")) Parser
  (Maybe Text
   -> Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe SourceTypeEps
      -> Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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
"dynamic_last4")) Parser
  (Maybe SourceTypeEps
   -> Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe SourceTypeEps)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe SourceTypeEps)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"eps")) Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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
"exp_month")) Parser
  (Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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
"exp_year")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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
"fingerprint")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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
"flow")) Parser
  (Maybe Text
   -> Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe SourceTypeGiropay
      -> Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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
"funding")) Parser
  (Maybe SourceTypeGiropay
   -> Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe SourceTypeGiropay)
-> Parser
     (Maybe Text
      -> Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe SourceTypeGiropay)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"giropay")) Parser
  (Maybe Text
   -> Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe SourceTypeIdeal
      -> Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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
"id")) Parser
  (Maybe SourceTypeIdeal
   -> Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe SourceTypeIdeal)
-> Parser
     (Maybe SourceTypeKlarna
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe SourceTypeIdeal)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"ideal")) Parser
  (Maybe SourceTypeKlarna
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe SourceTypeKlarna)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe SourceTypeKlarna)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"klarna")) Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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
"last4")) Parser
  (Maybe Bool
   -> Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Object
      -> Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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
"livemode")) Parser
  (Maybe Object
   -> Maybe SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Object)
-> Parser
     (Maybe SourceTypeMultibanco
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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 SourceTypeMultibanco
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe SourceTypeMultibanco)
-> Parser
     (Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe SourceTypeMultibanco)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"multibanco")) Parser
  (Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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 PostCustomersCustomerSourcesIdResponseBody200Object'
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser
     (Maybe PostCustomersCustomerSourcesIdResponseBody200Object')
-> Parser
     (Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
      -> Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostCustomersCustomerSourcesIdResponseBody200Object')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"object")) Parser
  (Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
   -> Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser
     (Maybe PostCustomersCustomerSourcesIdResponseBody200Owner')
-> Parser
     (Maybe SourceTypeP24
      -> Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostCustomersCustomerSourcesIdResponseBody200Owner')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"owner")) Parser
  (Maybe SourceTypeP24
   -> Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe SourceTypeP24)
-> Parser
     (Maybe SourceReceiverFlow
      -> Maybe
           PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe SourceTypeP24)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"p24")) Parser
  (Maybe SourceReceiverFlow
   -> Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe SourceReceiverFlow)
-> Parser
     (Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
      -> Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe SourceReceiverFlow)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"receiver")) Parser
  (Maybe
     PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
   -> Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser
     (Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants)
-> Parser
     (Maybe SourceRedirectFlow
      -> Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"recipient")) Parser
  (Maybe SourceRedirectFlow
   -> Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe SourceRedirectFlow)
-> Parser
     (Maybe Text
      -> Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe SourceRedirectFlow)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"redirect")) Parser
  (Maybe Text
   -> Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe SourceTypeSepaDebit
      -> Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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
"routing_number")) Parser
  (Maybe SourceTypeSepaDebit
   -> Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe SourceTypeSepaDebit)
-> Parser
     (Maybe SourceTypeSofort
      -> Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe SourceTypeSepaDebit)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"sepa_debit")) Parser
  (Maybe SourceTypeSofort
   -> Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe SourceTypeSofort)
-> Parser
     (Maybe SourceOrder
      -> Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe SourceTypeSofort)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"sofort")) Parser
  (Maybe SourceOrder
   -> Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe SourceOrder)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe SourceOrder)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"source_order")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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 SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe SourceTypeThreeDSecure
      -> Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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
"status")) Parser
  (Maybe SourceTypeThreeDSecure
   -> Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe SourceTypeThreeDSecure)
-> Parser
     (Maybe Text
      -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe SourceTypeThreeDSecure)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"three_d_secure")) Parser
  (Maybe Text
   -> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
      -> Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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
"tokenization_method")) Parser
  (Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
   -> Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser
     (Maybe PostCustomersCustomerSourcesIdResponseBody200Type')
-> Parser
     (Maybe Text
      -> Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostCustomersCustomerSourcesIdResponseBody200Type')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"type")) Parser
  (Maybe Text
   -> Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe Text)
-> Parser
     (Maybe SourceTypeWechat
      -> PostCustomersCustomerSourcesIdResponseBody200)
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
"usage")) Parser
  (Maybe SourceTypeWechat
   -> PostCustomersCustomerSourcesIdResponseBody200)
-> Parser (Maybe SourceTypeWechat)
-> Parser PostCustomersCustomerSourcesIdResponseBody200
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe SourceTypeWechat)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"wechat"))

-- | Create a new 'PostCustomersCustomerSourcesIdResponseBody200' with all required fields.
mkPostCustomersCustomerSourcesIdResponseBody200 :: PostCustomersCustomerSourcesIdResponseBody200
mkPostCustomersCustomerSourcesIdResponseBody200 :: PostCustomersCustomerSourcesIdResponseBody200
mkPostCustomersCustomerSourcesIdResponseBody200 =
  PostCustomersCustomerSourcesIdResponseBody200 :: Maybe PostCustomersCustomerSourcesIdResponseBody200Account'Variants
-> Maybe Text
-> Maybe Text
-> Maybe SourceTypeAchCreditTransfer
-> Maybe SourceTypeAchDebit
-> Maybe SourceTypeAcssDebit
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe SourceTypeAlipay
-> Maybe Int
-> Maybe SourceTypeAuBecsDebit
-> Maybe
     [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
-> Maybe SourceTypeBancontact
-> Maybe Text
-> Maybe Text
-> Maybe SourceTypeCard
-> Maybe SourceTypeCardPresent
-> Maybe Text
-> Maybe SourceCodeVerificationFlow
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe SourceTypeEps
-> Maybe Int
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe SourceTypeGiropay
-> Maybe Text
-> Maybe SourceTypeIdeal
-> Maybe SourceTypeKlarna
-> Maybe Text
-> Maybe Bool
-> Maybe Object
-> Maybe SourceTypeMultibanco
-> Maybe Text
-> Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
-> Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
-> Maybe SourceTypeP24
-> Maybe SourceReceiverFlow
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
-> Maybe SourceRedirectFlow
-> Maybe Text
-> Maybe SourceTypeSepaDebit
-> Maybe SourceTypeSofort
-> Maybe SourceOrder
-> Maybe Text
-> Maybe Text
-> Maybe SourceTypeThreeDSecure
-> Maybe Text
-> Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
-> Maybe Text
-> Maybe SourceTypeWechat
-> PostCustomersCustomerSourcesIdResponseBody200
PostCustomersCustomerSourcesIdResponseBody200
    { postCustomersCustomerSourcesIdResponseBody200Account :: Maybe PostCustomersCustomerSourcesIdResponseBody200Account'Variants
postCustomersCustomerSourcesIdResponseBody200Account = Maybe PostCustomersCustomerSourcesIdResponseBody200Account'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200AccountHolderName :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200AccountHolderName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200AccountHolderType :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200AccountHolderType = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200AchCreditTransfer :: Maybe SourceTypeAchCreditTransfer
postCustomersCustomerSourcesIdResponseBody200AchCreditTransfer = Maybe SourceTypeAchCreditTransfer
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200AchDebit :: Maybe SourceTypeAchDebit
postCustomersCustomerSourcesIdResponseBody200AchDebit = Maybe SourceTypeAchDebit
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200AcssDebit :: Maybe SourceTypeAcssDebit
postCustomersCustomerSourcesIdResponseBody200AcssDebit = Maybe SourceTypeAcssDebit
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200AddressCity :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressCity = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200AddressCountry :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressCountry = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200AddressLine1 :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressLine1 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200AddressLine1Check :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressLine1Check = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200AddressLine2 :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressLine2 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200AddressState :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressState = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200AddressZip :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressZip = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200AddressZipCheck :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200AddressZipCheck = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Alipay :: Maybe SourceTypeAlipay
postCustomersCustomerSourcesIdResponseBody200Alipay = Maybe SourceTypeAlipay
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Amount :: Maybe Int
postCustomersCustomerSourcesIdResponseBody200Amount = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200AuBecsDebit :: Maybe SourceTypeAuBecsDebit
postCustomersCustomerSourcesIdResponseBody200AuBecsDebit = Maybe SourceTypeAuBecsDebit
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods :: Maybe
  [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
postCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods = Maybe
  [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Bancontact :: Maybe SourceTypeBancontact
postCustomersCustomerSourcesIdResponseBody200Bancontact = Maybe SourceTypeBancontact
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200BankName :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200BankName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Brand :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Brand = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Card :: Maybe SourceTypeCard
postCustomersCustomerSourcesIdResponseBody200Card = Maybe SourceTypeCard
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200CardPresent :: Maybe SourceTypeCardPresent
postCustomersCustomerSourcesIdResponseBody200CardPresent = Maybe SourceTypeCardPresent
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200ClientSecret :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200ClientSecret = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200CodeVerification :: Maybe SourceCodeVerificationFlow
postCustomersCustomerSourcesIdResponseBody200CodeVerification = Maybe SourceCodeVerificationFlow
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Country :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Country = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Created :: Maybe Int
postCustomersCustomerSourcesIdResponseBody200Created = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Currency :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Currency = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Customer :: Maybe
  PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
postCustomersCustomerSourcesIdResponseBody200Customer = Maybe
  PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200CvcCheck :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200CvcCheck = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200DefaultForCurrency :: Maybe Bool
postCustomersCustomerSourcesIdResponseBody200DefaultForCurrency = Maybe Bool
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200DynamicLast4 :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200DynamicLast4 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Eps :: Maybe SourceTypeEps
postCustomersCustomerSourcesIdResponseBody200Eps = Maybe SourceTypeEps
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200ExpMonth :: Maybe Int
postCustomersCustomerSourcesIdResponseBody200ExpMonth = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200ExpYear :: Maybe Int
postCustomersCustomerSourcesIdResponseBody200ExpYear = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Fingerprint :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Fingerprint = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Flow :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Flow = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Funding :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Funding = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Giropay :: Maybe SourceTypeGiropay
postCustomersCustomerSourcesIdResponseBody200Giropay = Maybe SourceTypeGiropay
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Id :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Id = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Ideal :: Maybe SourceTypeIdeal
postCustomersCustomerSourcesIdResponseBody200Ideal = Maybe SourceTypeIdeal
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Klarna :: Maybe SourceTypeKlarna
postCustomersCustomerSourcesIdResponseBody200Klarna = Maybe SourceTypeKlarna
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Last4 :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Last4 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Livemode :: Maybe Bool
postCustomersCustomerSourcesIdResponseBody200Livemode = Maybe Bool
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Metadata :: Maybe Object
postCustomersCustomerSourcesIdResponseBody200Metadata = Maybe Object
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Multibanco :: Maybe SourceTypeMultibanco
postCustomersCustomerSourcesIdResponseBody200Multibanco = Maybe SourceTypeMultibanco
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Name :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Name = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Object :: Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
postCustomersCustomerSourcesIdResponseBody200Object = Maybe PostCustomersCustomerSourcesIdResponseBody200Object'
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Owner :: Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
postCustomersCustomerSourcesIdResponseBody200Owner = Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200P24 :: Maybe SourceTypeP24
postCustomersCustomerSourcesIdResponseBody200P24 = Maybe SourceTypeP24
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Receiver :: Maybe SourceReceiverFlow
postCustomersCustomerSourcesIdResponseBody200Receiver = Maybe SourceReceiverFlow
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Recipient :: Maybe
  PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
postCustomersCustomerSourcesIdResponseBody200Recipient = Maybe
  PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Redirect :: Maybe SourceRedirectFlow
postCustomersCustomerSourcesIdResponseBody200Redirect = Maybe SourceRedirectFlow
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200RoutingNumber :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200RoutingNumber = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200SepaDebit :: Maybe SourceTypeSepaDebit
postCustomersCustomerSourcesIdResponseBody200SepaDebit = Maybe SourceTypeSepaDebit
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Sofort :: Maybe SourceTypeSofort
postCustomersCustomerSourcesIdResponseBody200Sofort = Maybe SourceTypeSofort
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200SourceOrder :: Maybe SourceOrder
postCustomersCustomerSourcesIdResponseBody200SourceOrder = Maybe SourceOrder
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200StatementDescriptor :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200StatementDescriptor = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Status :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Status = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200ThreeDSecure :: Maybe SourceTypeThreeDSecure
postCustomersCustomerSourcesIdResponseBody200ThreeDSecure = Maybe SourceTypeThreeDSecure
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200TokenizationMethod :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200TokenizationMethod = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Type :: Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
postCustomersCustomerSourcesIdResponseBody200Type = Maybe PostCustomersCustomerSourcesIdResponseBody200Type'
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Usage :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Usage = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Wechat :: Maybe SourceTypeWechat
postCustomersCustomerSourcesIdResponseBody200Wechat = Maybe SourceTypeWechat
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the oneOf schema located at @paths.\/v1\/customers\/{customer}\/sources\/{id}.POST.responses.200.content.application\/json.schema.anyOf.properties.account.anyOf@ in the specification.
--
-- The account this card belongs to. This attribute will not be in the card object if the card belongs to a customer or recipient instead.
data PostCustomersCustomerSourcesIdResponseBody200Account'Variants
  = PostCustomersCustomerSourcesIdResponseBody200Account'Text Data.Text.Internal.Text
  | PostCustomersCustomerSourcesIdResponseBody200Account'Account Account
  deriving (Int
-> PostCustomersCustomerSourcesIdResponseBody200Account'Variants
-> String
-> String
[PostCustomersCustomerSourcesIdResponseBody200Account'Variants]
-> String -> String
PostCustomersCustomerSourcesIdResponseBody200Account'Variants
-> String
(Int
 -> PostCustomersCustomerSourcesIdResponseBody200Account'Variants
 -> String
 -> String)
-> (PostCustomersCustomerSourcesIdResponseBody200Account'Variants
    -> String)
-> ([PostCustomersCustomerSourcesIdResponseBody200Account'Variants]
    -> String -> String)
-> Show
     PostCustomersCustomerSourcesIdResponseBody200Account'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostCustomersCustomerSourcesIdResponseBody200Account'Variants]
-> String -> String
$cshowList :: [PostCustomersCustomerSourcesIdResponseBody200Account'Variants]
-> String -> String
show :: PostCustomersCustomerSourcesIdResponseBody200Account'Variants
-> String
$cshow :: PostCustomersCustomerSourcesIdResponseBody200Account'Variants
-> String
showsPrec :: Int
-> PostCustomersCustomerSourcesIdResponseBody200Account'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostCustomersCustomerSourcesIdResponseBody200Account'Variants
-> String
-> String
GHC.Show.Show, PostCustomersCustomerSourcesIdResponseBody200Account'Variants
-> PostCustomersCustomerSourcesIdResponseBody200Account'Variants
-> Bool
(PostCustomersCustomerSourcesIdResponseBody200Account'Variants
 -> PostCustomersCustomerSourcesIdResponseBody200Account'Variants
 -> Bool)
-> (PostCustomersCustomerSourcesIdResponseBody200Account'Variants
    -> PostCustomersCustomerSourcesIdResponseBody200Account'Variants
    -> Bool)
-> Eq PostCustomersCustomerSourcesIdResponseBody200Account'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersCustomerSourcesIdResponseBody200Account'Variants
-> PostCustomersCustomerSourcesIdResponseBody200Account'Variants
-> Bool
$c/= :: PostCustomersCustomerSourcesIdResponseBody200Account'Variants
-> PostCustomersCustomerSourcesIdResponseBody200Account'Variants
-> Bool
== :: PostCustomersCustomerSourcesIdResponseBody200Account'Variants
-> PostCustomersCustomerSourcesIdResponseBody200Account'Variants
-> Bool
$c== :: PostCustomersCustomerSourcesIdResponseBody200Account'Variants
-> PostCustomersCustomerSourcesIdResponseBody200Account'Variants
-> Bool
GHC.Classes.Eq)

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

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

-- | Defines the enum schema located at @paths.\/v1\/customers\/{customer}\/sources\/{id}.POST.responses.200.content.application\/json.schema.anyOf.properties.available_payout_methods.items@ in the specification.
data PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'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.
    PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"instant"@
    PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'EnumInstant
  | -- | Represents the JSON value @"standard"@
    PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'EnumStandard
  deriving (Int
-> PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
-> String
-> String
[PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
-> String -> String
PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
-> String
(Int
 -> PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
 -> String
 -> String)
-> (PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
    -> String)
-> ([PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
    -> String -> String)
-> Show
     PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
-> String -> String
$cshowList :: [PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods']
-> String -> String
show :: PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
-> String
$cshow :: PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
-> String
showsPrec :: Int
-> PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
-> String
-> String
$cshowsPrec :: Int
-> PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
-> String
-> String
GHC.Show.Show, PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
-> PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
-> Bool
(PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
 -> PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
 -> Bool)
-> (PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
    -> PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
    -> Bool)
-> Eq
     PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
-> PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
-> Bool
$c/= :: PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
-> PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
-> Bool
== :: PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
-> PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
-> Bool
$c== :: PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
-> PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods' where
  toJSON :: PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
-> Value
toJSON (PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'Other Value
val) = Value
val
  toJSON (PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'EnumInstant) = Value
"instant"
  toJSON (PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'EnumStandard) = Value
"standard"

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods' where
  parseJSON :: Value
-> Parser
     PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
parseJSON Value
val =
    PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
-> Parser
     PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
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
"instant" -> PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'EnumInstant
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"standard" -> PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'EnumStandard
            | Bool
GHC.Base.otherwise -> Value
-> PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'
PostCustomersCustomerSourcesIdResponseBody200AvailablePayoutMethods'Other Value
val
      )

-- | Defines the oneOf schema located at @paths.\/v1\/customers\/{customer}\/sources\/{id}.POST.responses.200.content.application\/json.schema.anyOf.properties.customer.anyOf@ in the specification.
--
-- The customer that this card belongs to. This attribute will not be in the card object if the card belongs to an account or recipient instead.
data PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
  = PostCustomersCustomerSourcesIdResponseBody200Customer'Text Data.Text.Internal.Text
  | PostCustomersCustomerSourcesIdResponseBody200Customer'Customer Customer
  | PostCustomersCustomerSourcesIdResponseBody200Customer'DeletedCustomer DeletedCustomer
  deriving (Int
-> PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
-> String
-> String
[PostCustomersCustomerSourcesIdResponseBody200Customer'Variants]
-> String -> String
PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
-> String
(Int
 -> PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
 -> String
 -> String)
-> (PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
    -> String)
-> ([PostCustomersCustomerSourcesIdResponseBody200Customer'Variants]
    -> String -> String)
-> Show
     PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostCustomersCustomerSourcesIdResponseBody200Customer'Variants]
-> String -> String
$cshowList :: [PostCustomersCustomerSourcesIdResponseBody200Customer'Variants]
-> String -> String
show :: PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
-> String
$cshow :: PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
-> String
showsPrec :: Int
-> PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
-> String
-> String
GHC.Show.Show, PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
-> PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
-> Bool
(PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
 -> PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
 -> Bool)
-> (PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
    -> PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
    -> Bool)
-> Eq
     PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
-> PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
-> Bool
$c/= :: PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
-> PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
-> Bool
== :: PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
-> PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
-> Bool
$c== :: PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
-> PostCustomersCustomerSourcesIdResponseBody200Customer'Variants
-> Bool
GHC.Classes.Eq)

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

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

-- | Defines the enum schema located at @paths.\/v1\/customers\/{customer}\/sources\/{id}.POST.responses.200.content.application\/json.schema.anyOf.properties.object@ in the specification.
--
-- String representing the object\'s type. Objects of the same type share the same value.
data PostCustomersCustomerSourcesIdResponseBody200Object'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostCustomersCustomerSourcesIdResponseBody200Object'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.
    PostCustomersCustomerSourcesIdResponseBody200Object'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"card"@
    PostCustomersCustomerSourcesIdResponseBody200Object'EnumCard
  deriving (Int
-> PostCustomersCustomerSourcesIdResponseBody200Object'
-> String
-> String
[PostCustomersCustomerSourcesIdResponseBody200Object']
-> String -> String
PostCustomersCustomerSourcesIdResponseBody200Object' -> String
(Int
 -> PostCustomersCustomerSourcesIdResponseBody200Object'
 -> String
 -> String)
-> (PostCustomersCustomerSourcesIdResponseBody200Object' -> String)
-> ([PostCustomersCustomerSourcesIdResponseBody200Object']
    -> String -> String)
-> Show PostCustomersCustomerSourcesIdResponseBody200Object'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostCustomersCustomerSourcesIdResponseBody200Object']
-> String -> String
$cshowList :: [PostCustomersCustomerSourcesIdResponseBody200Object']
-> String -> String
show :: PostCustomersCustomerSourcesIdResponseBody200Object' -> String
$cshow :: PostCustomersCustomerSourcesIdResponseBody200Object' -> String
showsPrec :: Int
-> PostCustomersCustomerSourcesIdResponseBody200Object'
-> String
-> String
$cshowsPrec :: Int
-> PostCustomersCustomerSourcesIdResponseBody200Object'
-> String
-> String
GHC.Show.Show, PostCustomersCustomerSourcesIdResponseBody200Object'
-> PostCustomersCustomerSourcesIdResponseBody200Object' -> Bool
(PostCustomersCustomerSourcesIdResponseBody200Object'
 -> PostCustomersCustomerSourcesIdResponseBody200Object' -> Bool)
-> (PostCustomersCustomerSourcesIdResponseBody200Object'
    -> PostCustomersCustomerSourcesIdResponseBody200Object' -> Bool)
-> Eq PostCustomersCustomerSourcesIdResponseBody200Object'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersCustomerSourcesIdResponseBody200Object'
-> PostCustomersCustomerSourcesIdResponseBody200Object' -> Bool
$c/= :: PostCustomersCustomerSourcesIdResponseBody200Object'
-> PostCustomersCustomerSourcesIdResponseBody200Object' -> Bool
== :: PostCustomersCustomerSourcesIdResponseBody200Object'
-> PostCustomersCustomerSourcesIdResponseBody200Object' -> Bool
$c== :: PostCustomersCustomerSourcesIdResponseBody200Object'
-> PostCustomersCustomerSourcesIdResponseBody200Object' -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostCustomersCustomerSourcesIdResponseBody200Object' where
  toJSON :: PostCustomersCustomerSourcesIdResponseBody200Object' -> Value
toJSON (PostCustomersCustomerSourcesIdResponseBody200Object'Other Value
val) = Value
val
  toJSON (PostCustomersCustomerSourcesIdResponseBody200Object'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (PostCustomersCustomerSourcesIdResponseBody200Object'
PostCustomersCustomerSourcesIdResponseBody200Object'EnumCard) = Value
"card"

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersCustomerSourcesIdResponseBody200Object' where
  parseJSON :: Value
-> Parser PostCustomersCustomerSourcesIdResponseBody200Object'
parseJSON Value
val =
    PostCustomersCustomerSourcesIdResponseBody200Object'
-> Parser PostCustomersCustomerSourcesIdResponseBody200Object'
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
"card" -> PostCustomersCustomerSourcesIdResponseBody200Object'
PostCustomersCustomerSourcesIdResponseBody200Object'EnumCard
            | Bool
GHC.Base.otherwise -> Value -> PostCustomersCustomerSourcesIdResponseBody200Object'
PostCustomersCustomerSourcesIdResponseBody200Object'Other Value
val
      )

-- | Defines the object schema located at @paths.\/v1\/customers\/{customer}\/sources\/{id}.POST.responses.200.content.application\/json.schema.anyOf.properties.owner.anyOf@ in the specification.
--
-- Information about the owner of the payment instrument that may be used or required by particular source types.
data PostCustomersCustomerSourcesIdResponseBody200Owner' = PostCustomersCustomerSourcesIdResponseBody200Owner'
  { -- | address: Owner\'s address.
    PostCustomersCustomerSourcesIdResponseBody200Owner'
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
postCustomersCustomerSourcesIdResponseBody200Owner'Address :: (GHC.Maybe.Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'Address'),
    -- | email: Owner\'s email address.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200Owner' -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Email :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | name: Owner\'s full name.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200Owner' -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Name :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | phone: Owner\'s phone number (including extension).
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200Owner' -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Phone :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | verified_address: Verified owner\'s address. Verified values are verified or provided by the payment method directly (and if supported) at the time of authorization or settlement. They cannot be set or mutated.
    PostCustomersCustomerSourcesIdResponseBody200Owner'
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress :: (GHC.Maybe.Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'),
    -- | verified_email: Verified owner\'s email address. Verified values are verified or provided by the payment method directly (and if supported) at the time of authorization or settlement. They cannot be set or mutated.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200Owner' -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedEmail :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | verified_name: Verified owner\'s full name. Verified values are verified or provided by the payment method directly (and if supported) at the time of authorization or settlement. They cannot be set or mutated.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200Owner' -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedName :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | verified_phone: Verified owner\'s phone number (including extension). Verified values are verified or provided by the payment method directly (and if supported) at the time of authorization or settlement. They cannot be set or mutated.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200Owner' -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedPhone :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int
-> PostCustomersCustomerSourcesIdResponseBody200Owner'
-> String
-> String
[PostCustomersCustomerSourcesIdResponseBody200Owner']
-> String -> String
PostCustomersCustomerSourcesIdResponseBody200Owner' -> String
(Int
 -> PostCustomersCustomerSourcesIdResponseBody200Owner'
 -> String
 -> String)
-> (PostCustomersCustomerSourcesIdResponseBody200Owner' -> String)
-> ([PostCustomersCustomerSourcesIdResponseBody200Owner']
    -> String -> String)
-> Show PostCustomersCustomerSourcesIdResponseBody200Owner'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostCustomersCustomerSourcesIdResponseBody200Owner']
-> String -> String
$cshowList :: [PostCustomersCustomerSourcesIdResponseBody200Owner']
-> String -> String
show :: PostCustomersCustomerSourcesIdResponseBody200Owner' -> String
$cshow :: PostCustomersCustomerSourcesIdResponseBody200Owner' -> String
showsPrec :: Int
-> PostCustomersCustomerSourcesIdResponseBody200Owner'
-> String
-> String
$cshowsPrec :: Int
-> PostCustomersCustomerSourcesIdResponseBody200Owner'
-> String
-> String
GHC.Show.Show,
      PostCustomersCustomerSourcesIdResponseBody200Owner'
-> PostCustomersCustomerSourcesIdResponseBody200Owner' -> Bool
(PostCustomersCustomerSourcesIdResponseBody200Owner'
 -> PostCustomersCustomerSourcesIdResponseBody200Owner' -> Bool)
-> (PostCustomersCustomerSourcesIdResponseBody200Owner'
    -> PostCustomersCustomerSourcesIdResponseBody200Owner' -> Bool)
-> Eq PostCustomersCustomerSourcesIdResponseBody200Owner'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersCustomerSourcesIdResponseBody200Owner'
-> PostCustomersCustomerSourcesIdResponseBody200Owner' -> Bool
$c/= :: PostCustomersCustomerSourcesIdResponseBody200Owner'
-> PostCustomersCustomerSourcesIdResponseBody200Owner' -> Bool
== :: PostCustomersCustomerSourcesIdResponseBody200Owner'
-> PostCustomersCustomerSourcesIdResponseBody200Owner' -> Bool
$c== :: PostCustomersCustomerSourcesIdResponseBody200Owner'
-> PostCustomersCustomerSourcesIdResponseBody200Owner' -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostCustomersCustomerSourcesIdResponseBody200Owner' where
  toJSON :: PostCustomersCustomerSourcesIdResponseBody200Owner' -> Value
toJSON PostCustomersCustomerSourcesIdResponseBody200Owner'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"address" Text
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200Owner'
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
postCustomersCustomerSourcesIdResponseBody200Owner'Address PostCustomersCustomerSourcesIdResponseBody200Owner'
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..= PostCustomersCustomerSourcesIdResponseBody200Owner' -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Email PostCustomersCustomerSourcesIdResponseBody200Owner'
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..= PostCustomersCustomerSourcesIdResponseBody200Owner' -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Name PostCustomersCustomerSourcesIdResponseBody200Owner'
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..= PostCustomersCustomerSourcesIdResponseBody200Owner' -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Phone PostCustomersCustomerSourcesIdResponseBody200Owner'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"verified_address" Text
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200Owner'
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress PostCustomersCustomerSourcesIdResponseBody200Owner'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"verified_email" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200Owner' -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedEmail PostCustomersCustomerSourcesIdResponseBody200Owner'
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..= PostCustomersCustomerSourcesIdResponseBody200Owner' -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedName PostCustomersCustomerSourcesIdResponseBody200Owner'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"verified_phone" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200Owner' -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedPhone PostCustomersCustomerSourcesIdResponseBody200Owner'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostCustomersCustomerSourcesIdResponseBody200Owner' -> Encoding
toEncoding PostCustomersCustomerSourcesIdResponseBody200Owner'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"address" Text
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200Owner'
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
postCustomersCustomerSourcesIdResponseBody200Owner'Address PostCustomersCustomerSourcesIdResponseBody200Owner'
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..= PostCustomersCustomerSourcesIdResponseBody200Owner' -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Email PostCustomersCustomerSourcesIdResponseBody200Owner'
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..= PostCustomersCustomerSourcesIdResponseBody200Owner' -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Name PostCustomersCustomerSourcesIdResponseBody200Owner'
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..= PostCustomersCustomerSourcesIdResponseBody200Owner' -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Phone PostCustomersCustomerSourcesIdResponseBody200Owner'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"verified_address" Text
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200Owner'
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress PostCustomersCustomerSourcesIdResponseBody200Owner'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"verified_email" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200Owner' -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedEmail PostCustomersCustomerSourcesIdResponseBody200Owner'
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..= PostCustomersCustomerSourcesIdResponseBody200Owner' -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedName PostCustomersCustomerSourcesIdResponseBody200Owner'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"verified_phone" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200Owner' -> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedPhone PostCustomersCustomerSourcesIdResponseBody200Owner'
obj))))))))

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

-- | Create a new 'PostCustomersCustomerSourcesIdResponseBody200Owner'' with all required fields.
mkPostCustomersCustomerSourcesIdResponseBody200Owner' :: PostCustomersCustomerSourcesIdResponseBody200Owner'
mkPostCustomersCustomerSourcesIdResponseBody200Owner' :: PostCustomersCustomerSourcesIdResponseBody200Owner'
mkPostCustomersCustomerSourcesIdResponseBody200Owner' =
  PostCustomersCustomerSourcesIdResponseBody200Owner' :: Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe
     PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostCustomersCustomerSourcesIdResponseBody200Owner'
PostCustomersCustomerSourcesIdResponseBody200Owner'
    { postCustomersCustomerSourcesIdResponseBody200Owner'Address :: Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
postCustomersCustomerSourcesIdResponseBody200Owner'Address = Maybe PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Owner'Email :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Email = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Owner'Name :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Name = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Owner'Phone :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Phone = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress :: Maybe
  PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress = Maybe
  PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedEmail :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedEmail = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedName :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedPhone :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedPhone = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the object schema located at @paths.\/v1\/customers\/{customer}\/sources\/{id}.POST.responses.200.content.application\/json.schema.anyOf.properties.owner.anyOf.properties.address.anyOf@ in the specification.
--
-- Owner\\\'s address.
data PostCustomersCustomerSourcesIdResponseBody200Owner'Address' = PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
  { -- | city: City, district, suburb, town, or village.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Address'City :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | country: Two-letter country code ([ISO 3166-1 alpha-2](https:\/\/en.wikipedia.org\/wiki\/ISO_3166-1_alpha-2)).
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Address'Country :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | line1: Address line 1 (e.g., street, PO Box, or company name).
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Address'Line1 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | line2: Address line 2 (e.g., apartment, suite, unit, or building).
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Address'Line2 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | postal_code: ZIP or postal code.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Address'PostalCode :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | state: State, county, province, or region.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Address'State :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int
-> PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> String
-> String
[PostCustomersCustomerSourcesIdResponseBody200Owner'Address']
-> String -> String
PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> String
(Int
 -> PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
 -> String
 -> String)
-> (PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
    -> String)
-> ([PostCustomersCustomerSourcesIdResponseBody200Owner'Address']
    -> String -> String)
-> Show PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostCustomersCustomerSourcesIdResponseBody200Owner'Address']
-> String -> String
$cshowList :: [PostCustomersCustomerSourcesIdResponseBody200Owner'Address']
-> String -> String
show :: PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> String
$cshow :: PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> String
showsPrec :: Int
-> PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> String
-> String
$cshowsPrec :: Int
-> PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> String
-> String
GHC.Show.Show,
      PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Bool
(PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
 -> PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
 -> Bool)
-> (PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
    -> PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
    -> Bool)
-> Eq PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Bool
$c/= :: PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Bool
== :: PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Bool
$c== :: PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostCustomersCustomerSourcesIdResponseBody200Owner'Address' where
  toJSON :: PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Value
toJSON PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"city" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Address'City PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"country" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Address'Country PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
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..= PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Address'Line1 PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"line2" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Address'Line2 PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"postal_code" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Address'PostalCode PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"state" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Address'State PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Encoding
toEncoding PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"city" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Address'City PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"country" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Address'Country PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
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..= PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Address'Line1 PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"line2" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Address'Line2 PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"postal_code" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Address'PostalCode PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"state" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
-> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Address'State PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
obj))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersCustomerSourcesIdResponseBody200Owner'Address' where
  parseJSON :: Value
-> Parser
     PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
parseJSON = String
-> (Object
    -> Parser
         PostCustomersCustomerSourcesIdResponseBody200Owner'Address')
-> Value
-> Parser
     PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostCustomersCustomerSourcesIdResponseBody200Owner'Address'" (\Object
obj -> ((((((Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> PostCustomersCustomerSourcesIdResponseBody200Owner'Address')
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostCustomersCustomerSourcesIdResponseBody200Owner'Address')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
PostCustomersCustomerSourcesIdResponseBody200Owner'Address' Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostCustomersCustomerSourcesIdResponseBody200Owner'Address')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostCustomersCustomerSourcesIdResponseBody200Owner'Address')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"city")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostCustomersCustomerSourcesIdResponseBody200Owner'Address')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostCustomersCustomerSourcesIdResponseBody200Owner'Address')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"country")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostCustomersCustomerSourcesIdResponseBody200Owner'Address')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostCustomersCustomerSourcesIdResponseBody200Owner'Address')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"line1")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostCustomersCustomerSourcesIdResponseBody200Owner'Address')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> PostCustomersCustomerSourcesIdResponseBody200Owner'Address')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"line2")) Parser
  (Maybe Text
   -> Maybe Text
   -> PostCustomersCustomerSourcesIdResponseBody200Owner'Address')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> PostCustomersCustomerSourcesIdResponseBody200Owner'Address')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"postal_code")) Parser
  (Maybe Text
   -> PostCustomersCustomerSourcesIdResponseBody200Owner'Address')
-> Parser (Maybe Text)
-> Parser
     PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"state"))

-- | Create a new 'PostCustomersCustomerSourcesIdResponseBody200Owner'Address'' with all required fields.
mkPostCustomersCustomerSourcesIdResponseBody200Owner'Address' :: PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
mkPostCustomersCustomerSourcesIdResponseBody200Owner'Address' :: PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
mkPostCustomersCustomerSourcesIdResponseBody200Owner'Address' =
  PostCustomersCustomerSourcesIdResponseBody200Owner'Address' :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
PostCustomersCustomerSourcesIdResponseBody200Owner'Address'
    { postCustomersCustomerSourcesIdResponseBody200Owner'Address'City :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Address'City = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Owner'Address'Country :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Address'Country = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Owner'Address'Line1 :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Address'Line1 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Owner'Address'Line2 :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Address'Line2 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Owner'Address'PostalCode :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Address'PostalCode = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Owner'Address'State :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'Address'State = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the object schema located at @paths.\/v1\/customers\/{customer}\/sources\/{id}.POST.responses.200.content.application\/json.schema.anyOf.properties.owner.anyOf.properties.verified_address.anyOf@ in the specification.
--
-- Verified owner\\\'s address. Verified values are verified or provided by the payment method directly (and if supported) at the time of authorization or settlement. They cannot be set or mutated.
data PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress' = PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
  { -- | city: City, district, suburb, town, or village.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
-> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'City :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | country: Two-letter country code ([ISO 3166-1 alpha-2](https:\/\/en.wikipedia.org\/wiki\/ISO_3166-1_alpha-2)).
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
-> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'Country :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | line1: Address line 1 (e.g., street, PO Box, or company name).
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
-> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'Line1 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | line2: Address line 2 (e.g., apartment, suite, unit, or building).
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
-> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'Line2 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | postal_code: ZIP or postal code.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
-> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'PostalCode :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | state: State, county, province, or region.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
-> Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'State :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int
-> PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
-> String
-> String
[PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress']
-> String -> String
PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
-> String
(Int
 -> PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
 -> String
 -> String)
-> (PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
    -> String)
-> ([PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress']
    -> String -> String)
-> Show
     PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress']
-> String -> String
$cshowList :: [PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress']
-> String -> String
show :: PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
-> String
$cshow :: PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
-> String
showsPrec :: Int
-> PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
-> String
-> String
$cshowsPrec :: Int
-> PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
-> String
-> String
GHC.Show.Show,
      PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
-> PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
-> Bool
(PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
 -> PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
 -> Bool)
-> (PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
    -> PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
    -> Bool)
-> Eq
     PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
-> PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
-> Bool
$c/= :: PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
-> PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
-> Bool
== :: PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
-> PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
-> Bool
$c== :: PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
-> PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
-> Bool
GHC.Classes.Eq
    )

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

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress' where
  parseJSON :: Value
-> Parser
     PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
parseJSON = String
-> (Object
    -> Parser
         PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress')
-> Value
-> Parser
     PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'" (\Object
obj -> ((((((Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress')
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress' Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress')
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
   -> PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress')
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
   -> PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress')
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
   -> PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress')
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
   -> PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress')
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
   -> PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress')
-> Parser (Maybe Text)
-> Parser
     PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
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 'PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'' with all required fields.
mkPostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress' :: PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
mkPostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress' :: PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
mkPostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress' =
  PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress' :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
PostCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'
    { postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'City :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'City = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'Country :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'Country = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'Line1 :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'Line1 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'Line2 :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'Line2 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'PostalCode :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'PostalCode = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'State :: Maybe Text
postCustomersCustomerSourcesIdResponseBody200Owner'VerifiedAddress'State = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the oneOf schema located at @paths.\/v1\/customers\/{customer}\/sources\/{id}.POST.responses.200.content.application\/json.schema.anyOf.properties.recipient.anyOf@ in the specification.
--
-- The recipient that this card belongs to. This attribute will not be in the card object if the card belongs to a customer or account instead.
data PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
  = PostCustomersCustomerSourcesIdResponseBody200Recipient'Text Data.Text.Internal.Text
  | PostCustomersCustomerSourcesIdResponseBody200Recipient'Recipient Recipient
  deriving (Int
-> PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
-> String
-> String
[PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants]
-> String -> String
PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
-> String
(Int
 -> PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
 -> String
 -> String)
-> (PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
    -> String)
-> ([PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants]
    -> String -> String)
-> Show
     PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants]
-> String -> String
$cshowList :: [PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants]
-> String -> String
show :: PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
-> String
$cshow :: PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
-> String
showsPrec :: Int
-> PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
-> String
-> String
GHC.Show.Show, PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
-> PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
-> Bool
(PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
 -> PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
 -> Bool)
-> (PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
    -> PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
    -> Bool)
-> Eq
     PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
-> PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
-> Bool
$c/= :: PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
-> PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
-> Bool
== :: PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
-> PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
-> Bool
$c== :: PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
-> PostCustomersCustomerSourcesIdResponseBody200Recipient'Variants
-> Bool
GHC.Classes.Eq)

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

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

-- | Defines the enum schema located at @paths.\/v1\/customers\/{customer}\/sources\/{id}.POST.responses.200.content.application\/json.schema.anyOf.properties.type@ in the specification.
--
-- The \`type\` of the source. The \`type\` is a payment method, one of \`ach_credit_transfer\`, \`ach_debit\`, \`alipay\`, \`bancontact\`, \`card\`, \`card_present\`, \`eps\`, \`giropay\`, \`ideal\`, \`multibanco\`, \`klarna\`, \`p24\`, \`sepa_debit\`, \`sofort\`, \`three_d_secure\`, or \`wechat\`. An additional hash is included on the source with a name matching this value. It contains additional information specific to the [payment method](https:\/\/stripe.com\/docs\/sources) used.
data PostCustomersCustomerSourcesIdResponseBody200Type'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostCustomersCustomerSourcesIdResponseBody200Type'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.
    PostCustomersCustomerSourcesIdResponseBody200Type'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"ach_credit_transfer"@
    PostCustomersCustomerSourcesIdResponseBody200Type'EnumAchCreditTransfer
  | -- | Represents the JSON value @"ach_debit"@
    PostCustomersCustomerSourcesIdResponseBody200Type'EnumAchDebit
  | -- | Represents the JSON value @"acss_debit"@
    PostCustomersCustomerSourcesIdResponseBody200Type'EnumAcssDebit
  | -- | Represents the JSON value @"alipay"@
    PostCustomersCustomerSourcesIdResponseBody200Type'EnumAlipay
  | -- | Represents the JSON value @"au_becs_debit"@
    PostCustomersCustomerSourcesIdResponseBody200Type'EnumAuBecsDebit
  | -- | Represents the JSON value @"bancontact"@
    PostCustomersCustomerSourcesIdResponseBody200Type'EnumBancontact
  | -- | Represents the JSON value @"card"@
    PostCustomersCustomerSourcesIdResponseBody200Type'EnumCard
  | -- | Represents the JSON value @"card_present"@
    PostCustomersCustomerSourcesIdResponseBody200Type'EnumCardPresent
  | -- | Represents the JSON value @"eps"@
    PostCustomersCustomerSourcesIdResponseBody200Type'EnumEps
  | -- | Represents the JSON value @"giropay"@
    PostCustomersCustomerSourcesIdResponseBody200Type'EnumGiropay
  | -- | Represents the JSON value @"ideal"@
    PostCustomersCustomerSourcesIdResponseBody200Type'EnumIdeal
  | -- | Represents the JSON value @"klarna"@
    PostCustomersCustomerSourcesIdResponseBody200Type'EnumKlarna
  | -- | Represents the JSON value @"multibanco"@
    PostCustomersCustomerSourcesIdResponseBody200Type'EnumMultibanco
  | -- | Represents the JSON value @"p24"@
    PostCustomersCustomerSourcesIdResponseBody200Type'EnumP24
  | -- | Represents the JSON value @"sepa_debit"@
    PostCustomersCustomerSourcesIdResponseBody200Type'EnumSepaDebit
  | -- | Represents the JSON value @"sofort"@
    PostCustomersCustomerSourcesIdResponseBody200Type'EnumSofort
  | -- | Represents the JSON value @"three_d_secure"@
    PostCustomersCustomerSourcesIdResponseBody200Type'EnumThreeDSecure
  | -- | Represents the JSON value @"wechat"@
    PostCustomersCustomerSourcesIdResponseBody200Type'EnumWechat
  deriving (Int
-> PostCustomersCustomerSourcesIdResponseBody200Type'
-> String
-> String
[PostCustomersCustomerSourcesIdResponseBody200Type']
-> String -> String
PostCustomersCustomerSourcesIdResponseBody200Type' -> String
(Int
 -> PostCustomersCustomerSourcesIdResponseBody200Type'
 -> String
 -> String)
-> (PostCustomersCustomerSourcesIdResponseBody200Type' -> String)
-> ([PostCustomersCustomerSourcesIdResponseBody200Type']
    -> String -> String)
-> Show PostCustomersCustomerSourcesIdResponseBody200Type'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostCustomersCustomerSourcesIdResponseBody200Type']
-> String -> String
$cshowList :: [PostCustomersCustomerSourcesIdResponseBody200Type']
-> String -> String
show :: PostCustomersCustomerSourcesIdResponseBody200Type' -> String
$cshow :: PostCustomersCustomerSourcesIdResponseBody200Type' -> String
showsPrec :: Int
-> PostCustomersCustomerSourcesIdResponseBody200Type'
-> String
-> String
$cshowsPrec :: Int
-> PostCustomersCustomerSourcesIdResponseBody200Type'
-> String
-> String
GHC.Show.Show, PostCustomersCustomerSourcesIdResponseBody200Type'
-> PostCustomersCustomerSourcesIdResponseBody200Type' -> Bool
(PostCustomersCustomerSourcesIdResponseBody200Type'
 -> PostCustomersCustomerSourcesIdResponseBody200Type' -> Bool)
-> (PostCustomersCustomerSourcesIdResponseBody200Type'
    -> PostCustomersCustomerSourcesIdResponseBody200Type' -> Bool)
-> Eq PostCustomersCustomerSourcesIdResponseBody200Type'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersCustomerSourcesIdResponseBody200Type'
-> PostCustomersCustomerSourcesIdResponseBody200Type' -> Bool
$c/= :: PostCustomersCustomerSourcesIdResponseBody200Type'
-> PostCustomersCustomerSourcesIdResponseBody200Type' -> Bool
== :: PostCustomersCustomerSourcesIdResponseBody200Type'
-> PostCustomersCustomerSourcesIdResponseBody200Type' -> Bool
$c== :: PostCustomersCustomerSourcesIdResponseBody200Type'
-> PostCustomersCustomerSourcesIdResponseBody200Type' -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostCustomersCustomerSourcesIdResponseBody200Type' where
  toJSON :: PostCustomersCustomerSourcesIdResponseBody200Type' -> Value
toJSON (PostCustomersCustomerSourcesIdResponseBody200Type'Other Value
val) = Value
val
  toJSON (PostCustomersCustomerSourcesIdResponseBody200Type'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumAchCreditTransfer) = Value
"ach_credit_transfer"
  toJSON (PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumAchDebit) = Value
"ach_debit"
  toJSON (PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumAcssDebit) = Value
"acss_debit"
  toJSON (PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumAlipay) = Value
"alipay"
  toJSON (PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumAuBecsDebit) = Value
"au_becs_debit"
  toJSON (PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumBancontact) = Value
"bancontact"
  toJSON (PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumCard) = Value
"card"
  toJSON (PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumCardPresent) = Value
"card_present"
  toJSON (PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumEps) = Value
"eps"
  toJSON (PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumGiropay) = Value
"giropay"
  toJSON (PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumIdeal) = Value
"ideal"
  toJSON (PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumKlarna) = Value
"klarna"
  toJSON (PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumMultibanco) = Value
"multibanco"
  toJSON (PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumP24) = Value
"p24"
  toJSON (PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumSepaDebit) = Value
"sepa_debit"
  toJSON (PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumSofort) = Value
"sofort"
  toJSON (PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumThreeDSecure) = Value
"three_d_secure"
  toJSON (PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumWechat) = Value
"wechat"

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersCustomerSourcesIdResponseBody200Type' where
  parseJSON :: Value -> Parser PostCustomersCustomerSourcesIdResponseBody200Type'
parseJSON Value
val =
    PostCustomersCustomerSourcesIdResponseBody200Type'
-> Parser PostCustomersCustomerSourcesIdResponseBody200Type'
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
"ach_credit_transfer" -> PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumAchCreditTransfer
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ach_debit" -> PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumAchDebit
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"acss_debit" -> PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumAcssDebit
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"alipay" -> PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumAlipay
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"au_becs_debit" -> PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumAuBecsDebit
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"bancontact" -> PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumBancontact
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"card" -> PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumCard
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"card_present" -> PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumCardPresent
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"eps" -> PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumEps
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"giropay" -> PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumGiropay
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ideal" -> PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumIdeal
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"klarna" -> PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumKlarna
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"multibanco" -> PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumMultibanco
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"p24" -> PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumP24
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"sepa_debit" -> PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumSepaDebit
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"sofort" -> PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumSofort
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"three_d_secure" -> PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumThreeDSecure
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"wechat" -> PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'EnumWechat
            | Bool
GHC.Base.otherwise -> Value -> PostCustomersCustomerSourcesIdResponseBody200Type'
PostCustomersCustomerSourcesIdResponseBody200Type'Other Value
val
      )