{-# 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 postCustomersCustomer
module StripeAPI.Operations.PostCustomersCustomer 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}
--
-- \<p>Updates the specified customer by setting the values of the parameters passed. Any parameters not provided will be left unchanged. For example, if you pass the \<strong>source\<\/strong> parameter, that becomes the customer’s active source (e.g., a card) to be used for all charges in the future. When you update a customer to a new valid card source by passing the \<strong>source\<\/strong> parameter: for each of the customer’s current subscriptions, if the subscription bills automatically and is in the \<code>past_due\<\/code> state, then the latest open invoice for the subscription with automatic collection enabled will be retried. This retry will not count as an automatic retry, and will not affect the next regularly scheduled payment for the invoice. Changing the \<strong>default_source\<\/strong> for a customer will not trigger this behavior.\<\/p>
--
-- \<p>This request accepts mostly the same arguments as the customer creation call.\<\/p>
postCustomersCustomer ::
  forall m.
  StripeAPI.Common.MonadHTTP m =>
  -- | customer | Constraints: Maximum length of 5000
  Data.Text.Internal.Text ->
  -- | The request body to send
  GHC.Maybe.Maybe PostCustomersCustomerRequestBody ->
  -- | Monadic computation which returns the result of the operation
  StripeAPI.Common.StripeT m (Network.HTTP.Client.Types.Response PostCustomersCustomerResponse)
postCustomersCustomer :: Text
-> Maybe PostCustomersCustomerRequestBody
-> StripeT m (Response PostCustomersCustomerResponse)
postCustomersCustomer
  Text
customer
  Maybe PostCustomersCustomerRequestBody
body =
    (Response ByteString -> Response PostCustomersCustomerResponse)
-> StripeT m (Response ByteString)
-> StripeT m (Response PostCustomersCustomerResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
      ( \Response ByteString
response_0 ->
          (ByteString -> PostCustomersCustomerResponse)
-> Response ByteString -> Response PostCustomersCustomerResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
            ( (String -> PostCustomersCustomerResponse)
-> (PostCustomersCustomerResponse -> PostCustomersCustomerResponse)
-> Either String PostCustomersCustomerResponse
-> PostCustomersCustomerResponse
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Data.Either.either String -> PostCustomersCustomerResponse
PostCustomersCustomerResponseError PostCustomersCustomerResponse -> PostCustomersCustomerResponse
forall a. a -> a
GHC.Base.id
                (Either String PostCustomersCustomerResponse
 -> PostCustomersCustomerResponse)
-> (ByteString -> Either String PostCustomersCustomerResponse)
-> ByteString
-> PostCustomersCustomerResponse
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) ->
                                     Customer -> PostCustomersCustomerResponse
PostCustomersCustomerResponse200
                                       (Customer -> PostCustomersCustomerResponse)
-> Either String Customer
-> Either String PostCustomersCustomerResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> ( ByteString -> Either String Customer
forall a. FromJSON a => ByteString -> Either String a
Data.Aeson.eitherDecodeStrict ByteString
body ::
                                                            Data.Either.Either
                                                              GHC.Base.String
                                                              Customer
                                                        )
                                   | 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 -> PostCustomersCustomerResponse
PostCustomersCustomerResponseDefault
                                       (Error -> PostCustomersCustomerResponse)
-> Either String Error
-> Either String PostCustomersCustomerResponse
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 PostCustomersCustomerResponse
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 PostCustomersCustomerRequestBody
-> RequestBodyEncoding
-> StripeT m (Response ByteString)
forall (m :: * -> *) body.
(MonadHTTP m, ToJSON body) =>
Text
-> Text
-> [QueryParameter]
-> Maybe body
-> RequestBodyEncoding
-> StripeT m (Response ByteString)
StripeAPI.Common.doBodyCallWithConfigurationM (Text -> Text
Data.Text.toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
GHC.Base.$ String -> Text
Data.Text.pack String
"POST") (String -> Text
Data.Text.pack (String
"/v1/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 Text
customer)) String -> String -> String
forall a. [a] -> [a] -> [a]
GHC.Base.++ String
""))) [QueryParameter]
forall a. Monoid a => a
GHC.Base.mempty Maybe PostCustomersCustomerRequestBody
body RequestBodyEncoding
StripeAPI.Common.RequestBodyEncodingFormData)

-- | Defines the object schema located at @paths.\/v1\/customers\/{customer}.POST.requestBody.content.application\/x-www-form-urlencoded.schema@ in the specification.
data PostCustomersCustomerRequestBody = PostCustomersCustomerRequestBody
  { -- | address: The customer\'s address.
    PostCustomersCustomerRequestBody
-> Maybe PostCustomersCustomerRequestBodyAddress'Variants
postCustomersCustomerRequestBodyAddress :: (GHC.Maybe.Maybe PostCustomersCustomerRequestBodyAddress'Variants),
    -- | balance: An integer amount in %s that represents the customer\'s current balance, which affect the customer\'s future invoices. A negative amount represents a credit that decreases the amount due on an invoice; a positive amount increases the amount due on an invoice.
    PostCustomersCustomerRequestBody -> Maybe Int
postCustomersCustomerRequestBodyBalance :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | bank_account: Either a token, like the ones returned by [Stripe.js](https:\/\/stripe.com\/docs\/stripe.js), or a dictionary containing a user\'s bank account details.
    PostCustomersCustomerRequestBody
-> Maybe PostCustomersCustomerRequestBodyBankAccount'Variants
postCustomersCustomerRequestBodyBankAccount :: (GHC.Maybe.Maybe PostCustomersCustomerRequestBodyBankAccount'Variants),
    -- | card: A token, like the ones returned by [Stripe.js](https:\/\/stripe.com\/docs\/stripe.js).
    PostCustomersCustomerRequestBody
-> Maybe PostCustomersCustomerRequestBodyCard'Variants
postCustomersCustomerRequestBodyCard :: (GHC.Maybe.Maybe PostCustomersCustomerRequestBodyCard'Variants),
    -- | coupon
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyCoupon :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | default_alipay_account: ID of Alipay account to make the customer\'s new default for invoice payments.
    --
    -- Constraints:
    --
    -- * Maximum length of 500
    PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyDefaultAlipayAccount :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | default_bank_account: ID of bank account to make the customer\'s new default for invoice payments.
    --
    -- Constraints:
    --
    -- * Maximum length of 500
    PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyDefaultBankAccount :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | default_card: ID of card to make the customer\'s new default for invoice payments.
    --
    -- Constraints:
    --
    -- * Maximum length of 500
    PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyDefaultCard :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | default_source: If you are using payment methods created via the PaymentMethods API, see the [invoice_settings.default_payment_method](https:\/\/stripe.com\/docs\/api\/customers\/update\#update_customer-invoice_settings-default_payment_method) parameter.
    --
    -- Provide the ID of a payment source already attached to this customer to make it this customer\'s default payment source.
    --
    -- If you want to add a new payment source and make it the default, see the [source](https:\/\/stripe.com\/docs\/api\/customers\/update\#update_customer-source) property.
    --
    -- Constraints:
    --
    -- * Maximum length of 500
    PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyDefaultSource :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | description: An arbitrary string that you can attach to a customer object. It is displayed alongside the customer in the dashboard.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyDescription :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | email: Customer\'s email address. It\'s displayed alongside the customer in your dashboard and can be useful for searching and tracking. This may be up to *512 characters*.
    --
    -- Constraints:
    --
    -- * Maximum length of 512
    PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyEmail :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | expand: Specifies which fields in the response should be expanded.
    PostCustomersCustomerRequestBody -> Maybe [Text]
postCustomersCustomerRequestBodyExpand :: (GHC.Maybe.Maybe ([Data.Text.Internal.Text])),
    -- | invoice_prefix: The prefix for the customer used to generate unique invoice numbers. Must be 3–12 uppercase letters or numbers.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyInvoicePrefix :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | invoice_settings: Default invoice settings for this customer.
    PostCustomersCustomerRequestBody
-> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
postCustomersCustomerRequestBodyInvoiceSettings :: (GHC.Maybe.Maybe PostCustomersCustomerRequestBodyInvoiceSettings'),
    -- | 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\`.
    PostCustomersCustomerRequestBody
-> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
postCustomersCustomerRequestBodyMetadata :: (GHC.Maybe.Maybe PostCustomersCustomerRequestBodyMetadata'Variants),
    -- | name: The customer\'s full name or business name.
    --
    -- Constraints:
    --
    -- * Maximum length of 256
    PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyName :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | next_invoice_sequence: The sequence to be used on the customer\'s next invoice. Defaults to 1.
    PostCustomersCustomerRequestBody -> Maybe Int
postCustomersCustomerRequestBodyNextInvoiceSequence :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | phone: The customer\'s phone number.
    --
    -- Constraints:
    --
    -- * Maximum length of 20
    PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyPhone :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | preferred_locales: Customer\'s preferred languages, ordered by preference.
    PostCustomersCustomerRequestBody -> Maybe [Text]
postCustomersCustomerRequestBodyPreferredLocales :: (GHC.Maybe.Maybe ([Data.Text.Internal.Text])),
    -- | promotion_code: The API ID of a promotion code to apply to the customer. The customer will have a discount applied on all recurring payments. Charges you create through the API will not have the discount.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyPromotionCode :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | shipping: The customer\'s shipping information. Appears on invoices emailed to this customer.
    PostCustomersCustomerRequestBody
-> Maybe PostCustomersCustomerRequestBodyShipping'Variants
postCustomersCustomerRequestBodyShipping :: (GHC.Maybe.Maybe PostCustomersCustomerRequestBodyShipping'Variants),
    -- | source
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodySource :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | tax: Tax details about the customer.
    PostCustomersCustomerRequestBody
-> Maybe PostCustomersCustomerRequestBodyTax'
postCustomersCustomerRequestBodyTax :: (GHC.Maybe.Maybe PostCustomersCustomerRequestBodyTax'),
    -- | tax_exempt: The customer\'s tax exemption. One of \`none\`, \`exempt\`, or \`reverse\`.
    PostCustomersCustomerRequestBody
-> Maybe PostCustomersCustomerRequestBodyTaxExempt'
postCustomersCustomerRequestBodyTaxExempt :: (GHC.Maybe.Maybe PostCustomersCustomerRequestBodyTaxExempt'),
    -- | trial_end: Unix timestamp representing the end of the trial period the customer will get before being charged for the first time. This will always overwrite any trials that might apply via a subscribed plan. If set, trial_end will override the default trial period of the plan the customer is being subscribed to. The special value \`now\` can be provided to end the customer\'s trial immediately. Can be at most two years from \`billing_cycle_anchor\`.
    PostCustomersCustomerRequestBody
-> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
postCustomersCustomerRequestBodyTrialEnd :: (GHC.Maybe.Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants)
  }
  deriving
    ( Int -> PostCustomersCustomerRequestBody -> String -> String
[PostCustomersCustomerRequestBody] -> String -> String
PostCustomersCustomerRequestBody -> String
(Int -> PostCustomersCustomerRequestBody -> String -> String)
-> (PostCustomersCustomerRequestBody -> String)
-> ([PostCustomersCustomerRequestBody] -> String -> String)
-> Show PostCustomersCustomerRequestBody
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostCustomersCustomerRequestBody] -> String -> String
$cshowList :: [PostCustomersCustomerRequestBody] -> String -> String
show :: PostCustomersCustomerRequestBody -> String
$cshow :: PostCustomersCustomerRequestBody -> String
showsPrec :: Int -> PostCustomersCustomerRequestBody -> String -> String
$cshowsPrec :: Int -> PostCustomersCustomerRequestBody -> String -> String
GHC.Show.Show,
      PostCustomersCustomerRequestBody
-> PostCustomersCustomerRequestBody -> Bool
(PostCustomersCustomerRequestBody
 -> PostCustomersCustomerRequestBody -> Bool)
-> (PostCustomersCustomerRequestBody
    -> PostCustomersCustomerRequestBody -> Bool)
-> Eq PostCustomersCustomerRequestBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersCustomerRequestBody
-> PostCustomersCustomerRequestBody -> Bool
$c/= :: PostCustomersCustomerRequestBody
-> PostCustomersCustomerRequestBody -> Bool
== :: PostCustomersCustomerRequestBody
-> PostCustomersCustomerRequestBody -> Bool
$c== :: PostCustomersCustomerRequestBody
-> PostCustomersCustomerRequestBody -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostCustomersCustomerRequestBody where
  toJSON :: PostCustomersCustomerRequestBody -> Value
toJSON PostCustomersCustomerRequestBody
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"address" Text
-> Maybe PostCustomersCustomerRequestBodyAddress'Variants -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody
-> Maybe PostCustomersCustomerRequestBodyAddress'Variants
postCustomersCustomerRequestBodyAddress PostCustomersCustomerRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"balance" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody -> Maybe Int
postCustomersCustomerRequestBodyBalance PostCustomersCustomerRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"bank_account" Text
-> Maybe PostCustomersCustomerRequestBodyBankAccount'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody
-> Maybe PostCustomersCustomerRequestBodyBankAccount'Variants
postCustomersCustomerRequestBodyBankAccount PostCustomersCustomerRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"card" Text -> Maybe PostCustomersCustomerRequestBodyCard'Variants -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody
-> Maybe PostCustomersCustomerRequestBodyCard'Variants
postCustomersCustomerRequestBodyCard PostCustomersCustomerRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"coupon" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyCoupon PostCustomersCustomerRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"default_alipay_account" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyDefaultAlipayAccount PostCustomersCustomerRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"default_bank_account" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyDefaultBankAccount PostCustomersCustomerRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"default_card" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyDefaultCard PostCustomersCustomerRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"default_source" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyDefaultSource PostCustomersCustomerRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"description" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyDescription PostCustomersCustomerRequestBody
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..= PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyEmail PostCustomersCustomerRequestBody
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..= PostCustomersCustomerRequestBody -> Maybe [Text]
postCustomersCustomerRequestBodyExpand PostCustomersCustomerRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"invoice_prefix" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyInvoicePrefix PostCustomersCustomerRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"invoice_settings" Text
-> Maybe PostCustomersCustomerRequestBodyInvoiceSettings' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody
-> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
postCustomersCustomerRequestBodyInvoiceSettings PostCustomersCustomerRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"metadata" Text
-> Maybe PostCustomersCustomerRequestBodyMetadata'Variants -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody
-> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
postCustomersCustomerRequestBodyMetadata PostCustomersCustomerRequestBody
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..= PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyName PostCustomersCustomerRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"next_invoice_sequence" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody -> Maybe Int
postCustomersCustomerRequestBodyNextInvoiceSequence PostCustomersCustomerRequestBody
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..= PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyPhone PostCustomersCustomerRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"preferred_locales" Text -> Maybe [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody -> Maybe [Text]
postCustomersCustomerRequestBodyPreferredLocales PostCustomersCustomerRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"promotion_code" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyPromotionCode PostCustomersCustomerRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"shipping" Text
-> Maybe PostCustomersCustomerRequestBodyShipping'Variants -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody
-> Maybe PostCustomersCustomerRequestBodyShipping'Variants
postCustomersCustomerRequestBodyShipping PostCustomersCustomerRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"source" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodySource PostCustomersCustomerRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"tax" Text -> Maybe PostCustomersCustomerRequestBodyTax' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody
-> Maybe PostCustomersCustomerRequestBodyTax'
postCustomersCustomerRequestBodyTax PostCustomersCustomerRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"tax_exempt" Text -> Maybe PostCustomersCustomerRequestBodyTaxExempt' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody
-> Maybe PostCustomersCustomerRequestBodyTaxExempt'
postCustomersCustomerRequestBodyTaxExempt PostCustomersCustomerRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"trial_end" Text
-> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody
-> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
postCustomersCustomerRequestBodyTrialEnd PostCustomersCustomerRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostCustomersCustomerRequestBody -> Encoding
toEncoding PostCustomersCustomerRequestBody
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"address" Text
-> Maybe PostCustomersCustomerRequestBodyAddress'Variants -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody
-> Maybe PostCustomersCustomerRequestBodyAddress'Variants
postCustomersCustomerRequestBodyAddress PostCustomersCustomerRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"balance" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody -> Maybe Int
postCustomersCustomerRequestBodyBalance PostCustomersCustomerRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"bank_account" Text
-> Maybe PostCustomersCustomerRequestBodyBankAccount'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody
-> Maybe PostCustomersCustomerRequestBodyBankAccount'Variants
postCustomersCustomerRequestBodyBankAccount PostCustomersCustomerRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"card" Text
-> Maybe PostCustomersCustomerRequestBodyCard'Variants -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody
-> Maybe PostCustomersCustomerRequestBodyCard'Variants
postCustomersCustomerRequestBodyCard PostCustomersCustomerRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"coupon" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyCoupon PostCustomersCustomerRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"default_alipay_account" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyDefaultAlipayAccount PostCustomersCustomerRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"default_bank_account" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyDefaultBankAccount PostCustomersCustomerRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"default_card" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyDefaultCard PostCustomersCustomerRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"default_source" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyDefaultSource PostCustomersCustomerRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"description" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyDescription PostCustomersCustomerRequestBody
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..= PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyEmail PostCustomersCustomerRequestBody
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..= PostCustomersCustomerRequestBody -> Maybe [Text]
postCustomersCustomerRequestBodyExpand PostCustomersCustomerRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"invoice_prefix" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyInvoicePrefix PostCustomersCustomerRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"invoice_settings" Text
-> Maybe PostCustomersCustomerRequestBodyInvoiceSettings' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody
-> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
postCustomersCustomerRequestBodyInvoiceSettings PostCustomersCustomerRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"metadata" Text
-> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody
-> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
postCustomersCustomerRequestBodyMetadata PostCustomersCustomerRequestBody
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..= PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyName PostCustomersCustomerRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"next_invoice_sequence" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody -> Maybe Int
postCustomersCustomerRequestBodyNextInvoiceSequence PostCustomersCustomerRequestBody
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..= PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyPhone PostCustomersCustomerRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"preferred_locales" Text -> Maybe [Text] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody -> Maybe [Text]
postCustomersCustomerRequestBodyPreferredLocales PostCustomersCustomerRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"promotion_code" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodyPromotionCode PostCustomersCustomerRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"shipping" Text
-> Maybe PostCustomersCustomerRequestBodyShipping'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody
-> Maybe PostCustomersCustomerRequestBodyShipping'Variants
postCustomersCustomerRequestBodyShipping PostCustomersCustomerRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"source" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody -> Maybe Text
postCustomersCustomerRequestBodySource PostCustomersCustomerRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"tax" Text -> Maybe PostCustomersCustomerRequestBodyTax' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody
-> Maybe PostCustomersCustomerRequestBodyTax'
postCustomersCustomerRequestBodyTax PostCustomersCustomerRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"tax_exempt" Text -> Maybe PostCustomersCustomerRequestBodyTaxExempt' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody
-> Maybe PostCustomersCustomerRequestBodyTaxExempt'
postCustomersCustomerRequestBodyTaxExempt PostCustomersCustomerRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"trial_end" Text
-> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBody
-> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
postCustomersCustomerRequestBodyTrialEnd PostCustomersCustomerRequestBody
obj)))))))))))))))))))))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersCustomerRequestBody where
  parseJSON :: Value -> Parser PostCustomersCustomerRequestBody
parseJSON = String
-> (Object -> Parser PostCustomersCustomerRequestBody)
-> Value
-> Parser PostCustomersCustomerRequestBody
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostCustomersCustomerRequestBody" (\Object
obj -> (((((((((((((((((((((((((Maybe PostCustomersCustomerRequestBodyAddress'Variants
 -> Maybe Int
 -> Maybe PostCustomersCustomerRequestBodyBankAccount'Variants
 -> Maybe PostCustomersCustomerRequestBodyCard'Variants
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe Text
 -> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
 -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
 -> Maybe Text
 -> Maybe Int
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe Text
 -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
 -> Maybe Text
 -> Maybe PostCustomersCustomerRequestBodyTax'
 -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
 -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
 -> PostCustomersCustomerRequestBody)
-> Parser
     (Maybe PostCustomersCustomerRequestBodyAddress'Variants
      -> Maybe Int
      -> Maybe PostCustomersCustomerRequestBodyBankAccount'Variants
      -> Maybe PostCustomersCustomerRequestBodyCard'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
      -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyTax'
      -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
      -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
      -> PostCustomersCustomerRequestBody)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe PostCustomersCustomerRequestBodyAddress'Variants
-> Maybe Int
-> Maybe PostCustomersCustomerRequestBodyBankAccount'Variants
-> Maybe PostCustomersCustomerRequestBodyCard'Variants
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
-> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe PostCustomersCustomerRequestBodyShipping'Variants
-> Maybe Text
-> Maybe PostCustomersCustomerRequestBodyTax'
-> Maybe PostCustomersCustomerRequestBodyTaxExempt'
-> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
-> PostCustomersCustomerRequestBody
PostCustomersCustomerRequestBody Parser
  (Maybe PostCustomersCustomerRequestBodyAddress'Variants
   -> Maybe Int
   -> Maybe PostCustomersCustomerRequestBodyBankAccount'Variants
   -> Maybe PostCustomersCustomerRequestBodyCard'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
   -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyTax'
   -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
   -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
   -> PostCustomersCustomerRequestBody)
-> Parser (Maybe PostCustomersCustomerRequestBodyAddress'Variants)
-> Parser
     (Maybe Int
      -> Maybe PostCustomersCustomerRequestBodyBankAccount'Variants
      -> Maybe PostCustomersCustomerRequestBodyCard'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
      -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyTax'
      -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
      -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
      -> PostCustomersCustomerRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostCustomersCustomerRequestBodyAddress'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address")) Parser
  (Maybe Int
   -> Maybe PostCustomersCustomerRequestBodyBankAccount'Variants
   -> Maybe PostCustomersCustomerRequestBodyCard'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
   -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyTax'
   -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
   -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
   -> PostCustomersCustomerRequestBody)
-> Parser (Maybe Int)
-> Parser
     (Maybe PostCustomersCustomerRequestBodyBankAccount'Variants
      -> Maybe PostCustomersCustomerRequestBodyCard'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
      -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyTax'
      -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
      -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
      -> PostCustomersCustomerRequestBody)
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
"balance")) Parser
  (Maybe PostCustomersCustomerRequestBodyBankAccount'Variants
   -> Maybe PostCustomersCustomerRequestBodyCard'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
   -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyTax'
   -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
   -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
   -> PostCustomersCustomerRequestBody)
-> Parser
     (Maybe PostCustomersCustomerRequestBodyBankAccount'Variants)
-> Parser
     (Maybe PostCustomersCustomerRequestBodyCard'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
      -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyTax'
      -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
      -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
      -> PostCustomersCustomerRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe PostCustomersCustomerRequestBodyBankAccount'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"bank_account")) Parser
  (Maybe PostCustomersCustomerRequestBodyCard'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
   -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyTax'
   -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
   -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
   -> PostCustomersCustomerRequestBody)
-> Parser (Maybe PostCustomersCustomerRequestBodyCard'Variants)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
      -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyTax'
      -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
      -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
      -> PostCustomersCustomerRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostCustomersCustomerRequestBodyCard'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"card")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
   -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyTax'
   -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
   -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
   -> PostCustomersCustomerRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
      -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyTax'
      -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
      -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
      -> PostCustomersCustomerRequestBody)
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
"coupon")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
   -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyTax'
   -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
   -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
   -> PostCustomersCustomerRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
      -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyTax'
      -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
      -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
      -> PostCustomersCustomerRequestBody)
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
"default_alipay_account")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
   -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyTax'
   -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
   -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
   -> PostCustomersCustomerRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
      -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyTax'
      -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
      -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
      -> PostCustomersCustomerRequestBody)
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
"default_bank_account")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
   -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyTax'
   -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
   -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
   -> PostCustomersCustomerRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
      -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyTax'
      -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
      -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
      -> PostCustomersCustomerRequestBody)
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
"default_card")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
   -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyTax'
   -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
   -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
   -> PostCustomersCustomerRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
      -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyTax'
      -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
      -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
      -> PostCustomersCustomerRequestBody)
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
"default_source")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
   -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyTax'
   -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
   -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
   -> PostCustomersCustomerRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
      -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyTax'
      -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
      -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
      -> PostCustomersCustomerRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"description")) Parser
  (Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
   -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyTax'
   -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
   -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
   -> PostCustomersCustomerRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
      -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyTax'
      -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
      -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
      -> PostCustomersCustomerRequestBody)
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 PostCustomersCustomerRequestBodyInvoiceSettings'
   -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyTax'
   -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
   -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
   -> PostCustomersCustomerRequestBody)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
      -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyTax'
      -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
      -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
      -> PostCustomersCustomerRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"expand")) Parser
  (Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
   -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyTax'
   -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
   -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
   -> PostCustomersCustomerRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
      -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyTax'
      -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
      -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
      -> PostCustomersCustomerRequestBody)
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
"invoice_prefix")) Parser
  (Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
   -> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyTax'
   -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
   -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
   -> PostCustomersCustomerRequestBody)
-> Parser (Maybe PostCustomersCustomerRequestBodyInvoiceSettings')
-> Parser
     (Maybe PostCustomersCustomerRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyTax'
      -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
      -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
      -> PostCustomersCustomerRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostCustomersCustomerRequestBodyInvoiceSettings')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"invoice_settings")) Parser
  (Maybe PostCustomersCustomerRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyTax'
   -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
   -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
   -> PostCustomersCustomerRequestBody)
-> Parser (Maybe PostCustomersCustomerRequestBodyMetadata'Variants)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyTax'
      -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
      -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
      -> PostCustomersCustomerRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostCustomersCustomerRequestBodyMetadata'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"metadata")) Parser
  (Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyTax'
   -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
   -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
   -> PostCustomersCustomerRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyTax'
      -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
      -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
      -> PostCustomersCustomerRequestBody)
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 Int
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyTax'
   -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
   -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
   -> PostCustomersCustomerRequestBody)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyTax'
      -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
      -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
      -> PostCustomersCustomerRequestBody)
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
"next_invoice_sequence")) Parser
  (Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyTax'
   -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
   -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
   -> PostCustomersCustomerRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyTax'
      -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
      -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
      -> PostCustomersCustomerRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"phone")) Parser
  (Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyTax'
   -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
   -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
   -> PostCustomersCustomerRequestBody)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyTax'
      -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
      -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
      -> PostCustomersCustomerRequestBody)
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
"preferred_locales")) Parser
  (Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyTax'
   -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
   -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
   -> PostCustomersCustomerRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostCustomersCustomerRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyTax'
      -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
      -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
      -> PostCustomersCustomerRequestBody)
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
"promotion_code")) Parser
  (Maybe PostCustomersCustomerRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyTax'
   -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
   -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
   -> PostCustomersCustomerRequestBody)
-> Parser (Maybe PostCustomersCustomerRequestBodyShipping'Variants)
-> Parser
     (Maybe Text
      -> Maybe PostCustomersCustomerRequestBodyTax'
      -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
      -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
      -> PostCustomersCustomerRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostCustomersCustomerRequestBodyShipping'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"shipping")) Parser
  (Maybe Text
   -> Maybe PostCustomersCustomerRequestBodyTax'
   -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
   -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
   -> PostCustomersCustomerRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostCustomersCustomerRequestBodyTax'
      -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
      -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
      -> PostCustomersCustomerRequestBody)
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
"source")) Parser
  (Maybe PostCustomersCustomerRequestBodyTax'
   -> Maybe PostCustomersCustomerRequestBodyTaxExempt'
   -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
   -> PostCustomersCustomerRequestBody)
-> Parser (Maybe PostCustomersCustomerRequestBodyTax')
-> Parser
     (Maybe PostCustomersCustomerRequestBodyTaxExempt'
      -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
      -> PostCustomersCustomerRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe PostCustomersCustomerRequestBodyTax')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"tax")) Parser
  (Maybe PostCustomersCustomerRequestBodyTaxExempt'
   -> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
   -> PostCustomersCustomerRequestBody)
-> Parser (Maybe PostCustomersCustomerRequestBodyTaxExempt')
-> Parser
     (Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
      -> PostCustomersCustomerRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostCustomersCustomerRequestBodyTaxExempt')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"tax_exempt")) Parser
  (Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
   -> PostCustomersCustomerRequestBody)
-> Parser (Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants)
-> Parser PostCustomersCustomerRequestBody
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"trial_end"))

-- | Create a new 'PostCustomersCustomerRequestBody' with all required fields.
mkPostCustomersCustomerRequestBody :: PostCustomersCustomerRequestBody
mkPostCustomersCustomerRequestBody :: PostCustomersCustomerRequestBody
mkPostCustomersCustomerRequestBody =
  PostCustomersCustomerRequestBody :: Maybe PostCustomersCustomerRequestBodyAddress'Variants
-> Maybe Int
-> Maybe PostCustomersCustomerRequestBodyBankAccount'Variants
-> Maybe PostCustomersCustomerRequestBodyCard'Variants
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
-> Maybe PostCustomersCustomerRequestBodyMetadata'Variants
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe PostCustomersCustomerRequestBodyShipping'Variants
-> Maybe Text
-> Maybe PostCustomersCustomerRequestBodyTax'
-> Maybe PostCustomersCustomerRequestBodyTaxExempt'
-> Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
-> PostCustomersCustomerRequestBody
PostCustomersCustomerRequestBody
    { postCustomersCustomerRequestBodyAddress :: Maybe PostCustomersCustomerRequestBodyAddress'Variants
postCustomersCustomerRequestBodyAddress = Maybe PostCustomersCustomerRequestBodyAddress'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyBalance :: Maybe Int
postCustomersCustomerRequestBodyBalance = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyBankAccount :: Maybe PostCustomersCustomerRequestBodyBankAccount'Variants
postCustomersCustomerRequestBodyBankAccount = Maybe PostCustomersCustomerRequestBodyBankAccount'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyCard :: Maybe PostCustomersCustomerRequestBodyCard'Variants
postCustomersCustomerRequestBodyCard = Maybe PostCustomersCustomerRequestBodyCard'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyCoupon :: Maybe Text
postCustomersCustomerRequestBodyCoupon = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyDefaultAlipayAccount :: Maybe Text
postCustomersCustomerRequestBodyDefaultAlipayAccount = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyDefaultBankAccount :: Maybe Text
postCustomersCustomerRequestBodyDefaultBankAccount = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyDefaultCard :: Maybe Text
postCustomersCustomerRequestBodyDefaultCard = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyDefaultSource :: Maybe Text
postCustomersCustomerRequestBodyDefaultSource = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyDescription :: Maybe Text
postCustomersCustomerRequestBodyDescription = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyEmail :: Maybe Text
postCustomersCustomerRequestBodyEmail = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyExpand :: Maybe [Text]
postCustomersCustomerRequestBodyExpand = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyInvoicePrefix :: Maybe Text
postCustomersCustomerRequestBodyInvoicePrefix = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyInvoiceSettings :: Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
postCustomersCustomerRequestBodyInvoiceSettings = Maybe PostCustomersCustomerRequestBodyInvoiceSettings'
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyMetadata :: Maybe PostCustomersCustomerRequestBodyMetadata'Variants
postCustomersCustomerRequestBodyMetadata = Maybe PostCustomersCustomerRequestBodyMetadata'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyName :: Maybe Text
postCustomersCustomerRequestBodyName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyNextInvoiceSequence :: Maybe Int
postCustomersCustomerRequestBodyNextInvoiceSequence = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyPhone :: Maybe Text
postCustomersCustomerRequestBodyPhone = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyPreferredLocales :: Maybe [Text]
postCustomersCustomerRequestBodyPreferredLocales = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyPromotionCode :: Maybe Text
postCustomersCustomerRequestBodyPromotionCode = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyShipping :: Maybe PostCustomersCustomerRequestBodyShipping'Variants
postCustomersCustomerRequestBodyShipping = Maybe PostCustomersCustomerRequestBodyShipping'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodySource :: Maybe Text
postCustomersCustomerRequestBodySource = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyTax :: Maybe PostCustomersCustomerRequestBodyTax'
postCustomersCustomerRequestBodyTax = Maybe PostCustomersCustomerRequestBodyTax'
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyTaxExempt :: Maybe PostCustomersCustomerRequestBodyTaxExempt'
postCustomersCustomerRequestBodyTaxExempt = Maybe PostCustomersCustomerRequestBodyTaxExempt'
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyTrialEnd :: Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
postCustomersCustomerRequestBodyTrialEnd = Maybe PostCustomersCustomerRequestBodyTrialEnd'Variants
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

instance Data.Aeson.Types.ToJSON.ToJSON PostCustomersCustomerRequestBodyAddress'OneOf1 where
  toJSON :: PostCustomersCustomerRequestBodyAddress'OneOf1 -> Value
toJSON PostCustomersCustomerRequestBodyAddress'OneOf1
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"city" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyAddress'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyAddress'OneOf1City PostCustomersCustomerRequestBodyAddress'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"country" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyAddress'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyAddress'OneOf1Country PostCustomersCustomerRequestBodyAddress'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"line1" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyAddress'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyAddress'OneOf1Line1 PostCustomersCustomerRequestBodyAddress'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"line2" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyAddress'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyAddress'OneOf1Line2 PostCustomersCustomerRequestBodyAddress'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"postal_code" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyAddress'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyAddress'OneOf1PostalCode PostCustomersCustomerRequestBodyAddress'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"state" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyAddress'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyAddress'OneOf1State PostCustomersCustomerRequestBodyAddress'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostCustomersCustomerRequestBodyAddress'OneOf1 -> Encoding
toEncoding PostCustomersCustomerRequestBodyAddress'OneOf1
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"city" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyAddress'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyAddress'OneOf1City PostCustomersCustomerRequestBodyAddress'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"country" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyAddress'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyAddress'OneOf1Country PostCustomersCustomerRequestBodyAddress'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"line1" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyAddress'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyAddress'OneOf1Line1 PostCustomersCustomerRequestBodyAddress'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"line2" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyAddress'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyAddress'OneOf1Line2 PostCustomersCustomerRequestBodyAddress'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"postal_code" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyAddress'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyAddress'OneOf1PostalCode PostCustomersCustomerRequestBodyAddress'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"state" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyAddress'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyAddress'OneOf1State PostCustomersCustomerRequestBodyAddress'OneOf1
obj))))))

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

-- | Create a new 'PostCustomersCustomerRequestBodyAddress'OneOf1' with all required fields.
mkPostCustomersCustomerRequestBodyAddress'OneOf1 :: PostCustomersCustomerRequestBodyAddress'OneOf1
mkPostCustomersCustomerRequestBodyAddress'OneOf1 :: PostCustomersCustomerRequestBodyAddress'OneOf1
mkPostCustomersCustomerRequestBodyAddress'OneOf1 =
  PostCustomersCustomerRequestBodyAddress'OneOf1 :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostCustomersCustomerRequestBodyAddress'OneOf1
PostCustomersCustomerRequestBodyAddress'OneOf1
    { postCustomersCustomerRequestBodyAddress'OneOf1City :: Maybe Text
postCustomersCustomerRequestBodyAddress'OneOf1City = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyAddress'OneOf1Country :: Maybe Text
postCustomersCustomerRequestBodyAddress'OneOf1Country = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyAddress'OneOf1Line1 :: Maybe Text
postCustomersCustomerRequestBodyAddress'OneOf1Line1 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyAddress'OneOf1Line2 :: Maybe Text
postCustomersCustomerRequestBodyAddress'OneOf1Line2 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyAddress'OneOf1PostalCode :: Maybe Text
postCustomersCustomerRequestBodyAddress'OneOf1PostalCode = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyAddress'OneOf1State :: Maybe Text
postCustomersCustomerRequestBodyAddress'OneOf1State = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

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

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersCustomerRequestBodyAddress'Variants where
  parseJSON :: Value -> Parser PostCustomersCustomerRequestBodyAddress'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostCustomersCustomerRequestBodyAddress'Variants
-> Parser PostCustomersCustomerRequestBodyAddress'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostCustomersCustomerRequestBodyAddress'Variants
PostCustomersCustomerRequestBodyAddress'EmptyString
        | Bool
GHC.Base.otherwise -> case (PostCustomersCustomerRequestBodyAddress'OneOf1
-> PostCustomersCustomerRequestBodyAddress'Variants
PostCustomersCustomerRequestBodyAddress'PostCustomersCustomerRequestBodyAddress'OneOf1 (PostCustomersCustomerRequestBodyAddress'OneOf1
 -> PostCustomersCustomerRequestBodyAddress'Variants)
-> Result PostCustomersCustomerRequestBodyAddress'OneOf1
-> Result PostCustomersCustomerRequestBodyAddress'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value -> Result PostCustomersCustomerRequestBodyAddress'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result PostCustomersCustomerRequestBodyAddress'Variants
-> Result PostCustomersCustomerRequestBodyAddress'Variants
-> Result PostCustomersCustomerRequestBodyAddress'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String -> Result PostCustomersCustomerRequestBodyAddress'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostCustomersCustomerRequestBodyAddress'Variants
a -> PostCustomersCustomerRequestBodyAddress'Variants
-> Parser PostCustomersCustomerRequestBodyAddress'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostCustomersCustomerRequestBodyAddress'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String -> Parser PostCustomersCustomerRequestBodyAddress'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}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.bank_account.anyOf@ in the specification.
data PostCustomersCustomerRequestBodyBankAccount'OneOf1 = PostCustomersCustomerRequestBodyBankAccount'OneOf1
  { -- | account_holder_name
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyBankAccount'OneOf1AccountHolderName :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | account_holder_type
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerRequestBodyBankAccount'OneOf1
-> Maybe
     PostCustomersCustomerRequestBodyBankAccount'OneOf1AccountHolderType'
postCustomersCustomerRequestBodyBankAccount'OneOf1AccountHolderType :: (GHC.Maybe.Maybe PostCustomersCustomerRequestBodyBankAccount'OneOf1AccountHolderType'),
    -- | account_number
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> Text
postCustomersCustomerRequestBodyBankAccount'OneOf1AccountNumber :: Data.Text.Internal.Text,
    -- | country
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> Text
postCustomersCustomerRequestBodyBankAccount'OneOf1Country :: Data.Text.Internal.Text,
    -- | currency
    PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyBankAccount'OneOf1Currency :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | routing_number
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyBankAccount'OneOf1RoutingNumber :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int
-> PostCustomersCustomerRequestBodyBankAccount'OneOf1
-> String
-> String
[PostCustomersCustomerRequestBodyBankAccount'OneOf1]
-> String -> String
PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> String
(Int
 -> PostCustomersCustomerRequestBodyBankAccount'OneOf1
 -> String
 -> String)
-> (PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> String)
-> ([PostCustomersCustomerRequestBodyBankAccount'OneOf1]
    -> String -> String)
-> Show PostCustomersCustomerRequestBodyBankAccount'OneOf1
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostCustomersCustomerRequestBodyBankAccount'OneOf1]
-> String -> String
$cshowList :: [PostCustomersCustomerRequestBodyBankAccount'OneOf1]
-> String -> String
show :: PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> String
$cshow :: PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> String
showsPrec :: Int
-> PostCustomersCustomerRequestBodyBankAccount'OneOf1
-> String
-> String
$cshowsPrec :: Int
-> PostCustomersCustomerRequestBodyBankAccount'OneOf1
-> String
-> String
GHC.Show.Show,
      PostCustomersCustomerRequestBodyBankAccount'OneOf1
-> PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> Bool
(PostCustomersCustomerRequestBodyBankAccount'OneOf1
 -> PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> Bool)
-> (PostCustomersCustomerRequestBodyBankAccount'OneOf1
    -> PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> Bool)
-> Eq PostCustomersCustomerRequestBodyBankAccount'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersCustomerRequestBodyBankAccount'OneOf1
-> PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> Bool
$c/= :: PostCustomersCustomerRequestBodyBankAccount'OneOf1
-> PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> Bool
== :: PostCustomersCustomerRequestBodyBankAccount'OneOf1
-> PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> Bool
$c== :: PostCustomersCustomerRequestBodyBankAccount'OneOf1
-> PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostCustomersCustomerRequestBodyBankAccount'OneOf1 where
  toJSON :: PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> Value
toJSON PostCustomersCustomerRequestBodyBankAccount'OneOf1
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..= PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyBankAccount'OneOf1AccountHolderName PostCustomersCustomerRequestBodyBankAccount'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"account_holder_type" Text
-> Maybe
     PostCustomersCustomerRequestBodyBankAccount'OneOf1AccountHolderType'
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyBankAccount'OneOf1
-> Maybe
     PostCustomersCustomerRequestBodyBankAccount'OneOf1AccountHolderType'
postCustomersCustomerRequestBodyBankAccount'OneOf1AccountHolderType PostCustomersCustomerRequestBodyBankAccount'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"account_number" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> Text
postCustomersCustomerRequestBodyBankAccount'OneOf1AccountNumber PostCustomersCustomerRequestBodyBankAccount'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"country" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> Text
postCustomersCustomerRequestBodyBankAccount'OneOf1Country PostCustomersCustomerRequestBodyBankAccount'OneOf1
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..= PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyBankAccount'OneOf1Currency PostCustomersCustomerRequestBodyBankAccount'OneOf1
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..= PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyBankAccount'OneOf1RoutingNumber PostCustomersCustomerRequestBodyBankAccount'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"object" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= Text -> Value
Data.Aeson.Types.Internal.String Text
"bank_account" Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> Encoding
toEncoding PostCustomersCustomerRequestBodyBankAccount'OneOf1
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..= PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyBankAccount'OneOf1AccountHolderName PostCustomersCustomerRequestBodyBankAccount'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"account_holder_type" Text
-> Maybe
     PostCustomersCustomerRequestBodyBankAccount'OneOf1AccountHolderType'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyBankAccount'OneOf1
-> Maybe
     PostCustomersCustomerRequestBodyBankAccount'OneOf1AccountHolderType'
postCustomersCustomerRequestBodyBankAccount'OneOf1AccountHolderType PostCustomersCustomerRequestBodyBankAccount'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"account_number" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> Text
postCustomersCustomerRequestBodyBankAccount'OneOf1AccountNumber PostCustomersCustomerRequestBodyBankAccount'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"country" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> Text
postCustomersCustomerRequestBodyBankAccount'OneOf1Country PostCustomersCustomerRequestBodyBankAccount'OneOf1
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..= PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyBankAccount'OneOf1Currency PostCustomersCustomerRequestBodyBankAccount'OneOf1
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..= PostCustomersCustomerRequestBodyBankAccount'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyBankAccount'OneOf1RoutingNumber PostCustomersCustomerRequestBodyBankAccount'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"object" Text -> Value -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= Text -> Value
Data.Aeson.Types.Internal.String Text
"bank_account")))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersCustomerRequestBodyBankAccount'OneOf1 where
  parseJSON :: Value -> Parser PostCustomersCustomerRequestBodyBankAccount'OneOf1
parseJSON = String
-> (Object
    -> Parser PostCustomersCustomerRequestBodyBankAccount'OneOf1)
-> Value
-> Parser PostCustomersCustomerRequestBodyBankAccount'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostCustomersCustomerRequestBodyBankAccount'OneOf1" (\Object
obj -> ((((((Maybe Text
 -> Maybe
      PostCustomersCustomerRequestBodyBankAccount'OneOf1AccountHolderType'
 -> Text
 -> Text
 -> Maybe Text
 -> Maybe Text
 -> PostCustomersCustomerRequestBodyBankAccount'OneOf1)
-> Parser
     (Maybe Text
      -> Maybe
           PostCustomersCustomerRequestBodyBankAccount'OneOf1AccountHolderType'
      -> Text
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> PostCustomersCustomerRequestBodyBankAccount'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe
     PostCustomersCustomerRequestBodyBankAccount'OneOf1AccountHolderType'
-> Text
-> Text
-> Maybe Text
-> Maybe Text
-> PostCustomersCustomerRequestBodyBankAccount'OneOf1
PostCustomersCustomerRequestBodyBankAccount'OneOf1 Parser
  (Maybe Text
   -> Maybe
        PostCustomersCustomerRequestBodyBankAccount'OneOf1AccountHolderType'
   -> Text
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> PostCustomersCustomerRequestBodyBankAccount'OneOf1)
-> Parser (Maybe Text)
-> Parser
     (Maybe
        PostCustomersCustomerRequestBodyBankAccount'OneOf1AccountHolderType'
      -> Text
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> PostCustomersCustomerRequestBodyBankAccount'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"account_holder_name")) Parser
  (Maybe
     PostCustomersCustomerRequestBodyBankAccount'OneOf1AccountHolderType'
   -> Text
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> PostCustomersCustomerRequestBodyBankAccount'OneOf1)
-> Parser
     (Maybe
        PostCustomersCustomerRequestBodyBankAccount'OneOf1AccountHolderType')
-> Parser
     (Text
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> PostCustomersCustomerRequestBodyBankAccount'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostCustomersCustomerRequestBodyBankAccount'OneOf1AccountHolderType')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"account_holder_type")) Parser
  (Text
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> PostCustomersCustomerRequestBodyBankAccount'OneOf1)
-> Parser Text
-> Parser
     (Text
      -> Maybe Text
      -> Maybe Text
      -> PostCustomersCustomerRequestBodyBankAccount'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"account_number")) Parser
  (Text
   -> Maybe Text
   -> Maybe Text
   -> PostCustomersCustomerRequestBodyBankAccount'OneOf1)
-> Parser Text
-> Parser
     (Maybe Text
      -> Maybe Text
      -> PostCustomersCustomerRequestBodyBankAccount'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"country")) Parser
  (Maybe Text
   -> Maybe Text
   -> PostCustomersCustomerRequestBodyBankAccount'OneOf1)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> PostCustomersCustomerRequestBodyBankAccount'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"currency")) Parser
  (Maybe Text -> PostCustomersCustomerRequestBodyBankAccount'OneOf1)
-> Parser (Maybe Text)
-> Parser PostCustomersCustomerRequestBodyBankAccount'OneOf1
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"routing_number"))

-- | Create a new 'PostCustomersCustomerRequestBodyBankAccount'OneOf1' with all required fields.
mkPostCustomersCustomerRequestBodyBankAccount'OneOf1 ::
  -- | 'postCustomersCustomerRequestBodyBankAccount'OneOf1AccountNumber'
  Data.Text.Internal.Text ->
  -- | 'postCustomersCustomerRequestBodyBankAccount'OneOf1Country'
  Data.Text.Internal.Text ->
  PostCustomersCustomerRequestBodyBankAccount'OneOf1
mkPostCustomersCustomerRequestBodyBankAccount'OneOf1 :: Text -> Text -> PostCustomersCustomerRequestBodyBankAccount'OneOf1
mkPostCustomersCustomerRequestBodyBankAccount'OneOf1 Text
postCustomersCustomerRequestBodyBankAccount'OneOf1AccountNumber Text
postCustomersCustomerRequestBodyBankAccount'OneOf1Country =
  PostCustomersCustomerRequestBodyBankAccount'OneOf1 :: Maybe Text
-> Maybe
     PostCustomersCustomerRequestBodyBankAccount'OneOf1AccountHolderType'
-> Text
-> Text
-> Maybe Text
-> Maybe Text
-> PostCustomersCustomerRequestBodyBankAccount'OneOf1
PostCustomersCustomerRequestBodyBankAccount'OneOf1
    { postCustomersCustomerRequestBodyBankAccount'OneOf1AccountHolderName :: Maybe Text
postCustomersCustomerRequestBodyBankAccount'OneOf1AccountHolderName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyBankAccount'OneOf1AccountHolderType :: Maybe
  PostCustomersCustomerRequestBodyBankAccount'OneOf1AccountHolderType'
postCustomersCustomerRequestBodyBankAccount'OneOf1AccountHolderType = Maybe
  PostCustomersCustomerRequestBodyBankAccount'OneOf1AccountHolderType'
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyBankAccount'OneOf1AccountNumber :: Text
postCustomersCustomerRequestBodyBankAccount'OneOf1AccountNumber = Text
postCustomersCustomerRequestBodyBankAccount'OneOf1AccountNumber,
      postCustomersCustomerRequestBodyBankAccount'OneOf1Country :: Text
postCustomersCustomerRequestBodyBankAccount'OneOf1Country = Text
postCustomersCustomerRequestBodyBankAccount'OneOf1Country,
      postCustomersCustomerRequestBodyBankAccount'OneOf1Currency :: Maybe Text
postCustomersCustomerRequestBodyBankAccount'OneOf1Currency = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyBankAccount'OneOf1RoutingNumber :: Maybe Text
postCustomersCustomerRequestBodyBankAccount'OneOf1RoutingNumber = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

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

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

-- | Defines the oneOf schema located at @paths.\/v1\/customers\/{customer}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.bank_account.anyOf@ in the specification.
--
-- Either a token, like the ones returned by [Stripe.js](https:\/\/stripe.com\/docs\/stripe.js), or a dictionary containing a user\'s bank account details.
data PostCustomersCustomerRequestBodyBankAccount'Variants
  = PostCustomersCustomerRequestBodyBankAccount'PostCustomersCustomerRequestBodyBankAccount'OneOf1 PostCustomersCustomerRequestBodyBankAccount'OneOf1
  | PostCustomersCustomerRequestBodyBankAccount'Text Data.Text.Internal.Text
  deriving (Int
-> PostCustomersCustomerRequestBodyBankAccount'Variants
-> String
-> String
[PostCustomersCustomerRequestBodyBankAccount'Variants]
-> String -> String
PostCustomersCustomerRequestBodyBankAccount'Variants -> String
(Int
 -> PostCustomersCustomerRequestBodyBankAccount'Variants
 -> String
 -> String)
-> (PostCustomersCustomerRequestBodyBankAccount'Variants -> String)
-> ([PostCustomersCustomerRequestBodyBankAccount'Variants]
    -> String -> String)
-> Show PostCustomersCustomerRequestBodyBankAccount'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostCustomersCustomerRequestBodyBankAccount'Variants]
-> String -> String
$cshowList :: [PostCustomersCustomerRequestBodyBankAccount'Variants]
-> String -> String
show :: PostCustomersCustomerRequestBodyBankAccount'Variants -> String
$cshow :: PostCustomersCustomerRequestBodyBankAccount'Variants -> String
showsPrec :: Int
-> PostCustomersCustomerRequestBodyBankAccount'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostCustomersCustomerRequestBodyBankAccount'Variants
-> String
-> String
GHC.Show.Show, PostCustomersCustomerRequestBodyBankAccount'Variants
-> PostCustomersCustomerRequestBodyBankAccount'Variants -> Bool
(PostCustomersCustomerRequestBodyBankAccount'Variants
 -> PostCustomersCustomerRequestBodyBankAccount'Variants -> Bool)
-> (PostCustomersCustomerRequestBodyBankAccount'Variants
    -> PostCustomersCustomerRequestBodyBankAccount'Variants -> Bool)
-> Eq PostCustomersCustomerRequestBodyBankAccount'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersCustomerRequestBodyBankAccount'Variants
-> PostCustomersCustomerRequestBodyBankAccount'Variants -> Bool
$c/= :: PostCustomersCustomerRequestBodyBankAccount'Variants
-> PostCustomersCustomerRequestBodyBankAccount'Variants -> Bool
== :: PostCustomersCustomerRequestBodyBankAccount'Variants
-> PostCustomersCustomerRequestBodyBankAccount'Variants -> Bool
$c== :: PostCustomersCustomerRequestBodyBankAccount'Variants
-> PostCustomersCustomerRequestBodyBankAccount'Variants -> Bool
GHC.Classes.Eq)

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

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersCustomerRequestBodyBankAccount'Variants where
  parseJSON :: Value
-> Parser PostCustomersCustomerRequestBodyBankAccount'Variants
parseJSON Value
val = case (PostCustomersCustomerRequestBodyBankAccount'OneOf1
-> PostCustomersCustomerRequestBodyBankAccount'Variants
PostCustomersCustomerRequestBodyBankAccount'PostCustomersCustomerRequestBodyBankAccount'OneOf1 (PostCustomersCustomerRequestBodyBankAccount'OneOf1
 -> PostCustomersCustomerRequestBodyBankAccount'Variants)
-> Result PostCustomersCustomerRequestBodyBankAccount'OneOf1
-> Result PostCustomersCustomerRequestBodyBankAccount'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value -> Result PostCustomersCustomerRequestBodyBankAccount'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result PostCustomersCustomerRequestBodyBankAccount'Variants
-> Result PostCustomersCustomerRequestBodyBankAccount'Variants
-> Result PostCustomersCustomerRequestBodyBankAccount'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> ((Text -> PostCustomersCustomerRequestBodyBankAccount'Variants
PostCustomersCustomerRequestBodyBankAccount'Text (Text -> PostCustomersCustomerRequestBodyBankAccount'Variants)
-> Result Text
-> Result PostCustomersCustomerRequestBodyBankAccount'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 PostCustomersCustomerRequestBodyBankAccount'Variants
-> Result PostCustomersCustomerRequestBodyBankAccount'Variants
-> Result PostCustomersCustomerRequestBodyBankAccount'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result PostCustomersCustomerRequestBodyBankAccount'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched") of
    Data.Aeson.Types.Internal.Success PostCustomersCustomerRequestBodyBankAccount'Variants
a -> PostCustomersCustomerRequestBodyBankAccount'Variants
-> Parser PostCustomersCustomerRequestBodyBankAccount'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostCustomersCustomerRequestBodyBankAccount'Variants
a
    Data.Aeson.Types.Internal.Error String
a -> String
-> Parser PostCustomersCustomerRequestBodyBankAccount'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}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.card.anyOf@ in the specification.
data PostCustomersCustomerRequestBodyCard'OneOf1 = PostCustomersCustomerRequestBodyCard'OneOf1
  { -- | address_city
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerRequestBodyCard'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1AddressCity :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | address_country
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerRequestBodyCard'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1AddressCountry :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | address_line1
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerRequestBodyCard'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1AddressLine1 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | address_line2
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerRequestBodyCard'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1AddressLine2 :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | address_state
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerRequestBodyCard'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1AddressState :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | address_zip
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerRequestBodyCard'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1AddressZip :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | cvc
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerRequestBodyCard'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1Cvc :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | exp_month
    PostCustomersCustomerRequestBodyCard'OneOf1 -> Int
postCustomersCustomerRequestBodyCard'OneOf1ExpMonth :: GHC.Types.Int,
    -- | exp_year
    PostCustomersCustomerRequestBodyCard'OneOf1 -> Int
postCustomersCustomerRequestBodyCard'OneOf1ExpYear :: GHC.Types.Int,
    -- | metadata
    PostCustomersCustomerRequestBodyCard'OneOf1 -> Maybe Object
postCustomersCustomerRequestBodyCard'OneOf1Metadata :: (GHC.Maybe.Maybe Data.Aeson.Types.Internal.Object),
    -- | name
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerRequestBodyCard'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1Name :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | number
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerRequestBodyCard'OneOf1 -> Text
postCustomersCustomerRequestBodyCard'OneOf1Number :: Data.Text.Internal.Text
  }
  deriving
    ( Int
-> PostCustomersCustomerRequestBodyCard'OneOf1 -> String -> String
[PostCustomersCustomerRequestBodyCard'OneOf1] -> String -> String
PostCustomersCustomerRequestBodyCard'OneOf1 -> String
(Int
 -> PostCustomersCustomerRequestBodyCard'OneOf1 -> String -> String)
-> (PostCustomersCustomerRequestBodyCard'OneOf1 -> String)
-> ([PostCustomersCustomerRequestBodyCard'OneOf1]
    -> String -> String)
-> Show PostCustomersCustomerRequestBodyCard'OneOf1
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostCustomersCustomerRequestBodyCard'OneOf1] -> String -> String
$cshowList :: [PostCustomersCustomerRequestBodyCard'OneOf1] -> String -> String
show :: PostCustomersCustomerRequestBodyCard'OneOf1 -> String
$cshow :: PostCustomersCustomerRequestBodyCard'OneOf1 -> String
showsPrec :: Int
-> PostCustomersCustomerRequestBodyCard'OneOf1 -> String -> String
$cshowsPrec :: Int
-> PostCustomersCustomerRequestBodyCard'OneOf1 -> String -> String
GHC.Show.Show,
      PostCustomersCustomerRequestBodyCard'OneOf1
-> PostCustomersCustomerRequestBodyCard'OneOf1 -> Bool
(PostCustomersCustomerRequestBodyCard'OneOf1
 -> PostCustomersCustomerRequestBodyCard'OneOf1 -> Bool)
-> (PostCustomersCustomerRequestBodyCard'OneOf1
    -> PostCustomersCustomerRequestBodyCard'OneOf1 -> Bool)
-> Eq PostCustomersCustomerRequestBodyCard'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersCustomerRequestBodyCard'OneOf1
-> PostCustomersCustomerRequestBodyCard'OneOf1 -> Bool
$c/= :: PostCustomersCustomerRequestBodyCard'OneOf1
-> PostCustomersCustomerRequestBodyCard'OneOf1 -> Bool
== :: PostCustomersCustomerRequestBodyCard'OneOf1
-> PostCustomersCustomerRequestBodyCard'OneOf1 -> Bool
$c== :: PostCustomersCustomerRequestBodyCard'OneOf1
-> PostCustomersCustomerRequestBodyCard'OneOf1 -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostCustomersCustomerRequestBodyCard'OneOf1 where
  toJSON :: PostCustomersCustomerRequestBodyCard'OneOf1 -> Value
toJSON PostCustomersCustomerRequestBodyCard'OneOf1
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"address_city" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyCard'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1AddressCity PostCustomersCustomerRequestBodyCard'OneOf1
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..= PostCustomersCustomerRequestBodyCard'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1AddressCountry PostCustomersCustomerRequestBodyCard'OneOf1
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..= PostCustomersCustomerRequestBodyCard'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1AddressLine1 PostCustomersCustomerRequestBodyCard'OneOf1
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..= PostCustomersCustomerRequestBodyCard'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1AddressLine2 PostCustomersCustomerRequestBodyCard'OneOf1
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..= PostCustomersCustomerRequestBodyCard'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1AddressState PostCustomersCustomerRequestBodyCard'OneOf1
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..= PostCustomersCustomerRequestBodyCard'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1AddressZip PostCustomersCustomerRequestBodyCard'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"cvc" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyCard'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1Cvc PostCustomersCustomerRequestBodyCard'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"exp_month" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyCard'OneOf1 -> Int
postCustomersCustomerRequestBodyCard'OneOf1ExpMonth PostCustomersCustomerRequestBodyCard'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"exp_year" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyCard'OneOf1 -> Int
postCustomersCustomerRequestBodyCard'OneOf1ExpYear PostCustomersCustomerRequestBodyCard'OneOf1
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..= PostCustomersCustomerRequestBodyCard'OneOf1 -> Maybe Object
postCustomersCustomerRequestBodyCard'OneOf1Metadata PostCustomersCustomerRequestBodyCard'OneOf1
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..= PostCustomersCustomerRequestBodyCard'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1Name PostCustomersCustomerRequestBodyCard'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"number" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyCard'OneOf1 -> Text
postCustomersCustomerRequestBodyCard'OneOf1Number PostCustomersCustomerRequestBodyCard'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"object" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= Text -> Value
Data.Aeson.Types.Internal.String Text
"card" Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostCustomersCustomerRequestBodyCard'OneOf1 -> Encoding
toEncoding PostCustomersCustomerRequestBodyCard'OneOf1
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"address_city" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyCard'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1AddressCity PostCustomersCustomerRequestBodyCard'OneOf1
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..= PostCustomersCustomerRequestBodyCard'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1AddressCountry PostCustomersCustomerRequestBodyCard'OneOf1
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..= PostCustomersCustomerRequestBodyCard'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1AddressLine1 PostCustomersCustomerRequestBodyCard'OneOf1
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..= PostCustomersCustomerRequestBodyCard'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1AddressLine2 PostCustomersCustomerRequestBodyCard'OneOf1
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..= PostCustomersCustomerRequestBodyCard'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1AddressState PostCustomersCustomerRequestBodyCard'OneOf1
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..= PostCustomersCustomerRequestBodyCard'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1AddressZip PostCustomersCustomerRequestBodyCard'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"cvc" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyCard'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1Cvc PostCustomersCustomerRequestBodyCard'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"exp_month" Text -> Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyCard'OneOf1 -> Int
postCustomersCustomerRequestBodyCard'OneOf1ExpMonth PostCustomersCustomerRequestBodyCard'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"exp_year" Text -> Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyCard'OneOf1 -> Int
postCustomersCustomerRequestBodyCard'OneOf1ExpYear PostCustomersCustomerRequestBodyCard'OneOf1
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..= PostCustomersCustomerRequestBodyCard'OneOf1 -> Maybe Object
postCustomersCustomerRequestBodyCard'OneOf1Metadata PostCustomersCustomerRequestBodyCard'OneOf1
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..= PostCustomersCustomerRequestBodyCard'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1Name PostCustomersCustomerRequestBodyCard'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"number" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyCard'OneOf1 -> Text
postCustomersCustomerRequestBodyCard'OneOf1Number PostCustomersCustomerRequestBodyCard'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"object" Text -> Value -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= Text -> Value
Data.Aeson.Types.Internal.String Text
"card")))))))))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersCustomerRequestBodyCard'OneOf1 where
  parseJSON :: Value -> Parser PostCustomersCustomerRequestBodyCard'OneOf1
parseJSON = String
-> (Object -> Parser PostCustomersCustomerRequestBodyCard'OneOf1)
-> Value
-> Parser PostCustomersCustomerRequestBodyCard'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostCustomersCustomerRequestBodyCard'OneOf1" (\Object
obj -> ((((((((((((Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Int
 -> Int
 -> Maybe Object
 -> Maybe Text
 -> Text
 -> PostCustomersCustomerRequestBodyCard'OneOf1)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Int
      -> Int
      -> Maybe Object
      -> Maybe Text
      -> Text
      -> PostCustomersCustomerRequestBodyCard'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Int
-> Int
-> Maybe Object
-> Maybe Text
-> Text
-> PostCustomersCustomerRequestBodyCard'OneOf1
PostCustomersCustomerRequestBodyCard'OneOf1 Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Int
   -> Int
   -> Maybe Object
   -> Maybe Text
   -> Text
   -> PostCustomersCustomerRequestBodyCard'OneOf1)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Int
      -> Int
      -> Maybe Object
      -> Maybe Text
      -> Text
      -> PostCustomersCustomerRequestBodyCard'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address_city")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Int
   -> Int
   -> Maybe Object
   -> Maybe Text
   -> Text
   -> PostCustomersCustomerRequestBodyCard'OneOf1)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Int
      -> Int
      -> Maybe Object
      -> Maybe Text
      -> Text
      -> PostCustomersCustomerRequestBodyCard'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address_country")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Int
   -> Int
   -> Maybe Object
   -> Maybe Text
   -> Text
   -> PostCustomersCustomerRequestBodyCard'OneOf1)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Int
      -> Int
      -> Maybe Object
      -> Maybe Text
      -> Text
      -> PostCustomersCustomerRequestBodyCard'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address_line1")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Int
   -> Int
   -> Maybe Object
   -> Maybe Text
   -> Text
   -> PostCustomersCustomerRequestBodyCard'OneOf1)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Int
      -> Int
      -> Maybe Object
      -> Maybe Text
      -> Text
      -> PostCustomersCustomerRequestBodyCard'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address_line2")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Int
   -> Int
   -> Maybe Object
   -> Maybe Text
   -> Text
   -> PostCustomersCustomerRequestBodyCard'OneOf1)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Int
      -> Int
      -> Maybe Object
      -> Maybe Text
      -> Text
      -> PostCustomersCustomerRequestBodyCard'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address_state")) Parser
  (Maybe Text
   -> Maybe Text
   -> Int
   -> Int
   -> Maybe Object
   -> Maybe Text
   -> Text
   -> PostCustomersCustomerRequestBodyCard'OneOf1)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Int
      -> Int
      -> Maybe Object
      -> Maybe Text
      -> Text
      -> PostCustomersCustomerRequestBodyCard'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address_zip")) Parser
  (Maybe Text
   -> Int
   -> Int
   -> Maybe Object
   -> Maybe Text
   -> Text
   -> PostCustomersCustomerRequestBodyCard'OneOf1)
-> Parser (Maybe Text)
-> Parser
     (Int
      -> Int
      -> Maybe Object
      -> Maybe Text
      -> Text
      -> PostCustomersCustomerRequestBodyCard'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"cvc")) Parser
  (Int
   -> Int
   -> Maybe Object
   -> Maybe Text
   -> Text
   -> PostCustomersCustomerRequestBodyCard'OneOf1)
-> Parser Int
-> Parser
     (Int
      -> Maybe Object
      -> Maybe Text
      -> Text
      -> PostCustomersCustomerRequestBodyCard'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"exp_month")) Parser
  (Int
   -> Maybe Object
   -> Maybe Text
   -> Text
   -> PostCustomersCustomerRequestBodyCard'OneOf1)
-> Parser Int
-> Parser
     (Maybe Object
      -> Maybe Text
      -> Text
      -> PostCustomersCustomerRequestBodyCard'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"exp_year")) Parser
  (Maybe Object
   -> Maybe Text
   -> Text
   -> PostCustomersCustomerRequestBodyCard'OneOf1)
-> Parser (Maybe Object)
-> Parser
     (Maybe Text -> Text -> PostCustomersCustomerRequestBodyCard'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"metadata")) Parser
  (Maybe Text -> Text -> PostCustomersCustomerRequestBodyCard'OneOf1)
-> Parser (Maybe Text)
-> Parser (Text -> PostCustomersCustomerRequestBodyCard'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"name")) Parser (Text -> PostCustomersCustomerRequestBodyCard'OneOf1)
-> Parser Text
-> Parser PostCustomersCustomerRequestBodyCard'OneOf1
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"number"))

-- | Create a new 'PostCustomersCustomerRequestBodyCard'OneOf1' with all required fields.
mkPostCustomersCustomerRequestBodyCard'OneOf1 ::
  -- | 'postCustomersCustomerRequestBodyCard'OneOf1ExpMonth'
  GHC.Types.Int ->
  -- | 'postCustomersCustomerRequestBodyCard'OneOf1ExpYear'
  GHC.Types.Int ->
  -- | 'postCustomersCustomerRequestBodyCard'OneOf1Number'
  Data.Text.Internal.Text ->
  PostCustomersCustomerRequestBodyCard'OneOf1
mkPostCustomersCustomerRequestBodyCard'OneOf1 :: Int -> Int -> Text -> PostCustomersCustomerRequestBodyCard'OneOf1
mkPostCustomersCustomerRequestBodyCard'OneOf1 Int
postCustomersCustomerRequestBodyCard'OneOf1ExpMonth Int
postCustomersCustomerRequestBodyCard'OneOf1ExpYear Text
postCustomersCustomerRequestBodyCard'OneOf1Number =
  PostCustomersCustomerRequestBodyCard'OneOf1 :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Int
-> Int
-> Maybe Object
-> Maybe Text
-> Text
-> PostCustomersCustomerRequestBodyCard'OneOf1
PostCustomersCustomerRequestBodyCard'OneOf1
    { postCustomersCustomerRequestBodyCard'OneOf1AddressCity :: Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1AddressCity = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyCard'OneOf1AddressCountry :: Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1AddressCountry = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyCard'OneOf1AddressLine1 :: Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1AddressLine1 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyCard'OneOf1AddressLine2 :: Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1AddressLine2 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyCard'OneOf1AddressState :: Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1AddressState = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyCard'OneOf1AddressZip :: Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1AddressZip = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyCard'OneOf1Cvc :: Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1Cvc = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyCard'OneOf1ExpMonth :: Int
postCustomersCustomerRequestBodyCard'OneOf1ExpMonth = Int
postCustomersCustomerRequestBodyCard'OneOf1ExpMonth,
      postCustomersCustomerRequestBodyCard'OneOf1ExpYear :: Int
postCustomersCustomerRequestBodyCard'OneOf1ExpYear = Int
postCustomersCustomerRequestBodyCard'OneOf1ExpYear,
      postCustomersCustomerRequestBodyCard'OneOf1Metadata :: Maybe Object
postCustomersCustomerRequestBodyCard'OneOf1Metadata = Maybe Object
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyCard'OneOf1Name :: Maybe Text
postCustomersCustomerRequestBodyCard'OneOf1Name = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyCard'OneOf1Number :: Text
postCustomersCustomerRequestBodyCard'OneOf1Number = Text
postCustomersCustomerRequestBodyCard'OneOf1Number
    }

-- | Defines the oneOf schema located at @paths.\/v1\/customers\/{customer}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.card.anyOf@ in the specification.
--
-- A token, like the ones returned by [Stripe.js](https:\/\/stripe.com\/docs\/stripe.js).
data PostCustomersCustomerRequestBodyCard'Variants
  = PostCustomersCustomerRequestBodyCard'PostCustomersCustomerRequestBodyCard'OneOf1 PostCustomersCustomerRequestBodyCard'OneOf1
  | PostCustomersCustomerRequestBodyCard'Text Data.Text.Internal.Text
  deriving (Int
-> PostCustomersCustomerRequestBodyCard'Variants
-> String
-> String
[PostCustomersCustomerRequestBodyCard'Variants] -> String -> String
PostCustomersCustomerRequestBodyCard'Variants -> String
(Int
 -> PostCustomersCustomerRequestBodyCard'Variants
 -> String
 -> String)
-> (PostCustomersCustomerRequestBodyCard'Variants -> String)
-> ([PostCustomersCustomerRequestBodyCard'Variants]
    -> String -> String)
-> Show PostCustomersCustomerRequestBodyCard'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostCustomersCustomerRequestBodyCard'Variants] -> String -> String
$cshowList :: [PostCustomersCustomerRequestBodyCard'Variants] -> String -> String
show :: PostCustomersCustomerRequestBodyCard'Variants -> String
$cshow :: PostCustomersCustomerRequestBodyCard'Variants -> String
showsPrec :: Int
-> PostCustomersCustomerRequestBodyCard'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostCustomersCustomerRequestBodyCard'Variants
-> String
-> String
GHC.Show.Show, PostCustomersCustomerRequestBodyCard'Variants
-> PostCustomersCustomerRequestBodyCard'Variants -> Bool
(PostCustomersCustomerRequestBodyCard'Variants
 -> PostCustomersCustomerRequestBodyCard'Variants -> Bool)
-> (PostCustomersCustomerRequestBodyCard'Variants
    -> PostCustomersCustomerRequestBodyCard'Variants -> Bool)
-> Eq PostCustomersCustomerRequestBodyCard'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersCustomerRequestBodyCard'Variants
-> PostCustomersCustomerRequestBodyCard'Variants -> Bool
$c/= :: PostCustomersCustomerRequestBodyCard'Variants
-> PostCustomersCustomerRequestBodyCard'Variants -> Bool
== :: PostCustomersCustomerRequestBodyCard'Variants
-> PostCustomersCustomerRequestBodyCard'Variants -> Bool
$c== :: PostCustomersCustomerRequestBodyCard'Variants
-> PostCustomersCustomerRequestBodyCard'Variants -> Bool
GHC.Classes.Eq)

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

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersCustomerRequestBodyCard'Variants where
  parseJSON :: Value -> Parser PostCustomersCustomerRequestBodyCard'Variants
parseJSON Value
val = case (PostCustomersCustomerRequestBodyCard'OneOf1
-> PostCustomersCustomerRequestBodyCard'Variants
PostCustomersCustomerRequestBodyCard'PostCustomersCustomerRequestBodyCard'OneOf1 (PostCustomersCustomerRequestBodyCard'OneOf1
 -> PostCustomersCustomerRequestBodyCard'Variants)
-> Result PostCustomersCustomerRequestBodyCard'OneOf1
-> Result PostCustomersCustomerRequestBodyCard'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value -> Result PostCustomersCustomerRequestBodyCard'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result PostCustomersCustomerRequestBodyCard'Variants
-> Result PostCustomersCustomerRequestBodyCard'Variants
-> Result PostCustomersCustomerRequestBodyCard'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> ((Text -> PostCustomersCustomerRequestBodyCard'Variants
PostCustomersCustomerRequestBodyCard'Text (Text -> PostCustomersCustomerRequestBodyCard'Variants)
-> Result Text
-> Result PostCustomersCustomerRequestBodyCard'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 PostCustomersCustomerRequestBodyCard'Variants
-> Result PostCustomersCustomerRequestBodyCard'Variants
-> Result PostCustomersCustomerRequestBodyCard'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String -> Result PostCustomersCustomerRequestBodyCard'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched") of
    Data.Aeson.Types.Internal.Success PostCustomersCustomerRequestBodyCard'Variants
a -> PostCustomersCustomerRequestBodyCard'Variants
-> Parser PostCustomersCustomerRequestBodyCard'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostCustomersCustomerRequestBodyCard'Variants
a
    Data.Aeson.Types.Internal.Error String
a -> String -> Parser PostCustomersCustomerRequestBodyCard'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}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.invoice_settings@ in the specification.
--
-- Default invoice settings for this customer.
data PostCustomersCustomerRequestBodyInvoiceSettings' = PostCustomersCustomerRequestBodyInvoiceSettings'
  { -- | custom_fields
    PostCustomersCustomerRequestBodyInvoiceSettings'
-> Maybe
     PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'Variants
postCustomersCustomerRequestBodyInvoiceSettings'CustomFields :: (GHC.Maybe.Maybe PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'Variants),
    -- | default_payment_method
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerRequestBodyInvoiceSettings' -> Maybe Text
postCustomersCustomerRequestBodyInvoiceSettings'DefaultPaymentMethod :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | footer
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerRequestBodyInvoiceSettings' -> Maybe Text
postCustomersCustomerRequestBodyInvoiceSettings'Footer :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int
-> PostCustomersCustomerRequestBodyInvoiceSettings'
-> String
-> String
[PostCustomersCustomerRequestBodyInvoiceSettings']
-> String -> String
PostCustomersCustomerRequestBodyInvoiceSettings' -> String
(Int
 -> PostCustomersCustomerRequestBodyInvoiceSettings'
 -> String
 -> String)
-> (PostCustomersCustomerRequestBodyInvoiceSettings' -> String)
-> ([PostCustomersCustomerRequestBodyInvoiceSettings']
    -> String -> String)
-> Show PostCustomersCustomerRequestBodyInvoiceSettings'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostCustomersCustomerRequestBodyInvoiceSettings']
-> String -> String
$cshowList :: [PostCustomersCustomerRequestBodyInvoiceSettings']
-> String -> String
show :: PostCustomersCustomerRequestBodyInvoiceSettings' -> String
$cshow :: PostCustomersCustomerRequestBodyInvoiceSettings' -> String
showsPrec :: Int
-> PostCustomersCustomerRequestBodyInvoiceSettings'
-> String
-> String
$cshowsPrec :: Int
-> PostCustomersCustomerRequestBodyInvoiceSettings'
-> String
-> String
GHC.Show.Show,
      PostCustomersCustomerRequestBodyInvoiceSettings'
-> PostCustomersCustomerRequestBodyInvoiceSettings' -> Bool
(PostCustomersCustomerRequestBodyInvoiceSettings'
 -> PostCustomersCustomerRequestBodyInvoiceSettings' -> Bool)
-> (PostCustomersCustomerRequestBodyInvoiceSettings'
    -> PostCustomersCustomerRequestBodyInvoiceSettings' -> Bool)
-> Eq PostCustomersCustomerRequestBodyInvoiceSettings'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersCustomerRequestBodyInvoiceSettings'
-> PostCustomersCustomerRequestBodyInvoiceSettings' -> Bool
$c/= :: PostCustomersCustomerRequestBodyInvoiceSettings'
-> PostCustomersCustomerRequestBodyInvoiceSettings' -> Bool
== :: PostCustomersCustomerRequestBodyInvoiceSettings'
-> PostCustomersCustomerRequestBodyInvoiceSettings' -> Bool
$c== :: PostCustomersCustomerRequestBodyInvoiceSettings'
-> PostCustomersCustomerRequestBodyInvoiceSettings' -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostCustomersCustomerRequestBodyInvoiceSettings' where
  toJSON :: PostCustomersCustomerRequestBodyInvoiceSettings' -> Value
toJSON PostCustomersCustomerRequestBodyInvoiceSettings'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"custom_fields" Text
-> Maybe
     PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyInvoiceSettings'
-> Maybe
     PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'Variants
postCustomersCustomerRequestBodyInvoiceSettings'CustomFields PostCustomersCustomerRequestBodyInvoiceSettings'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"default_payment_method" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyInvoiceSettings' -> Maybe Text
postCustomersCustomerRequestBodyInvoiceSettings'DefaultPaymentMethod PostCustomersCustomerRequestBodyInvoiceSettings'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"footer" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyInvoiceSettings' -> Maybe Text
postCustomersCustomerRequestBodyInvoiceSettings'Footer PostCustomersCustomerRequestBodyInvoiceSettings'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostCustomersCustomerRequestBodyInvoiceSettings' -> Encoding
toEncoding PostCustomersCustomerRequestBodyInvoiceSettings'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"custom_fields" Text
-> Maybe
     PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyInvoiceSettings'
-> Maybe
     PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'Variants
postCustomersCustomerRequestBodyInvoiceSettings'CustomFields PostCustomersCustomerRequestBodyInvoiceSettings'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"default_payment_method" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyInvoiceSettings' -> Maybe Text
postCustomersCustomerRequestBodyInvoiceSettings'DefaultPaymentMethod PostCustomersCustomerRequestBodyInvoiceSettings'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"footer" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyInvoiceSettings' -> Maybe Text
postCustomersCustomerRequestBodyInvoiceSettings'Footer PostCustomersCustomerRequestBodyInvoiceSettings'
obj)))

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

-- | Create a new 'PostCustomersCustomerRequestBodyInvoiceSettings'' with all required fields.
mkPostCustomersCustomerRequestBodyInvoiceSettings' :: PostCustomersCustomerRequestBodyInvoiceSettings'
mkPostCustomersCustomerRequestBodyInvoiceSettings' :: PostCustomersCustomerRequestBodyInvoiceSettings'
mkPostCustomersCustomerRequestBodyInvoiceSettings' =
  PostCustomersCustomerRequestBodyInvoiceSettings' :: Maybe
  PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'Variants
-> Maybe Text
-> Maybe Text
-> PostCustomersCustomerRequestBodyInvoiceSettings'
PostCustomersCustomerRequestBodyInvoiceSettings'
    { postCustomersCustomerRequestBodyInvoiceSettings'CustomFields :: Maybe
  PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'Variants
postCustomersCustomerRequestBodyInvoiceSettings'CustomFields = Maybe
  PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyInvoiceSettings'DefaultPaymentMethod :: Maybe Text
postCustomersCustomerRequestBodyInvoiceSettings'DefaultPaymentMethod = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersCustomerRequestBodyInvoiceSettings'Footer :: Maybe Text
postCustomersCustomerRequestBodyInvoiceSettings'Footer = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the object schema located at @paths.\/v1\/customers\/{customer}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.invoice_settings.properties.custom_fields.anyOf.items@ in the specification.
data PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1 = PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
  { -- | name
    --
    -- Constraints:
    --
    -- * Maximum length of 30
    PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
-> Text
postCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1Name :: Data.Text.Internal.Text,
    -- | value
    --
    -- Constraints:
    --
    -- * Maximum length of 30
    PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
-> Text
postCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1Value :: Data.Text.Internal.Text
  }
  deriving
    ( Int
-> PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
-> String
-> String
[PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1]
-> String -> String
PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
-> String
(Int
 -> PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
 -> String
 -> String)
-> (PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
    -> String)
-> ([PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1]
    -> String -> String)
-> Show
     PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1]
-> String -> String
$cshowList :: [PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1]
-> String -> String
show :: PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
-> String
$cshow :: PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
-> String
showsPrec :: Int
-> PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
-> String
-> String
$cshowsPrec :: Int
-> PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
-> String
-> String
GHC.Show.Show,
      PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
-> PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
-> Bool
(PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
 -> PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
 -> Bool)
-> (PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
    -> PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
    -> Bool)
-> Eq
     PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
-> PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
-> Bool
$c/= :: PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
-> PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
-> Bool
== :: PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
-> PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
-> Bool
$c== :: PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
-> PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
-> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1 where
  toJSON :: PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
-> Value
toJSON PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
-> Text
postCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1Name PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"value" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
-> Text
postCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1Value PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
-> Encoding
toEncoding PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"name" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
-> Text
postCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1Name PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"value" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
-> Text
postCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1Value PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
obj))

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1 where
  parseJSON :: Value
-> Parser
     PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
parseJSON = String
-> (Object
    -> Parser
         PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1)
-> Value
-> Parser
     PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1" (\Object
obj -> ((Text
 -> Text
 -> PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1)
-> Parser
     (Text
      -> Text
      -> PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Text
-> Text
-> PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1 Parser
  (Text
   -> Text
   -> PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1)
-> Parser Text
-> Parser
     (Text
      -> PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"name")) Parser
  (Text
   -> PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1)
-> Parser Text
-> Parser
     PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"value"))

-- | Create a new 'PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1' with all required fields.
mkPostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1 ::
  -- | 'postCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1Name'
  Data.Text.Internal.Text ->
  -- | 'postCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1Value'
  Data.Text.Internal.Text ->
  PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
mkPostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1 :: Text
-> Text
-> PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
mkPostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1 Text
postCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1Name Text
postCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1Value =
  PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1 :: Text
-> Text
-> PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1
    { postCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1Name :: Text
postCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1Name = Text
postCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1Name,
      postCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1Value :: Text
postCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1Value = Text
postCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1Value
    }

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

instance Data.Aeson.Types.ToJSON.ToJSON PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'Variants where
  toJSON :: PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'Variants
-> Value
toJSON (PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'ListTPostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1 [PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1]
a) = [PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1]
-> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON [PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'OneOf1]
a
  toJSON (PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'Variants
PostCustomersCustomerRequestBodyInvoiceSettings'CustomFields'EmptyString) = Value
""

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

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

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

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersCustomerRequestBodyMetadata'Variants where
  parseJSON :: Value -> Parser PostCustomersCustomerRequestBodyMetadata'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostCustomersCustomerRequestBodyMetadata'Variants
-> Parser PostCustomersCustomerRequestBodyMetadata'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostCustomersCustomerRequestBodyMetadata'Variants
PostCustomersCustomerRequestBodyMetadata'EmptyString
        | Bool
GHC.Base.otherwise -> case (Object -> PostCustomersCustomerRequestBodyMetadata'Variants
PostCustomersCustomerRequestBodyMetadata'Object (Object -> PostCustomersCustomerRequestBodyMetadata'Variants)
-> Result Object
-> Result PostCustomersCustomerRequestBodyMetadata'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 PostCustomersCustomerRequestBodyMetadata'Variants
-> Result PostCustomersCustomerRequestBodyMetadata'Variants
-> Result PostCustomersCustomerRequestBodyMetadata'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String -> Result PostCustomersCustomerRequestBodyMetadata'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostCustomersCustomerRequestBodyMetadata'Variants
a -> PostCustomersCustomerRequestBodyMetadata'Variants
-> Parser PostCustomersCustomerRequestBodyMetadata'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostCustomersCustomerRequestBodyMetadata'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String -> Parser PostCustomersCustomerRequestBodyMetadata'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}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.shipping.anyOf@ in the specification.
data PostCustomersCustomerRequestBodyShipping'OneOf1 = PostCustomersCustomerRequestBodyShipping'OneOf1
  { -- | address
    PostCustomersCustomerRequestBodyShipping'OneOf1
-> PostCustomersCustomerRequestBodyShipping'OneOf1Address'
postCustomersCustomerRequestBodyShipping'OneOf1Address :: PostCustomersCustomerRequestBodyShipping'OneOf1Address',
    -- | name
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerRequestBodyShipping'OneOf1 -> Text
postCustomersCustomerRequestBodyShipping'OneOf1Name :: Data.Text.Internal.Text,
    -- | phone
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersCustomerRequestBodyShipping'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyShipping'OneOf1Phone :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int
-> PostCustomersCustomerRequestBodyShipping'OneOf1
-> String
-> String
[PostCustomersCustomerRequestBodyShipping'OneOf1]
-> String -> String
PostCustomersCustomerRequestBodyShipping'OneOf1 -> String
(Int
 -> PostCustomersCustomerRequestBodyShipping'OneOf1
 -> String
 -> String)
-> (PostCustomersCustomerRequestBodyShipping'OneOf1 -> String)
-> ([PostCustomersCustomerRequestBodyShipping'OneOf1]
    -> String -> String)
-> Show PostCustomersCustomerRequestBodyShipping'OneOf1
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostCustomersCustomerRequestBodyShipping'OneOf1]
-> String -> String
$cshowList :: [PostCustomersCustomerRequestBodyShipping'OneOf1]
-> String -> String
show :: PostCustomersCustomerRequestBodyShipping'OneOf1 -> String
$cshow :: PostCustomersCustomerRequestBodyShipping'OneOf1 -> String
showsPrec :: Int
-> PostCustomersCustomerRequestBodyShipping'OneOf1
-> String
-> String
$cshowsPrec :: Int
-> PostCustomersCustomerRequestBodyShipping'OneOf1
-> String
-> String
GHC.Show.Show,
      PostCustomersCustomerRequestBodyShipping'OneOf1
-> PostCustomersCustomerRequestBodyShipping'OneOf1 -> Bool
(PostCustomersCustomerRequestBodyShipping'OneOf1
 -> PostCustomersCustomerRequestBodyShipping'OneOf1 -> Bool)
-> (PostCustomersCustomerRequestBodyShipping'OneOf1
    -> PostCustomersCustomerRequestBodyShipping'OneOf1 -> Bool)
-> Eq PostCustomersCustomerRequestBodyShipping'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersCustomerRequestBodyShipping'OneOf1
-> PostCustomersCustomerRequestBodyShipping'OneOf1 -> Bool
$c/= :: PostCustomersCustomerRequestBodyShipping'OneOf1
-> PostCustomersCustomerRequestBodyShipping'OneOf1 -> Bool
== :: PostCustomersCustomerRequestBodyShipping'OneOf1
-> PostCustomersCustomerRequestBodyShipping'OneOf1 -> Bool
$c== :: PostCustomersCustomerRequestBodyShipping'OneOf1
-> PostCustomersCustomerRequestBodyShipping'OneOf1 -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostCustomersCustomerRequestBodyShipping'OneOf1 where
  toJSON :: PostCustomersCustomerRequestBodyShipping'OneOf1 -> Value
toJSON PostCustomersCustomerRequestBodyShipping'OneOf1
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"address" Text
-> PostCustomersCustomerRequestBodyShipping'OneOf1Address' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyShipping'OneOf1
-> PostCustomersCustomerRequestBodyShipping'OneOf1Address'
postCustomersCustomerRequestBodyShipping'OneOf1Address PostCustomersCustomerRequestBodyShipping'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyShipping'OneOf1 -> Text
postCustomersCustomerRequestBodyShipping'OneOf1Name PostCustomersCustomerRequestBodyShipping'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"phone" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyShipping'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyShipping'OneOf1Phone PostCustomersCustomerRequestBodyShipping'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostCustomersCustomerRequestBodyShipping'OneOf1 -> Encoding
toEncoding PostCustomersCustomerRequestBodyShipping'OneOf1
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"address" Text
-> PostCustomersCustomerRequestBodyShipping'OneOf1Address'
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyShipping'OneOf1
-> PostCustomersCustomerRequestBodyShipping'OneOf1Address'
postCustomersCustomerRequestBodyShipping'OneOf1Address PostCustomersCustomerRequestBodyShipping'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"name" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyShipping'OneOf1 -> Text
postCustomersCustomerRequestBodyShipping'OneOf1Name PostCustomersCustomerRequestBodyShipping'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"phone" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyShipping'OneOf1 -> Maybe Text
postCustomersCustomerRequestBodyShipping'OneOf1Phone PostCustomersCustomerRequestBodyShipping'OneOf1
obj)))

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

-- | Create a new 'PostCustomersCustomerRequestBodyShipping'OneOf1' with all required fields.
mkPostCustomersCustomerRequestBodyShipping'OneOf1 ::
  -- | 'postCustomersCustomerRequestBodyShipping'OneOf1Address'
  PostCustomersCustomerRequestBodyShipping'OneOf1Address' ->
  -- | 'postCustomersCustomerRequestBodyShipping'OneOf1Name'
  Data.Text.Internal.Text ->
  PostCustomersCustomerRequestBodyShipping'OneOf1
mkPostCustomersCustomerRequestBodyShipping'OneOf1 :: PostCustomersCustomerRequestBodyShipping'OneOf1Address'
-> Text -> PostCustomersCustomerRequestBodyShipping'OneOf1
mkPostCustomersCustomerRequestBodyShipping'OneOf1 PostCustomersCustomerRequestBodyShipping'OneOf1Address'
postCustomersCustomerRequestBodyShipping'OneOf1Address Text
postCustomersCustomerRequestBodyShipping'OneOf1Name =
  PostCustomersCustomerRequestBodyShipping'OneOf1 :: PostCustomersCustomerRequestBodyShipping'OneOf1Address'
-> Text
-> Maybe Text
-> PostCustomersCustomerRequestBodyShipping'OneOf1
PostCustomersCustomerRequestBodyShipping'OneOf1
    { postCustomersCustomerRequestBodyShipping'OneOf1Address :: PostCustomersCustomerRequestBodyShipping'OneOf1Address'
postCustomersCustomerRequestBodyShipping'OneOf1Address = PostCustomersCustomerRequestBodyShipping'OneOf1Address'
postCustomersCustomerRequestBodyShipping'OneOf1Address,
      postCustomersCustomerRequestBodyShipping'OneOf1Name :: Text
postCustomersCustomerRequestBodyShipping'OneOf1Name = Text
postCustomersCustomerRequestBodyShipping'OneOf1Name,
      postCustomersCustomerRequestBodyShipping'OneOf1Phone :: Maybe Text
postCustomersCustomerRequestBodyShipping'OneOf1Phone = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

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

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

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

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

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

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersCustomerRequestBodyShipping'Variants where
  parseJSON :: Value -> Parser PostCustomersCustomerRequestBodyShipping'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostCustomersCustomerRequestBodyShipping'Variants
-> Parser PostCustomersCustomerRequestBodyShipping'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostCustomersCustomerRequestBodyShipping'Variants
PostCustomersCustomerRequestBodyShipping'EmptyString
        | Bool
GHC.Base.otherwise -> case (PostCustomersCustomerRequestBodyShipping'OneOf1
-> PostCustomersCustomerRequestBodyShipping'Variants
PostCustomersCustomerRequestBodyShipping'PostCustomersCustomerRequestBodyShipping'OneOf1 (PostCustomersCustomerRequestBodyShipping'OneOf1
 -> PostCustomersCustomerRequestBodyShipping'Variants)
-> Result PostCustomersCustomerRequestBodyShipping'OneOf1
-> Result PostCustomersCustomerRequestBodyShipping'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value -> Result PostCustomersCustomerRequestBodyShipping'OneOf1
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result PostCustomersCustomerRequestBodyShipping'Variants
-> Result PostCustomersCustomerRequestBodyShipping'Variants
-> Result PostCustomersCustomerRequestBodyShipping'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String -> Result PostCustomersCustomerRequestBodyShipping'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostCustomersCustomerRequestBodyShipping'Variants
a -> PostCustomersCustomerRequestBodyShipping'Variants
-> Parser PostCustomersCustomerRequestBodyShipping'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostCustomersCustomerRequestBodyShipping'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String -> Parser PostCustomersCustomerRequestBodyShipping'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}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.tax@ in the specification.
--
-- Tax details about the customer.
data PostCustomersCustomerRequestBodyTax' = PostCustomersCustomerRequestBodyTax'
  { -- | ip_address
    PostCustomersCustomerRequestBodyTax'
-> Maybe PostCustomersCustomerRequestBodyTax'IpAddress'Variants
postCustomersCustomerRequestBodyTax'IpAddress :: (GHC.Maybe.Maybe PostCustomersCustomerRequestBodyTax'IpAddress'Variants)
  }
  deriving
    ( Int -> PostCustomersCustomerRequestBodyTax' -> String -> String
[PostCustomersCustomerRequestBodyTax'] -> String -> String
PostCustomersCustomerRequestBodyTax' -> String
(Int -> PostCustomersCustomerRequestBodyTax' -> String -> String)
-> (PostCustomersCustomerRequestBodyTax' -> String)
-> ([PostCustomersCustomerRequestBodyTax'] -> String -> String)
-> Show PostCustomersCustomerRequestBodyTax'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostCustomersCustomerRequestBodyTax'] -> String -> String
$cshowList :: [PostCustomersCustomerRequestBodyTax'] -> String -> String
show :: PostCustomersCustomerRequestBodyTax' -> String
$cshow :: PostCustomersCustomerRequestBodyTax' -> String
showsPrec :: Int -> PostCustomersCustomerRequestBodyTax' -> String -> String
$cshowsPrec :: Int -> PostCustomersCustomerRequestBodyTax' -> String -> String
GHC.Show.Show,
      PostCustomersCustomerRequestBodyTax'
-> PostCustomersCustomerRequestBodyTax' -> Bool
(PostCustomersCustomerRequestBodyTax'
 -> PostCustomersCustomerRequestBodyTax' -> Bool)
-> (PostCustomersCustomerRequestBodyTax'
    -> PostCustomersCustomerRequestBodyTax' -> Bool)
-> Eq PostCustomersCustomerRequestBodyTax'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersCustomerRequestBodyTax'
-> PostCustomersCustomerRequestBodyTax' -> Bool
$c/= :: PostCustomersCustomerRequestBodyTax'
-> PostCustomersCustomerRequestBodyTax' -> Bool
== :: PostCustomersCustomerRequestBodyTax'
-> PostCustomersCustomerRequestBodyTax' -> Bool
$c== :: PostCustomersCustomerRequestBodyTax'
-> PostCustomersCustomerRequestBodyTax' -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostCustomersCustomerRequestBodyTax' where
  toJSON :: PostCustomersCustomerRequestBodyTax' -> Value
toJSON PostCustomersCustomerRequestBodyTax'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"ip_address" Text
-> Maybe PostCustomersCustomerRequestBodyTax'IpAddress'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyTax'
-> Maybe PostCustomersCustomerRequestBodyTax'IpAddress'Variants
postCustomersCustomerRequestBodyTax'IpAddress PostCustomersCustomerRequestBodyTax'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostCustomersCustomerRequestBodyTax' -> Encoding
toEncoding PostCustomersCustomerRequestBodyTax'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs (Text
"ip_address" Text
-> Maybe PostCustomersCustomerRequestBodyTax'IpAddress'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersCustomerRequestBodyTax'
-> Maybe PostCustomersCustomerRequestBodyTax'IpAddress'Variants
postCustomersCustomerRequestBodyTax'IpAddress PostCustomersCustomerRequestBodyTax'
obj)

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

-- | Create a new 'PostCustomersCustomerRequestBodyTax'' with all required fields.
mkPostCustomersCustomerRequestBodyTax' :: PostCustomersCustomerRequestBodyTax'
mkPostCustomersCustomerRequestBodyTax' :: PostCustomersCustomerRequestBodyTax'
mkPostCustomersCustomerRequestBodyTax' = PostCustomersCustomerRequestBodyTax' :: Maybe PostCustomersCustomerRequestBodyTax'IpAddress'Variants
-> PostCustomersCustomerRequestBodyTax'
PostCustomersCustomerRequestBodyTax' {postCustomersCustomerRequestBodyTax'IpAddress :: Maybe PostCustomersCustomerRequestBodyTax'IpAddress'Variants
postCustomersCustomerRequestBodyTax'IpAddress = Maybe PostCustomersCustomerRequestBodyTax'IpAddress'Variants
forall a. Maybe a
GHC.Maybe.Nothing}

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

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

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersCustomerRequestBodyTax'IpAddress'Variants where
  parseJSON :: Value
-> Parser PostCustomersCustomerRequestBodyTax'IpAddress'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostCustomersCustomerRequestBodyTax'IpAddress'Variants
-> Parser PostCustomersCustomerRequestBodyTax'IpAddress'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostCustomersCustomerRequestBodyTax'IpAddress'Variants
PostCustomersCustomerRequestBodyTax'IpAddress'EmptyString
        | Bool
GHC.Base.otherwise -> case (Text -> PostCustomersCustomerRequestBodyTax'IpAddress'Variants
PostCustomersCustomerRequestBodyTax'IpAddress'Text (Text -> PostCustomersCustomerRequestBodyTax'IpAddress'Variants)
-> Result Text
-> Result PostCustomersCustomerRequestBodyTax'IpAddress'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 PostCustomersCustomerRequestBodyTax'IpAddress'Variants
-> Result PostCustomersCustomerRequestBodyTax'IpAddress'Variants
-> Result PostCustomersCustomerRequestBodyTax'IpAddress'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result PostCustomersCustomerRequestBodyTax'IpAddress'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostCustomersCustomerRequestBodyTax'IpAddress'Variants
a -> PostCustomersCustomerRequestBodyTax'IpAddress'Variants
-> Parser PostCustomersCustomerRequestBodyTax'IpAddress'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostCustomersCustomerRequestBodyTax'IpAddress'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String
-> Parser PostCustomersCustomerRequestBodyTax'IpAddress'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}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.tax_exempt@ in the specification.
--
-- The customer\'s tax exemption. One of \`none\`, \`exempt\`, or \`reverse\`.
data PostCustomersCustomerRequestBodyTaxExempt'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostCustomersCustomerRequestBodyTaxExempt'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.
    PostCustomersCustomerRequestBodyTaxExempt'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @""@
    PostCustomersCustomerRequestBodyTaxExempt'EnumEmptyString
  | -- | Represents the JSON value @"exempt"@
    PostCustomersCustomerRequestBodyTaxExempt'EnumExempt
  | -- | Represents the JSON value @"none"@
    PostCustomersCustomerRequestBodyTaxExempt'EnumNone
  | -- | Represents the JSON value @"reverse"@
    PostCustomersCustomerRequestBodyTaxExempt'EnumReverse
  deriving (Int
-> PostCustomersCustomerRequestBodyTaxExempt' -> String -> String
[PostCustomersCustomerRequestBodyTaxExempt'] -> String -> String
PostCustomersCustomerRequestBodyTaxExempt' -> String
(Int
 -> PostCustomersCustomerRequestBodyTaxExempt' -> String -> String)
-> (PostCustomersCustomerRequestBodyTaxExempt' -> String)
-> ([PostCustomersCustomerRequestBodyTaxExempt']
    -> String -> String)
-> Show PostCustomersCustomerRequestBodyTaxExempt'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostCustomersCustomerRequestBodyTaxExempt'] -> String -> String
$cshowList :: [PostCustomersCustomerRequestBodyTaxExempt'] -> String -> String
show :: PostCustomersCustomerRequestBodyTaxExempt' -> String
$cshow :: PostCustomersCustomerRequestBodyTaxExempt' -> String
showsPrec :: Int
-> PostCustomersCustomerRequestBodyTaxExempt' -> String -> String
$cshowsPrec :: Int
-> PostCustomersCustomerRequestBodyTaxExempt' -> String -> String
GHC.Show.Show, PostCustomersCustomerRequestBodyTaxExempt'
-> PostCustomersCustomerRequestBodyTaxExempt' -> Bool
(PostCustomersCustomerRequestBodyTaxExempt'
 -> PostCustomersCustomerRequestBodyTaxExempt' -> Bool)
-> (PostCustomersCustomerRequestBodyTaxExempt'
    -> PostCustomersCustomerRequestBodyTaxExempt' -> Bool)
-> Eq PostCustomersCustomerRequestBodyTaxExempt'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersCustomerRequestBodyTaxExempt'
-> PostCustomersCustomerRequestBodyTaxExempt' -> Bool
$c/= :: PostCustomersCustomerRequestBodyTaxExempt'
-> PostCustomersCustomerRequestBodyTaxExempt' -> Bool
== :: PostCustomersCustomerRequestBodyTaxExempt'
-> PostCustomersCustomerRequestBodyTaxExempt' -> Bool
$c== :: PostCustomersCustomerRequestBodyTaxExempt'
-> PostCustomersCustomerRequestBodyTaxExempt' -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostCustomersCustomerRequestBodyTaxExempt' where
  toJSON :: PostCustomersCustomerRequestBodyTaxExempt' -> Value
toJSON (PostCustomersCustomerRequestBodyTaxExempt'Other Value
val) = Value
val
  toJSON (PostCustomersCustomerRequestBodyTaxExempt'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (PostCustomersCustomerRequestBodyTaxExempt'
PostCustomersCustomerRequestBodyTaxExempt'EnumEmptyString) = Value
""
  toJSON (PostCustomersCustomerRequestBodyTaxExempt'
PostCustomersCustomerRequestBodyTaxExempt'EnumExempt) = Value
"exempt"
  toJSON (PostCustomersCustomerRequestBodyTaxExempt'
PostCustomersCustomerRequestBodyTaxExempt'EnumNone) = Value
"none"
  toJSON (PostCustomersCustomerRequestBodyTaxExempt'
PostCustomersCustomerRequestBodyTaxExempt'EnumReverse) = Value
"reverse"

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersCustomerRequestBodyTaxExempt' where
  parseJSON :: Value -> Parser PostCustomersCustomerRequestBodyTaxExempt'
parseJSON Value
val =
    PostCustomersCustomerRequestBodyTaxExempt'
-> Parser PostCustomersCustomerRequestBodyTaxExempt'
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
"" -> PostCustomersCustomerRequestBodyTaxExempt'
PostCustomersCustomerRequestBodyTaxExempt'EnumEmptyString
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"exempt" -> PostCustomersCustomerRequestBodyTaxExempt'
PostCustomersCustomerRequestBodyTaxExempt'EnumExempt
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"none" -> PostCustomersCustomerRequestBodyTaxExempt'
PostCustomersCustomerRequestBodyTaxExempt'EnumNone
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"reverse" -> PostCustomersCustomerRequestBodyTaxExempt'
PostCustomersCustomerRequestBodyTaxExempt'EnumReverse
            | Bool
GHC.Base.otherwise -> Value -> PostCustomersCustomerRequestBodyTaxExempt'
PostCustomersCustomerRequestBodyTaxExempt'Other Value
val
      )

-- | Defines the oneOf schema located at @paths.\/v1\/customers\/{customer}.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.trial_end.anyOf@ in the specification.
--
-- Unix timestamp representing the end of the trial period the customer will get before being charged for the first time. This will always overwrite any trials that might apply via a subscribed plan. If set, trial_end will override the default trial period of the plan the customer is being subscribed to. The special value \`now\` can be provided to end the customer\'s trial immediately. Can be at most two years from \`billing_cycle_anchor\`.
data PostCustomersCustomerRequestBodyTrialEnd'Variants
  = -- | Represents the JSON value @"now"@
    PostCustomersCustomerRequestBodyTrialEnd'Now
  | PostCustomersCustomerRequestBodyTrialEnd'Int GHC.Types.Int
  deriving (Int
-> PostCustomersCustomerRequestBodyTrialEnd'Variants
-> String
-> String
[PostCustomersCustomerRequestBodyTrialEnd'Variants]
-> String -> String
PostCustomersCustomerRequestBodyTrialEnd'Variants -> String
(Int
 -> PostCustomersCustomerRequestBodyTrialEnd'Variants
 -> String
 -> String)
-> (PostCustomersCustomerRequestBodyTrialEnd'Variants -> String)
-> ([PostCustomersCustomerRequestBodyTrialEnd'Variants]
    -> String -> String)
-> Show PostCustomersCustomerRequestBodyTrialEnd'Variants
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PostCustomersCustomerRequestBodyTrialEnd'Variants]
-> String -> String
$cshowList :: [PostCustomersCustomerRequestBodyTrialEnd'Variants]
-> String -> String
show :: PostCustomersCustomerRequestBodyTrialEnd'Variants -> String
$cshow :: PostCustomersCustomerRequestBodyTrialEnd'Variants -> String
showsPrec :: Int
-> PostCustomersCustomerRequestBodyTrialEnd'Variants
-> String
-> String
$cshowsPrec :: Int
-> PostCustomersCustomerRequestBodyTrialEnd'Variants
-> String
-> String
GHC.Show.Show, PostCustomersCustomerRequestBodyTrialEnd'Variants
-> PostCustomersCustomerRequestBodyTrialEnd'Variants -> Bool
(PostCustomersCustomerRequestBodyTrialEnd'Variants
 -> PostCustomersCustomerRequestBodyTrialEnd'Variants -> Bool)
-> (PostCustomersCustomerRequestBodyTrialEnd'Variants
    -> PostCustomersCustomerRequestBodyTrialEnd'Variants -> Bool)
-> Eq PostCustomersCustomerRequestBodyTrialEnd'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersCustomerRequestBodyTrialEnd'Variants
-> PostCustomersCustomerRequestBodyTrialEnd'Variants -> Bool
$c/= :: PostCustomersCustomerRequestBodyTrialEnd'Variants
-> PostCustomersCustomerRequestBodyTrialEnd'Variants -> Bool
== :: PostCustomersCustomerRequestBodyTrialEnd'Variants
-> PostCustomersCustomerRequestBodyTrialEnd'Variants -> Bool
$c== :: PostCustomersCustomerRequestBodyTrialEnd'Variants
-> PostCustomersCustomerRequestBodyTrialEnd'Variants -> Bool
GHC.Classes.Eq)

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

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

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