{-# 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 postCustomers
module StripeAPI.Operations.PostCustomers 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
--
-- \<p>Creates a new customer object.\<\/p>
postCustomers ::
  forall m.
  StripeAPI.Common.MonadHTTP m =>
  -- | The request body to send
  GHC.Maybe.Maybe PostCustomersRequestBody ->
  -- | Monadic computation which returns the result of the operation
  StripeAPI.Common.ClientT m (Network.HTTP.Client.Types.Response PostCustomersResponse)
postCustomers :: Maybe PostCustomersRequestBody
-> ClientT m (Response PostCustomersResponse)
postCustomers Maybe PostCustomersRequestBody
body =
  (Response ByteString -> Response PostCustomersResponse)
-> ClientT m (Response ByteString)
-> ClientT m (Response PostCustomersResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
    ( \Response ByteString
response_0 ->
        (ByteString -> PostCustomersResponse)
-> Response ByteString -> Response PostCustomersResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
          ( (String -> PostCustomersResponse)
-> (PostCustomersResponse -> PostCustomersResponse)
-> Either String PostCustomersResponse
-> PostCustomersResponse
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Data.Either.either String -> PostCustomersResponse
PostCustomersResponseError PostCustomersResponse -> PostCustomersResponse
forall a. a -> a
GHC.Base.id
              (Either String PostCustomersResponse -> PostCustomersResponse)
-> (ByteString -> Either String PostCustomersResponse)
-> ByteString
-> PostCustomersResponse
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 -> PostCustomersResponse
PostCustomersResponse200
                                     (Customer -> PostCustomersResponse)
-> Either String Customer -> Either String PostCustomersResponse
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 -> PostCustomersResponse
PostCustomersResponseDefault
                                     (Error -> PostCustomersResponse)
-> Either String Error -> Either String PostCustomersResponse
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 PostCustomersResponse
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 PostCustomersRequestBody
-> RequestBodyEncoding
-> ClientT m (Response ByteString)
forall (m :: * -> *) body.
(MonadHTTP m, ToJSON body) =>
Text
-> Text
-> [QueryParameter]
-> Maybe body
-> RequestBodyEncoding
-> ClientT m (Response ByteString)
StripeAPI.Common.doBodyCallWithConfigurationM (Text -> Text
Data.Text.toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
GHC.Base.$ String -> Text
Data.Text.pack String
"POST") (String -> Text
Data.Text.pack String
"/v1/customers") [QueryParameter]
forall a. Monoid a => a
GHC.Base.mempty Maybe PostCustomersRequestBody
body RequestBodyEncoding
StripeAPI.Common.RequestBodyEncodingFormData)

-- | Defines the object schema located at @paths.\/v1\/customers.POST.requestBody.content.application\/x-www-form-urlencoded.schema@ in the specification.
data PostCustomersRequestBody = PostCustomersRequestBody
  { -- | address: The customer\'s address.
    PostCustomersRequestBody
-> Maybe PostCustomersRequestBodyAddress'Variants
postCustomersRequestBodyAddress :: (GHC.Maybe.Maybe PostCustomersRequestBodyAddress'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.
    PostCustomersRequestBody -> Maybe Int
postCustomersRequestBodyBalance :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | coupon
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersRequestBody -> Maybe Text
postCustomersRequestBodyCoupon :: (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
    PostCustomersRequestBody -> Maybe Text
postCustomersRequestBodyDescription :: (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
    PostCustomersRequestBody -> Maybe Text
postCustomersRequestBodyEmail :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | expand: Specifies which fields in the response should be expanded.
    PostCustomersRequestBody -> Maybe [Text]
postCustomersRequestBodyExpand :: (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
    PostCustomersRequestBody -> Maybe Text
postCustomersRequestBodyInvoicePrefix :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | invoice_settings: Default invoice settings for this customer.
    PostCustomersRequestBody
-> Maybe PostCustomersRequestBodyInvoiceSettings'
postCustomersRequestBodyInvoiceSettings :: (GHC.Maybe.Maybe PostCustomersRequestBodyInvoiceSettings'),
    -- | 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\`.
    PostCustomersRequestBody
-> Maybe PostCustomersRequestBodyMetadata'Variants
postCustomersRequestBodyMetadata :: (GHC.Maybe.Maybe PostCustomersRequestBodyMetadata'Variants),
    -- | name: The customer\'s full name or business name.
    --
    -- Constraints:
    --
    -- * Maximum length of 256
    PostCustomersRequestBody -> Maybe Text
postCustomersRequestBodyName :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | next_invoice_sequence: The sequence to be used on the customer\'s next invoice. Defaults to 1.
    PostCustomersRequestBody -> Maybe Int
postCustomersRequestBodyNextInvoiceSequence :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | payment_method
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersRequestBody -> Maybe Text
postCustomersRequestBodyPaymentMethod :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | phone: The customer\'s phone number.
    --
    -- Constraints:
    --
    -- * Maximum length of 20
    PostCustomersRequestBody -> Maybe Text
postCustomersRequestBodyPhone :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | preferred_locales: Customer\'s preferred languages, ordered by preference.
    PostCustomersRequestBody -> Maybe [Text]
postCustomersRequestBodyPreferredLocales :: (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
    PostCustomersRequestBody -> Maybe Text
postCustomersRequestBodyPromotionCode :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | shipping: The customer\'s shipping information. Appears on invoices emailed to this customer.
    PostCustomersRequestBody
-> Maybe PostCustomersRequestBodyShipping'Variants
postCustomersRequestBodyShipping :: (GHC.Maybe.Maybe PostCustomersRequestBodyShipping'Variants),
    -- | source
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersRequestBody -> Maybe Text
postCustomersRequestBodySource :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | tax: Tax details about the customer.
    PostCustomersRequestBody -> Maybe PostCustomersRequestBodyTax'
postCustomersRequestBodyTax :: (GHC.Maybe.Maybe PostCustomersRequestBodyTax'),
    -- | tax_exempt: The customer\'s tax exemption. One of \`none\`, \`exempt\`, or \`reverse\`.
    PostCustomersRequestBody
-> Maybe PostCustomersRequestBodyTaxExempt'
postCustomersRequestBodyTaxExempt :: (GHC.Maybe.Maybe PostCustomersRequestBodyTaxExempt'),
    -- | tax_id_data: The customer\'s tax IDs.
    PostCustomersRequestBody
-> Maybe [PostCustomersRequestBodyTaxIdData']
postCustomersRequestBodyTaxIdData :: (GHC.Maybe.Maybe ([PostCustomersRequestBodyTaxIdData']))
  }
  deriving
    ( Int -> PostCustomersRequestBody -> ShowS
[PostCustomersRequestBody] -> ShowS
PostCustomersRequestBody -> String
(Int -> PostCustomersRequestBody -> ShowS)
-> (PostCustomersRequestBody -> String)
-> ([PostCustomersRequestBody] -> ShowS)
-> Show PostCustomersRequestBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostCustomersRequestBody] -> ShowS
$cshowList :: [PostCustomersRequestBody] -> ShowS
show :: PostCustomersRequestBody -> String
$cshow :: PostCustomersRequestBody -> String
showsPrec :: Int -> PostCustomersRequestBody -> ShowS
$cshowsPrec :: Int -> PostCustomersRequestBody -> ShowS
GHC.Show.Show,
      PostCustomersRequestBody -> PostCustomersRequestBody -> Bool
(PostCustomersRequestBody -> PostCustomersRequestBody -> Bool)
-> (PostCustomersRequestBody -> PostCustomersRequestBody -> Bool)
-> Eq PostCustomersRequestBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersRequestBody -> PostCustomersRequestBody -> Bool
$c/= :: PostCustomersRequestBody -> PostCustomersRequestBody -> Bool
== :: PostCustomersRequestBody -> PostCustomersRequestBody -> Bool
$c== :: PostCustomersRequestBody -> PostCustomersRequestBody -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostCustomersRequestBody where
  toJSON :: PostCustomersRequestBody -> Value
toJSON PostCustomersRequestBody
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"address" Text -> Maybe PostCustomersRequestBodyAddress'Variants -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersRequestBody
-> Maybe PostCustomersRequestBodyAddress'Variants
postCustomersRequestBodyAddress PostCustomersRequestBody
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..= PostCustomersRequestBody -> Maybe Int
postCustomersRequestBodyBalance PostCustomersRequestBody
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..= PostCustomersRequestBody -> Maybe Text
postCustomersRequestBodyCoupon PostCustomersRequestBody
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..= PostCustomersRequestBody -> Maybe Text
postCustomersRequestBodyDescription PostCustomersRequestBody
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..= PostCustomersRequestBody -> Maybe Text
postCustomersRequestBodyEmail PostCustomersRequestBody
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..= PostCustomersRequestBody -> Maybe [Text]
postCustomersRequestBodyExpand PostCustomersRequestBody
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..= PostCustomersRequestBody -> Maybe Text
postCustomersRequestBodyInvoicePrefix PostCustomersRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"invoice_settings" Text -> Maybe PostCustomersRequestBodyInvoiceSettings' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersRequestBody
-> Maybe PostCustomersRequestBodyInvoiceSettings'
postCustomersRequestBodyInvoiceSettings PostCustomersRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"metadata" Text -> Maybe PostCustomersRequestBodyMetadata'Variants -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersRequestBody
-> Maybe PostCustomersRequestBodyMetadata'Variants
postCustomersRequestBodyMetadata PostCustomersRequestBody
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..= PostCustomersRequestBody -> Maybe Text
postCustomersRequestBodyName PostCustomersRequestBody
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..= PostCustomersRequestBody -> Maybe Int
postCustomersRequestBodyNextInvoiceSequence PostCustomersRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"payment_method" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersRequestBody -> Maybe Text
postCustomersRequestBodyPaymentMethod PostCustomersRequestBody
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..= PostCustomersRequestBody -> Maybe Text
postCustomersRequestBodyPhone PostCustomersRequestBody
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..= PostCustomersRequestBody -> Maybe [Text]
postCustomersRequestBodyPreferredLocales PostCustomersRequestBody
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..= PostCustomersRequestBody -> Maybe Text
postCustomersRequestBodyPromotionCode PostCustomersRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"shipping" Text -> Maybe PostCustomersRequestBodyShipping'Variants -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersRequestBody
-> Maybe PostCustomersRequestBodyShipping'Variants
postCustomersRequestBodyShipping PostCustomersRequestBody
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..= PostCustomersRequestBody -> Maybe Text
postCustomersRequestBodySource PostCustomersRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"tax" Text -> Maybe PostCustomersRequestBodyTax' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersRequestBody -> Maybe PostCustomersRequestBodyTax'
postCustomersRequestBodyTax PostCustomersRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"tax_exempt" Text -> Maybe PostCustomersRequestBodyTaxExempt' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersRequestBody
-> Maybe PostCustomersRequestBodyTaxExempt'
postCustomersRequestBodyTaxExempt PostCustomersRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"tax_id_data" Text -> Maybe [PostCustomersRequestBodyTaxIdData'] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersRequestBody
-> Maybe [PostCustomersRequestBodyTaxIdData']
postCustomersRequestBodyTaxIdData PostCustomersRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostCustomersRequestBody -> Encoding
toEncoding PostCustomersRequestBody
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"address" Text -> Maybe PostCustomersRequestBodyAddress'Variants -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersRequestBody
-> Maybe PostCustomersRequestBodyAddress'Variants
postCustomersRequestBodyAddress PostCustomersRequestBody
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..= PostCustomersRequestBody -> Maybe Int
postCustomersRequestBodyBalance PostCustomersRequestBody
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..= PostCustomersRequestBody -> Maybe Text
postCustomersRequestBodyCoupon PostCustomersRequestBody
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..= PostCustomersRequestBody -> Maybe Text
postCustomersRequestBodyDescription PostCustomersRequestBody
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..= PostCustomersRequestBody -> Maybe Text
postCustomersRequestBodyEmail PostCustomersRequestBody
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..= PostCustomersRequestBody -> Maybe [Text]
postCustomersRequestBodyExpand PostCustomersRequestBody
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..= PostCustomersRequestBody -> Maybe Text
postCustomersRequestBodyInvoicePrefix PostCustomersRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"invoice_settings" Text -> Maybe PostCustomersRequestBodyInvoiceSettings' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersRequestBody
-> Maybe PostCustomersRequestBodyInvoiceSettings'
postCustomersRequestBodyInvoiceSettings PostCustomersRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"metadata" Text -> Maybe PostCustomersRequestBodyMetadata'Variants -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersRequestBody
-> Maybe PostCustomersRequestBodyMetadata'Variants
postCustomersRequestBodyMetadata PostCustomersRequestBody
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..= PostCustomersRequestBody -> Maybe Text
postCustomersRequestBodyName PostCustomersRequestBody
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..= PostCustomersRequestBody -> Maybe Int
postCustomersRequestBodyNextInvoiceSequence PostCustomersRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"payment_method" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersRequestBody -> Maybe Text
postCustomersRequestBodyPaymentMethod PostCustomersRequestBody
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..= PostCustomersRequestBody -> Maybe Text
postCustomersRequestBodyPhone PostCustomersRequestBody
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..= PostCustomersRequestBody -> Maybe [Text]
postCustomersRequestBodyPreferredLocales PostCustomersRequestBody
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..= PostCustomersRequestBody -> Maybe Text
postCustomersRequestBodyPromotionCode PostCustomersRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"shipping" Text -> Maybe PostCustomersRequestBodyShipping'Variants -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersRequestBody
-> Maybe PostCustomersRequestBodyShipping'Variants
postCustomersRequestBodyShipping PostCustomersRequestBody
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..= PostCustomersRequestBody -> Maybe Text
postCustomersRequestBodySource PostCustomersRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"tax" Text -> Maybe PostCustomersRequestBodyTax' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersRequestBody -> Maybe PostCustomersRequestBodyTax'
postCustomersRequestBodyTax PostCustomersRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"tax_exempt" Text -> Maybe PostCustomersRequestBodyTaxExempt' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersRequestBody
-> Maybe PostCustomersRequestBodyTaxExempt'
postCustomersRequestBodyTaxExempt PostCustomersRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"tax_id_data" Text -> Maybe [PostCustomersRequestBodyTaxIdData'] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersRequestBody
-> Maybe [PostCustomersRequestBodyTaxIdData']
postCustomersRequestBodyTaxIdData PostCustomersRequestBody
obj))))))))))))))))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersRequestBody where
  parseJSON :: Value -> Parser PostCustomersRequestBody
parseJSON = String
-> (Object -> Parser PostCustomersRequestBody)
-> Value
-> Parser PostCustomersRequestBody
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostCustomersRequestBody" (\Object
obj -> ((((((((((((((((((((Maybe PostCustomersRequestBodyAddress'Variants
 -> Maybe Int
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe Text
 -> Maybe PostCustomersRequestBodyInvoiceSettings'
 -> Maybe PostCustomersRequestBodyMetadata'Variants
 -> Maybe Text
 -> Maybe Int
 -> Maybe Text
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe Text
 -> Maybe PostCustomersRequestBodyShipping'Variants
 -> Maybe Text
 -> Maybe PostCustomersRequestBodyTax'
 -> Maybe PostCustomersRequestBodyTaxExempt'
 -> Maybe [PostCustomersRequestBodyTaxIdData']
 -> PostCustomersRequestBody)
-> Parser
     (Maybe PostCustomersRequestBodyAddress'Variants
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyInvoiceSettings'
      -> Maybe PostCustomersRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyTax'
      -> Maybe PostCustomersRequestBodyTaxExempt'
      -> Maybe [PostCustomersRequestBodyTaxIdData']
      -> PostCustomersRequestBody)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe PostCustomersRequestBodyAddress'Variants
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe PostCustomersRequestBodyInvoiceSettings'
-> Maybe PostCustomersRequestBodyMetadata'Variants
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe PostCustomersRequestBodyShipping'Variants
-> Maybe Text
-> Maybe PostCustomersRequestBodyTax'
-> Maybe PostCustomersRequestBodyTaxExempt'
-> Maybe [PostCustomersRequestBodyTaxIdData']
-> PostCustomersRequestBody
PostCustomersRequestBody Parser
  (Maybe PostCustomersRequestBodyAddress'Variants
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyInvoiceSettings'
   -> Maybe PostCustomersRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyTax'
   -> Maybe PostCustomersRequestBodyTaxExempt'
   -> Maybe [PostCustomersRequestBodyTaxIdData']
   -> PostCustomersRequestBody)
-> Parser (Maybe PostCustomersRequestBodyAddress'Variants)
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyInvoiceSettings'
      -> Maybe PostCustomersRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyTax'
      -> Maybe PostCustomersRequestBodyTaxExempt'
      -> Maybe [PostCustomersRequestBodyTaxIdData']
      -> PostCustomersRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe PostCustomersRequestBodyAddress'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"address")) Parser
  (Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyInvoiceSettings'
   -> Maybe PostCustomersRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyTax'
   -> Maybe PostCustomersRequestBodyTaxExempt'
   -> Maybe [PostCustomersRequestBodyTaxIdData']
   -> PostCustomersRequestBody)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyInvoiceSettings'
      -> Maybe PostCustomersRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyTax'
      -> Maybe PostCustomersRequestBodyTaxExempt'
      -> Maybe [PostCustomersRequestBodyTaxIdData']
      -> PostCustomersRequestBody)
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 Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyInvoiceSettings'
   -> Maybe PostCustomersRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyTax'
   -> Maybe PostCustomersRequestBodyTaxExempt'
   -> Maybe [PostCustomersRequestBodyTaxIdData']
   -> PostCustomersRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyInvoiceSettings'
      -> Maybe PostCustomersRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyTax'
      -> Maybe PostCustomersRequestBodyTaxExempt'
      -> Maybe [PostCustomersRequestBodyTaxIdData']
      -> PostCustomersRequestBody)
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 PostCustomersRequestBodyInvoiceSettings'
   -> Maybe PostCustomersRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyTax'
   -> Maybe PostCustomersRequestBodyTaxExempt'
   -> Maybe [PostCustomersRequestBodyTaxIdData']
   -> PostCustomersRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyInvoiceSettings'
      -> Maybe PostCustomersRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyTax'
      -> Maybe PostCustomersRequestBodyTaxExempt'
      -> Maybe [PostCustomersRequestBodyTaxIdData']
      -> PostCustomersRequestBody)
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 PostCustomersRequestBodyInvoiceSettings'
   -> Maybe PostCustomersRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyTax'
   -> Maybe PostCustomersRequestBodyTaxExempt'
   -> Maybe [PostCustomersRequestBodyTaxIdData']
   -> PostCustomersRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyInvoiceSettings'
      -> Maybe PostCustomersRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyTax'
      -> Maybe PostCustomersRequestBodyTaxExempt'
      -> Maybe [PostCustomersRequestBodyTaxIdData']
      -> PostCustomersRequestBody)
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 PostCustomersRequestBodyInvoiceSettings'
   -> Maybe PostCustomersRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyTax'
   -> Maybe PostCustomersRequestBodyTaxExempt'
   -> Maybe [PostCustomersRequestBodyTaxIdData']
   -> PostCustomersRequestBody)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Text
      -> Maybe PostCustomersRequestBodyInvoiceSettings'
      -> Maybe PostCustomersRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyTax'
      -> Maybe PostCustomersRequestBodyTaxExempt'
      -> Maybe [PostCustomersRequestBodyTaxIdData']
      -> PostCustomersRequestBody)
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 PostCustomersRequestBodyInvoiceSettings'
   -> Maybe PostCustomersRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyTax'
   -> Maybe PostCustomersRequestBodyTaxExempt'
   -> Maybe [PostCustomersRequestBodyTaxIdData']
   -> PostCustomersRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostCustomersRequestBodyInvoiceSettings'
      -> Maybe PostCustomersRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyTax'
      -> Maybe PostCustomersRequestBodyTaxExempt'
      -> Maybe [PostCustomersRequestBodyTaxIdData']
      -> PostCustomersRequestBody)
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 PostCustomersRequestBodyInvoiceSettings'
   -> Maybe PostCustomersRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyTax'
   -> Maybe PostCustomersRequestBodyTaxExempt'
   -> Maybe [PostCustomersRequestBodyTaxIdData']
   -> PostCustomersRequestBody)
-> Parser (Maybe PostCustomersRequestBodyInvoiceSettings')
-> Parser
     (Maybe PostCustomersRequestBodyMetadata'Variants
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyTax'
      -> Maybe PostCustomersRequestBodyTaxExempt'
      -> Maybe [PostCustomersRequestBodyTaxIdData']
      -> PostCustomersRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe PostCustomersRequestBodyInvoiceSettings')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"invoice_settings")) Parser
  (Maybe PostCustomersRequestBodyMetadata'Variants
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyTax'
   -> Maybe PostCustomersRequestBodyTaxExempt'
   -> Maybe [PostCustomersRequestBodyTaxIdData']
   -> PostCustomersRequestBody)
-> Parser (Maybe PostCustomersRequestBodyMetadata'Variants)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyTax'
      -> Maybe PostCustomersRequestBodyTaxExempt'
      -> Maybe [PostCustomersRequestBodyTaxIdData']
      -> PostCustomersRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe PostCustomersRequestBodyMetadata'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 Text
   -> Maybe PostCustomersRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyTax'
   -> Maybe PostCustomersRequestBodyTaxExempt'
   -> Maybe [PostCustomersRequestBodyTaxIdData']
   -> PostCustomersRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyTax'
      -> Maybe PostCustomersRequestBodyTaxExempt'
      -> Maybe [PostCustomersRequestBodyTaxIdData']
      -> PostCustomersRequestBody)
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 Text
   -> Maybe PostCustomersRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyTax'
   -> Maybe PostCustomersRequestBodyTaxExempt'
   -> Maybe [PostCustomersRequestBodyTaxIdData']
   -> PostCustomersRequestBody)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyTax'
      -> Maybe PostCustomersRequestBodyTaxExempt'
      -> Maybe [PostCustomersRequestBodyTaxIdData']
      -> PostCustomersRequestBody)
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 Text
   -> Maybe PostCustomersRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyTax'
   -> Maybe PostCustomersRequestBodyTaxExempt'
   -> Maybe [PostCustomersRequestBodyTaxIdData']
   -> PostCustomersRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyTax'
      -> Maybe PostCustomersRequestBodyTaxExempt'
      -> Maybe [PostCustomersRequestBodyTaxIdData']
      -> PostCustomersRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"payment_method")) Parser
  (Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyTax'
   -> Maybe PostCustomersRequestBodyTaxExempt'
   -> Maybe [PostCustomersRequestBodyTaxIdData']
   -> PostCustomersRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text]
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyTax'
      -> Maybe PostCustomersRequestBodyTaxExempt'
      -> Maybe [PostCustomersRequestBodyTaxIdData']
      -> PostCustomersRequestBody)
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 PostCustomersRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyTax'
   -> Maybe PostCustomersRequestBodyTaxExempt'
   -> Maybe [PostCustomersRequestBodyTaxIdData']
   -> PostCustomersRequestBody)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Text
      -> Maybe PostCustomersRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyTax'
      -> Maybe PostCustomersRequestBodyTaxExempt'
      -> Maybe [PostCustomersRequestBodyTaxIdData']
      -> PostCustomersRequestBody)
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 PostCustomersRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyTax'
   -> Maybe PostCustomersRequestBodyTaxExempt'
   -> Maybe [PostCustomersRequestBodyTaxIdData']
   -> PostCustomersRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostCustomersRequestBodyShipping'Variants
      -> Maybe Text
      -> Maybe PostCustomersRequestBodyTax'
      -> Maybe PostCustomersRequestBodyTaxExempt'
      -> Maybe [PostCustomersRequestBodyTaxIdData']
      -> PostCustomersRequestBody)
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 PostCustomersRequestBodyShipping'Variants
   -> Maybe Text
   -> Maybe PostCustomersRequestBodyTax'
   -> Maybe PostCustomersRequestBodyTaxExempt'
   -> Maybe [PostCustomersRequestBodyTaxIdData']
   -> PostCustomersRequestBody)
-> Parser (Maybe PostCustomersRequestBodyShipping'Variants)
-> Parser
     (Maybe Text
      -> Maybe PostCustomersRequestBodyTax'
      -> Maybe PostCustomersRequestBodyTaxExempt'
      -> Maybe [PostCustomersRequestBodyTaxIdData']
      -> PostCustomersRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe PostCustomersRequestBodyShipping'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"shipping")) Parser
  (Maybe Text
   -> Maybe PostCustomersRequestBodyTax'
   -> Maybe PostCustomersRequestBodyTaxExempt'
   -> Maybe [PostCustomersRequestBodyTaxIdData']
   -> PostCustomersRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostCustomersRequestBodyTax'
      -> Maybe PostCustomersRequestBodyTaxExempt'
      -> Maybe [PostCustomersRequestBodyTaxIdData']
      -> PostCustomersRequestBody)
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 PostCustomersRequestBodyTax'
   -> Maybe PostCustomersRequestBodyTaxExempt'
   -> Maybe [PostCustomersRequestBodyTaxIdData']
   -> PostCustomersRequestBody)
-> Parser (Maybe PostCustomersRequestBodyTax')
-> Parser
     (Maybe PostCustomersRequestBodyTaxExempt'
      -> Maybe [PostCustomersRequestBodyTaxIdData']
      -> PostCustomersRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe PostCustomersRequestBodyTax')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"tax")) Parser
  (Maybe PostCustomersRequestBodyTaxExempt'
   -> Maybe [PostCustomersRequestBodyTaxIdData']
   -> PostCustomersRequestBody)
-> Parser (Maybe PostCustomersRequestBodyTaxExempt')
-> Parser
     (Maybe [PostCustomersRequestBodyTaxIdData']
      -> PostCustomersRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe PostCustomersRequestBodyTaxExempt')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"tax_exempt")) Parser
  (Maybe [PostCustomersRequestBodyTaxIdData']
   -> PostCustomersRequestBody)
-> Parser (Maybe [PostCustomersRequestBodyTaxIdData'])
-> Parser PostCustomersRequestBody
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe [PostCustomersRequestBodyTaxIdData'])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"tax_id_data"))

-- | Create a new 'PostCustomersRequestBody' with all required fields.
mkPostCustomersRequestBody :: PostCustomersRequestBody
mkPostCustomersRequestBody :: PostCustomersRequestBody
mkPostCustomersRequestBody =
  PostCustomersRequestBody :: Maybe PostCustomersRequestBodyAddress'Variants
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe PostCustomersRequestBodyInvoiceSettings'
-> Maybe PostCustomersRequestBodyMetadata'Variants
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe PostCustomersRequestBodyShipping'Variants
-> Maybe Text
-> Maybe PostCustomersRequestBodyTax'
-> Maybe PostCustomersRequestBodyTaxExempt'
-> Maybe [PostCustomersRequestBodyTaxIdData']
-> PostCustomersRequestBody
PostCustomersRequestBody
    { postCustomersRequestBodyAddress :: Maybe PostCustomersRequestBodyAddress'Variants
postCustomersRequestBodyAddress = Maybe PostCustomersRequestBodyAddress'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersRequestBodyBalance :: Maybe Int
postCustomersRequestBodyBalance = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersRequestBodyCoupon :: Maybe Text
postCustomersRequestBodyCoupon = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersRequestBodyDescription :: Maybe Text
postCustomersRequestBodyDescription = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersRequestBodyEmail :: Maybe Text
postCustomersRequestBodyEmail = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersRequestBodyExpand :: Maybe [Text]
postCustomersRequestBodyExpand = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersRequestBodyInvoicePrefix :: Maybe Text
postCustomersRequestBodyInvoicePrefix = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersRequestBodyInvoiceSettings :: Maybe PostCustomersRequestBodyInvoiceSettings'
postCustomersRequestBodyInvoiceSettings = Maybe PostCustomersRequestBodyInvoiceSettings'
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersRequestBodyMetadata :: Maybe PostCustomersRequestBodyMetadata'Variants
postCustomersRequestBodyMetadata = Maybe PostCustomersRequestBodyMetadata'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersRequestBodyName :: Maybe Text
postCustomersRequestBodyName = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersRequestBodyNextInvoiceSequence :: Maybe Int
postCustomersRequestBodyNextInvoiceSequence = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersRequestBodyPaymentMethod :: Maybe Text
postCustomersRequestBodyPaymentMethod = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersRequestBodyPhone :: Maybe Text
postCustomersRequestBodyPhone = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersRequestBodyPreferredLocales :: Maybe [Text]
postCustomersRequestBodyPreferredLocales = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersRequestBodyPromotionCode :: Maybe Text
postCustomersRequestBodyPromotionCode = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersRequestBodyShipping :: Maybe PostCustomersRequestBodyShipping'Variants
postCustomersRequestBodyShipping = Maybe PostCustomersRequestBodyShipping'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersRequestBodySource :: Maybe Text
postCustomersRequestBodySource = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersRequestBodyTax :: Maybe PostCustomersRequestBodyTax'
postCustomersRequestBodyTax = Maybe PostCustomersRequestBodyTax'
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersRequestBodyTaxExempt :: Maybe PostCustomersRequestBodyTaxExempt'
postCustomersRequestBodyTaxExempt = Maybe PostCustomersRequestBodyTaxExempt'
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersRequestBodyTaxIdData :: Maybe [PostCustomersRequestBodyTaxIdData']
postCustomersRequestBodyTaxIdData = Maybe [PostCustomersRequestBodyTaxIdData']
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

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

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersRequestBodyAddress'OneOf1 where
  parseJSON :: Value -> Parser PostCustomersRequestBodyAddress'OneOf1
parseJSON = String
-> (Object -> Parser PostCustomersRequestBodyAddress'OneOf1)
-> Value
-> Parser PostCustomersRequestBodyAddress'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostCustomersRequestBodyAddress'OneOf1" (\Object
obj -> ((((((Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> PostCustomersRequestBodyAddress'OneOf1)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostCustomersRequestBodyAddress'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostCustomersRequestBodyAddress'OneOf1
PostCustomersRequestBodyAddress'OneOf1 Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostCustomersRequestBodyAddress'OneOf1)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostCustomersRequestBodyAddress'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
   -> PostCustomersRequestBodyAddress'OneOf1)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostCustomersRequestBodyAddress'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
   -> PostCustomersRequestBodyAddress'OneOf1)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostCustomersRequestBodyAddress'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
   -> PostCustomersRequestBodyAddress'OneOf1)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text -> PostCustomersRequestBodyAddress'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 -> PostCustomersRequestBodyAddress'OneOf1)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> PostCustomersRequestBodyAddress'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 -> PostCustomersRequestBodyAddress'OneOf1)
-> Parser (Maybe Text)
-> Parser PostCustomersRequestBodyAddress'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 'PostCustomersRequestBodyAddress'OneOf1' with all required fields.
mkPostCustomersRequestBodyAddress'OneOf1 :: PostCustomersRequestBodyAddress'OneOf1
mkPostCustomersRequestBodyAddress'OneOf1 :: PostCustomersRequestBodyAddress'OneOf1
mkPostCustomersRequestBodyAddress'OneOf1 =
  PostCustomersRequestBodyAddress'OneOf1 :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostCustomersRequestBodyAddress'OneOf1
PostCustomersRequestBodyAddress'OneOf1
    { postCustomersRequestBodyAddress'OneOf1City :: Maybe Text
postCustomersRequestBodyAddress'OneOf1City = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersRequestBodyAddress'OneOf1Country :: Maybe Text
postCustomersRequestBodyAddress'OneOf1Country = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersRequestBodyAddress'OneOf1Line1 :: Maybe Text
postCustomersRequestBodyAddress'OneOf1Line1 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersRequestBodyAddress'OneOf1Line2 :: Maybe Text
postCustomersRequestBodyAddress'OneOf1Line2 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersRequestBodyAddress'OneOf1PostalCode :: Maybe Text
postCustomersRequestBodyAddress'OneOf1PostalCode = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersRequestBodyAddress'OneOf1State :: Maybe Text
postCustomersRequestBodyAddress'OneOf1State = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

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

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

-- | Defines the object schema located at @paths.\/v1\/customers.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.invoice_settings@ in the specification.
--
-- Default invoice settings for this customer.
data PostCustomersRequestBodyInvoiceSettings' = PostCustomersRequestBodyInvoiceSettings'
  { -- | custom_fields
    PostCustomersRequestBodyInvoiceSettings'
-> Maybe
     PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants
postCustomersRequestBodyInvoiceSettings'CustomFields :: (GHC.Maybe.Maybe PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants),
    -- | default_payment_method
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersRequestBodyInvoiceSettings' -> Maybe Text
postCustomersRequestBodyInvoiceSettings'DefaultPaymentMethod :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | footer
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersRequestBodyInvoiceSettings' -> Maybe Text
postCustomersRequestBodyInvoiceSettings'Footer :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int -> PostCustomersRequestBodyInvoiceSettings' -> ShowS
[PostCustomersRequestBodyInvoiceSettings'] -> ShowS
PostCustomersRequestBodyInvoiceSettings' -> String
(Int -> PostCustomersRequestBodyInvoiceSettings' -> ShowS)
-> (PostCustomersRequestBodyInvoiceSettings' -> String)
-> ([PostCustomersRequestBodyInvoiceSettings'] -> ShowS)
-> Show PostCustomersRequestBodyInvoiceSettings'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostCustomersRequestBodyInvoiceSettings'] -> ShowS
$cshowList :: [PostCustomersRequestBodyInvoiceSettings'] -> ShowS
show :: PostCustomersRequestBodyInvoiceSettings' -> String
$cshow :: PostCustomersRequestBodyInvoiceSettings' -> String
showsPrec :: Int -> PostCustomersRequestBodyInvoiceSettings' -> ShowS
$cshowsPrec :: Int -> PostCustomersRequestBodyInvoiceSettings' -> ShowS
GHC.Show.Show,
      PostCustomersRequestBodyInvoiceSettings'
-> PostCustomersRequestBodyInvoiceSettings' -> Bool
(PostCustomersRequestBodyInvoiceSettings'
 -> PostCustomersRequestBodyInvoiceSettings' -> Bool)
-> (PostCustomersRequestBodyInvoiceSettings'
    -> PostCustomersRequestBodyInvoiceSettings' -> Bool)
-> Eq PostCustomersRequestBodyInvoiceSettings'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersRequestBodyInvoiceSettings'
-> PostCustomersRequestBodyInvoiceSettings' -> Bool
$c/= :: PostCustomersRequestBodyInvoiceSettings'
-> PostCustomersRequestBodyInvoiceSettings' -> Bool
== :: PostCustomersRequestBodyInvoiceSettings'
-> PostCustomersRequestBodyInvoiceSettings' -> Bool
$c== :: PostCustomersRequestBodyInvoiceSettings'
-> PostCustomersRequestBodyInvoiceSettings' -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostCustomersRequestBodyInvoiceSettings' where
  toJSON :: PostCustomersRequestBodyInvoiceSettings' -> Value
toJSON PostCustomersRequestBodyInvoiceSettings'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"custom_fields" Text
-> Maybe
     PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersRequestBodyInvoiceSettings'
-> Maybe
     PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants
postCustomersRequestBodyInvoiceSettings'CustomFields PostCustomersRequestBodyInvoiceSettings'
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..= PostCustomersRequestBodyInvoiceSettings' -> Maybe Text
postCustomersRequestBodyInvoiceSettings'DefaultPaymentMethod PostCustomersRequestBodyInvoiceSettings'
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..= PostCustomersRequestBodyInvoiceSettings' -> Maybe Text
postCustomersRequestBodyInvoiceSettings'Footer PostCustomersRequestBodyInvoiceSettings'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostCustomersRequestBodyInvoiceSettings' -> Encoding
toEncoding PostCustomersRequestBodyInvoiceSettings'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"custom_fields" Text
-> Maybe
     PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersRequestBodyInvoiceSettings'
-> Maybe
     PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants
postCustomersRequestBodyInvoiceSettings'CustomFields PostCustomersRequestBodyInvoiceSettings'
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..= PostCustomersRequestBodyInvoiceSettings' -> Maybe Text
postCustomersRequestBodyInvoiceSettings'DefaultPaymentMethod PostCustomersRequestBodyInvoiceSettings'
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..= PostCustomersRequestBodyInvoiceSettings' -> Maybe Text
postCustomersRequestBodyInvoiceSettings'Footer PostCustomersRequestBodyInvoiceSettings'
obj)))

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersRequestBodyInvoiceSettings' where
  parseJSON :: Value -> Parser PostCustomersRequestBodyInvoiceSettings'
parseJSON = String
-> (Object -> Parser PostCustomersRequestBodyInvoiceSettings')
-> Value
-> Parser PostCustomersRequestBodyInvoiceSettings'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostCustomersRequestBodyInvoiceSettings'" (\Object
obj -> (((Maybe
   PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants
 -> Maybe Text
 -> Maybe Text
 -> PostCustomersRequestBodyInvoiceSettings')
-> Parser
     (Maybe
        PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants
      -> Maybe Text
      -> Maybe Text
      -> PostCustomersRequestBodyInvoiceSettings')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants
-> Maybe Text
-> Maybe Text
-> PostCustomersRequestBodyInvoiceSettings'
PostCustomersRequestBodyInvoiceSettings' Parser
  (Maybe
     PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants
   -> Maybe Text
   -> Maybe Text
   -> PostCustomersRequestBodyInvoiceSettings')
-> Parser
     (Maybe
        PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants)
-> Parser
     (Maybe Text
      -> Maybe Text -> PostCustomersRequestBodyInvoiceSettings')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"custom_fields")) Parser
  (Maybe Text
   -> Maybe Text -> PostCustomersRequestBodyInvoiceSettings')
-> Parser (Maybe Text)
-> Parser (Maybe Text -> PostCustomersRequestBodyInvoiceSettings')
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 -> PostCustomersRequestBodyInvoiceSettings')
-> Parser (Maybe Text)
-> Parser PostCustomersRequestBodyInvoiceSettings'
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 'PostCustomersRequestBodyInvoiceSettings'' with all required fields.
mkPostCustomersRequestBodyInvoiceSettings' :: PostCustomersRequestBodyInvoiceSettings'
mkPostCustomersRequestBodyInvoiceSettings' :: PostCustomersRequestBodyInvoiceSettings'
mkPostCustomersRequestBodyInvoiceSettings' =
  PostCustomersRequestBodyInvoiceSettings' :: Maybe PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants
-> Maybe Text
-> Maybe Text
-> PostCustomersRequestBodyInvoiceSettings'
PostCustomersRequestBodyInvoiceSettings'
    { postCustomersRequestBodyInvoiceSettings'CustomFields :: Maybe PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants
postCustomersRequestBodyInvoiceSettings'CustomFields = Maybe PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersRequestBodyInvoiceSettings'DefaultPaymentMethod :: Maybe Text
postCustomersRequestBodyInvoiceSettings'DefaultPaymentMethod = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postCustomersRequestBodyInvoiceSettings'Footer :: Maybe Text
postCustomersRequestBodyInvoiceSettings'Footer = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

instance Data.Aeson.Types.ToJSON.ToJSON PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1 where
  toJSON :: PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1
-> Value
toJSON PostCustomersRequestBodyInvoiceSettings'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..= PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1 -> Text
postCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1Name PostCustomersRequestBodyInvoiceSettings'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..= PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1 -> Text
postCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1Value PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1
-> Encoding
toEncoding PostCustomersRequestBodyInvoiceSettings'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..= PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1 -> Text
postCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1Name PostCustomersRequestBodyInvoiceSettings'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..= PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1 -> Text
postCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1Value PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1
obj))

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1 where
  parseJSON :: Value
-> Parser
     PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1
parseJSON = String
-> (Object
    -> Parser
         PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1)
-> Value
-> Parser
     PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1" (\Object
obj -> ((Text
 -> Text
 -> PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1)
-> Parser
     (Text
      -> Text
      -> PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Text
-> Text
-> PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1
PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1 Parser
  (Text
   -> Text
   -> PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1)
-> Parser Text
-> Parser
     (Text
      -> PostCustomersRequestBodyInvoiceSettings'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
   -> PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1)
-> Parser Text
-> Parser
     PostCustomersRequestBodyInvoiceSettings'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 'PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1' with all required fields.
mkPostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1 ::
  -- | 'postCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1Name'
  Data.Text.Internal.Text ->
  -- | 'postCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1Value'
  Data.Text.Internal.Text ->
  PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1
mkPostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1 :: Text
-> Text
-> PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1
mkPostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1 Text
postCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1Name Text
postCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1Value =
  PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1 :: Text
-> Text
-> PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1
PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1
    { postCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1Name :: Text
postCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1Name = Text
postCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1Name,
      postCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1Value :: Text
postCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1Value = Text
postCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1Value
    }

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

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

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants where
  parseJSON :: Value
-> Parser
     PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants
-> Parser
     PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants
PostCustomersRequestBodyInvoiceSettings'CustomFields'EmptyString
        | Bool
GHC.Base.otherwise -> case ([PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1]
-> PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants
PostCustomersRequestBodyInvoiceSettings'CustomFields'ListTPostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1 ([PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1]
 -> PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants)
-> Result
     [PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1]
-> Result
     PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> Value
-> Result
     [PostCustomersRequestBodyInvoiceSettings'CustomFields'OneOf1]
forall a. FromJSON a => Value -> Result a
Data.Aeson.Types.FromJSON.fromJSON Value
val) Result
  PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants
-> Result
     PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants
-> Result
     PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String
-> Result
     PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants
a -> PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants
-> Parser
     PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostCustomersRequestBodyInvoiceSettings'CustomFields'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String
-> Parser
     PostCustomersRequestBodyInvoiceSettings'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.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 PostCustomersRequestBodyMetadata'Variants
  = -- | Represents the JSON value @""@
    PostCustomersRequestBodyMetadata'EmptyString
  | PostCustomersRequestBodyMetadata'Object Data.Aeson.Types.Internal.Object
  deriving (Int -> PostCustomersRequestBodyMetadata'Variants -> ShowS
[PostCustomersRequestBodyMetadata'Variants] -> ShowS
PostCustomersRequestBodyMetadata'Variants -> String
(Int -> PostCustomersRequestBodyMetadata'Variants -> ShowS)
-> (PostCustomersRequestBodyMetadata'Variants -> String)
-> ([PostCustomersRequestBodyMetadata'Variants] -> ShowS)
-> Show PostCustomersRequestBodyMetadata'Variants
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostCustomersRequestBodyMetadata'Variants] -> ShowS
$cshowList :: [PostCustomersRequestBodyMetadata'Variants] -> ShowS
show :: PostCustomersRequestBodyMetadata'Variants -> String
$cshow :: PostCustomersRequestBodyMetadata'Variants -> String
showsPrec :: Int -> PostCustomersRequestBodyMetadata'Variants -> ShowS
$cshowsPrec :: Int -> PostCustomersRequestBodyMetadata'Variants -> ShowS
GHC.Show.Show, PostCustomersRequestBodyMetadata'Variants
-> PostCustomersRequestBodyMetadata'Variants -> Bool
(PostCustomersRequestBodyMetadata'Variants
 -> PostCustomersRequestBodyMetadata'Variants -> Bool)
-> (PostCustomersRequestBodyMetadata'Variants
    -> PostCustomersRequestBodyMetadata'Variants -> Bool)
-> Eq PostCustomersRequestBodyMetadata'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersRequestBodyMetadata'Variants
-> PostCustomersRequestBodyMetadata'Variants -> Bool
$c/= :: PostCustomersRequestBodyMetadata'Variants
-> PostCustomersRequestBodyMetadata'Variants -> Bool
== :: PostCustomersRequestBodyMetadata'Variants
-> PostCustomersRequestBodyMetadata'Variants -> Bool
$c== :: PostCustomersRequestBodyMetadata'Variants
-> PostCustomersRequestBodyMetadata'Variants -> Bool
GHC.Classes.Eq)

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

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

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

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

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersRequestBodyShipping'OneOf1 where
  parseJSON :: Value -> Parser PostCustomersRequestBodyShipping'OneOf1
parseJSON = String
-> (Object -> Parser PostCustomersRequestBodyShipping'OneOf1)
-> Value
-> Parser PostCustomersRequestBodyShipping'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostCustomersRequestBodyShipping'OneOf1" (\Object
obj -> (((PostCustomersRequestBodyShipping'OneOf1Address'
 -> Text -> Maybe Text -> PostCustomersRequestBodyShipping'OneOf1)
-> Parser
     (PostCustomersRequestBodyShipping'OneOf1Address'
      -> Text -> Maybe Text -> PostCustomersRequestBodyShipping'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostCustomersRequestBodyShipping'OneOf1Address'
-> Text -> Maybe Text -> PostCustomersRequestBodyShipping'OneOf1
PostCustomersRequestBodyShipping'OneOf1 Parser
  (PostCustomersRequestBodyShipping'OneOf1Address'
   -> Text -> Maybe Text -> PostCustomersRequestBodyShipping'OneOf1)
-> Parser PostCustomersRequestBodyShipping'OneOf1Address'
-> Parser
     (Text -> Maybe Text -> PostCustomersRequestBodyShipping'OneOf1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser PostCustomersRequestBodyShipping'OneOf1Address'
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"address")) Parser
  (Text -> Maybe Text -> PostCustomersRequestBodyShipping'OneOf1)
-> Parser Text
-> Parser (Maybe Text -> PostCustomersRequestBodyShipping'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 -> PostCustomersRequestBodyShipping'OneOf1)
-> Parser (Maybe Text)
-> Parser PostCustomersRequestBodyShipping'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 'PostCustomersRequestBodyShipping'OneOf1' with all required fields.
mkPostCustomersRequestBodyShipping'OneOf1 ::
  -- | 'postCustomersRequestBodyShipping'OneOf1Address'
  PostCustomersRequestBodyShipping'OneOf1Address' ->
  -- | 'postCustomersRequestBodyShipping'OneOf1Name'
  Data.Text.Internal.Text ->
  PostCustomersRequestBodyShipping'OneOf1
mkPostCustomersRequestBodyShipping'OneOf1 :: PostCustomersRequestBodyShipping'OneOf1Address'
-> Text -> PostCustomersRequestBodyShipping'OneOf1
mkPostCustomersRequestBodyShipping'OneOf1 PostCustomersRequestBodyShipping'OneOf1Address'
postCustomersRequestBodyShipping'OneOf1Address Text
postCustomersRequestBodyShipping'OneOf1Name =
  PostCustomersRequestBodyShipping'OneOf1 :: PostCustomersRequestBodyShipping'OneOf1Address'
-> Text -> Maybe Text -> PostCustomersRequestBodyShipping'OneOf1
PostCustomersRequestBodyShipping'OneOf1
    { postCustomersRequestBodyShipping'OneOf1Address :: PostCustomersRequestBodyShipping'OneOf1Address'
postCustomersRequestBodyShipping'OneOf1Address = PostCustomersRequestBodyShipping'OneOf1Address'
postCustomersRequestBodyShipping'OneOf1Address,
      postCustomersRequestBodyShipping'OneOf1Name :: Text
postCustomersRequestBodyShipping'OneOf1Name = Text
postCustomersRequestBodyShipping'OneOf1Name,
      postCustomersRequestBodyShipping'OneOf1Phone :: Maybe Text
postCustomersRequestBodyShipping'OneOf1Phone = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

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

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

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

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

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

-- | Defines the object schema located at @paths.\/v1\/customers.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.tax@ in the specification.
--
-- Tax details about the customer.
data PostCustomersRequestBodyTax' = PostCustomersRequestBodyTax'
  { -- | ip_address
    PostCustomersRequestBodyTax'
-> Maybe PostCustomersRequestBodyTax'IpAddress'Variants
postCustomersRequestBodyTax'IpAddress :: (GHC.Maybe.Maybe PostCustomersRequestBodyTax'IpAddress'Variants)
  }
  deriving
    ( Int -> PostCustomersRequestBodyTax' -> ShowS
[PostCustomersRequestBodyTax'] -> ShowS
PostCustomersRequestBodyTax' -> String
(Int -> PostCustomersRequestBodyTax' -> ShowS)
-> (PostCustomersRequestBodyTax' -> String)
-> ([PostCustomersRequestBodyTax'] -> ShowS)
-> Show PostCustomersRequestBodyTax'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostCustomersRequestBodyTax'] -> ShowS
$cshowList :: [PostCustomersRequestBodyTax'] -> ShowS
show :: PostCustomersRequestBodyTax' -> String
$cshow :: PostCustomersRequestBodyTax' -> String
showsPrec :: Int -> PostCustomersRequestBodyTax' -> ShowS
$cshowsPrec :: Int -> PostCustomersRequestBodyTax' -> ShowS
GHC.Show.Show,
      PostCustomersRequestBodyTax'
-> PostCustomersRequestBodyTax' -> Bool
(PostCustomersRequestBodyTax'
 -> PostCustomersRequestBodyTax' -> Bool)
-> (PostCustomersRequestBodyTax'
    -> PostCustomersRequestBodyTax' -> Bool)
-> Eq PostCustomersRequestBodyTax'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersRequestBodyTax'
-> PostCustomersRequestBodyTax' -> Bool
$c/= :: PostCustomersRequestBodyTax'
-> PostCustomersRequestBodyTax' -> Bool
== :: PostCustomersRequestBodyTax'
-> PostCustomersRequestBodyTax' -> Bool
$c== :: PostCustomersRequestBodyTax'
-> PostCustomersRequestBodyTax' -> Bool
GHC.Classes.Eq
    )

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

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

-- | Create a new 'PostCustomersRequestBodyTax'' with all required fields.
mkPostCustomersRequestBodyTax' :: PostCustomersRequestBodyTax'
mkPostCustomersRequestBodyTax' :: PostCustomersRequestBodyTax'
mkPostCustomersRequestBodyTax' = PostCustomersRequestBodyTax' :: Maybe PostCustomersRequestBodyTax'IpAddress'Variants
-> PostCustomersRequestBodyTax'
PostCustomersRequestBodyTax' {postCustomersRequestBodyTax'IpAddress :: Maybe PostCustomersRequestBodyTax'IpAddress'Variants
postCustomersRequestBodyTax'IpAddress = Maybe PostCustomersRequestBodyTax'IpAddress'Variants
forall a. Maybe a
GHC.Maybe.Nothing}

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

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

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersRequestBodyTax'IpAddress'Variants where
  parseJSON :: Value -> Parser PostCustomersRequestBodyTax'IpAddress'Variants
parseJSON Value
val =
    if
        | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"" -> PostCustomersRequestBodyTax'IpAddress'Variants
-> Parser PostCustomersRequestBodyTax'IpAddress'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostCustomersRequestBodyTax'IpAddress'Variants
PostCustomersRequestBodyTax'IpAddress'EmptyString
        | Bool
GHC.Base.otherwise -> case (Text -> PostCustomersRequestBodyTax'IpAddress'Variants
PostCustomersRequestBodyTax'IpAddress'Text (Text -> PostCustomersRequestBodyTax'IpAddress'Variants)
-> Result Text
-> Result PostCustomersRequestBodyTax'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 PostCustomersRequestBodyTax'IpAddress'Variants
-> Result PostCustomersRequestBodyTax'IpAddress'Variants
-> Result PostCustomersRequestBodyTax'IpAddress'Variants
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
GHC.Base.<|> String -> Result PostCustomersRequestBodyTax'IpAddress'Variants
forall a. String -> Result a
Data.Aeson.Types.Internal.Error String
"No variant matched" of
          Data.Aeson.Types.Internal.Success PostCustomersRequestBodyTax'IpAddress'Variants
a -> PostCustomersRequestBodyTax'IpAddress'Variants
-> Parser PostCustomersRequestBodyTax'IpAddress'Variants
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostCustomersRequestBodyTax'IpAddress'Variants
a
          Data.Aeson.Types.Internal.Error String
a -> String -> Parser PostCustomersRequestBodyTax'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.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 PostCustomersRequestBodyTaxExempt'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostCustomersRequestBodyTaxExempt'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.
    PostCustomersRequestBodyTaxExempt'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @""@
    PostCustomersRequestBodyTaxExempt'EnumEmptyString
  | -- | Represents the JSON value @"exempt"@
    PostCustomersRequestBodyTaxExempt'EnumExempt
  | -- | Represents the JSON value @"none"@
    PostCustomersRequestBodyTaxExempt'EnumNone
  | -- | Represents the JSON value @"reverse"@
    PostCustomersRequestBodyTaxExempt'EnumReverse
  deriving (Int -> PostCustomersRequestBodyTaxExempt' -> ShowS
[PostCustomersRequestBodyTaxExempt'] -> ShowS
PostCustomersRequestBodyTaxExempt' -> String
(Int -> PostCustomersRequestBodyTaxExempt' -> ShowS)
-> (PostCustomersRequestBodyTaxExempt' -> String)
-> ([PostCustomersRequestBodyTaxExempt'] -> ShowS)
-> Show PostCustomersRequestBodyTaxExempt'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostCustomersRequestBodyTaxExempt'] -> ShowS
$cshowList :: [PostCustomersRequestBodyTaxExempt'] -> ShowS
show :: PostCustomersRequestBodyTaxExempt' -> String
$cshow :: PostCustomersRequestBodyTaxExempt' -> String
showsPrec :: Int -> PostCustomersRequestBodyTaxExempt' -> ShowS
$cshowsPrec :: Int -> PostCustomersRequestBodyTaxExempt' -> ShowS
GHC.Show.Show, PostCustomersRequestBodyTaxExempt'
-> PostCustomersRequestBodyTaxExempt' -> Bool
(PostCustomersRequestBodyTaxExempt'
 -> PostCustomersRequestBodyTaxExempt' -> Bool)
-> (PostCustomersRequestBodyTaxExempt'
    -> PostCustomersRequestBodyTaxExempt' -> Bool)
-> Eq PostCustomersRequestBodyTaxExempt'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersRequestBodyTaxExempt'
-> PostCustomersRequestBodyTaxExempt' -> Bool
$c/= :: PostCustomersRequestBodyTaxExempt'
-> PostCustomersRequestBodyTaxExempt' -> Bool
== :: PostCustomersRequestBodyTaxExempt'
-> PostCustomersRequestBodyTaxExempt' -> Bool
$c== :: PostCustomersRequestBodyTaxExempt'
-> PostCustomersRequestBodyTaxExempt' -> Bool
GHC.Classes.Eq)

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

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

-- | Defines the object schema located at @paths.\/v1\/customers.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.tax_id_data.items@ in the specification.
data PostCustomersRequestBodyTaxIdData' = PostCustomersRequestBodyTaxIdData'
  { -- | type
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostCustomersRequestBodyTaxIdData'
-> PostCustomersRequestBodyTaxIdData'Type'
postCustomersRequestBodyTaxIdData'Type :: PostCustomersRequestBodyTaxIdData'Type',
    -- | value
    PostCustomersRequestBodyTaxIdData' -> Text
postCustomersRequestBodyTaxIdData'Value :: Data.Text.Internal.Text
  }
  deriving
    ( Int -> PostCustomersRequestBodyTaxIdData' -> ShowS
[PostCustomersRequestBodyTaxIdData'] -> ShowS
PostCustomersRequestBodyTaxIdData' -> String
(Int -> PostCustomersRequestBodyTaxIdData' -> ShowS)
-> (PostCustomersRequestBodyTaxIdData' -> String)
-> ([PostCustomersRequestBodyTaxIdData'] -> ShowS)
-> Show PostCustomersRequestBodyTaxIdData'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostCustomersRequestBodyTaxIdData'] -> ShowS
$cshowList :: [PostCustomersRequestBodyTaxIdData'] -> ShowS
show :: PostCustomersRequestBodyTaxIdData' -> String
$cshow :: PostCustomersRequestBodyTaxIdData' -> String
showsPrec :: Int -> PostCustomersRequestBodyTaxIdData' -> ShowS
$cshowsPrec :: Int -> PostCustomersRequestBodyTaxIdData' -> ShowS
GHC.Show.Show,
      PostCustomersRequestBodyTaxIdData'
-> PostCustomersRequestBodyTaxIdData' -> Bool
(PostCustomersRequestBodyTaxIdData'
 -> PostCustomersRequestBodyTaxIdData' -> Bool)
-> (PostCustomersRequestBodyTaxIdData'
    -> PostCustomersRequestBodyTaxIdData' -> Bool)
-> Eq PostCustomersRequestBodyTaxIdData'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersRequestBodyTaxIdData'
-> PostCustomersRequestBodyTaxIdData' -> Bool
$c/= :: PostCustomersRequestBodyTaxIdData'
-> PostCustomersRequestBodyTaxIdData' -> Bool
== :: PostCustomersRequestBodyTaxIdData'
-> PostCustomersRequestBodyTaxIdData' -> Bool
$c== :: PostCustomersRequestBodyTaxIdData'
-> PostCustomersRequestBodyTaxIdData' -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostCustomersRequestBodyTaxIdData' where
  toJSON :: PostCustomersRequestBodyTaxIdData' -> Value
toJSON PostCustomersRequestBodyTaxIdData'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"type" Text -> PostCustomersRequestBodyTaxIdData'Type' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersRequestBodyTaxIdData'
-> PostCustomersRequestBodyTaxIdData'Type'
postCustomersRequestBodyTaxIdData'Type PostCustomersRequestBodyTaxIdData'
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..= PostCustomersRequestBodyTaxIdData' -> Text
postCustomersRequestBodyTaxIdData'Value PostCustomersRequestBodyTaxIdData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostCustomersRequestBodyTaxIdData' -> Encoding
toEncoding PostCustomersRequestBodyTaxIdData'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"type" Text -> PostCustomersRequestBodyTaxIdData'Type' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostCustomersRequestBodyTaxIdData'
-> PostCustomersRequestBodyTaxIdData'Type'
postCustomersRequestBodyTaxIdData'Type PostCustomersRequestBodyTaxIdData'
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..= PostCustomersRequestBodyTaxIdData' -> Text
postCustomersRequestBodyTaxIdData'Value PostCustomersRequestBodyTaxIdData'
obj))

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersRequestBodyTaxIdData' where
  parseJSON :: Value -> Parser PostCustomersRequestBodyTaxIdData'
parseJSON = String
-> (Object -> Parser PostCustomersRequestBodyTaxIdData')
-> Value
-> Parser PostCustomersRequestBodyTaxIdData'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostCustomersRequestBodyTaxIdData'" (\Object
obj -> ((PostCustomersRequestBodyTaxIdData'Type'
 -> Text -> PostCustomersRequestBodyTaxIdData')
-> Parser
     (PostCustomersRequestBodyTaxIdData'Type'
      -> Text -> PostCustomersRequestBodyTaxIdData')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure PostCustomersRequestBodyTaxIdData'Type'
-> Text -> PostCustomersRequestBodyTaxIdData'
PostCustomersRequestBodyTaxIdData' Parser
  (PostCustomersRequestBodyTaxIdData'Type'
   -> Text -> PostCustomersRequestBodyTaxIdData')
-> Parser PostCustomersRequestBodyTaxIdData'Type'
-> Parser (Text -> PostCustomersRequestBodyTaxIdData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser PostCustomersRequestBodyTaxIdData'Type'
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"type")) Parser (Text -> PostCustomersRequestBodyTaxIdData')
-> Parser Text -> Parser PostCustomersRequestBodyTaxIdData'
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 'PostCustomersRequestBodyTaxIdData'' with all required fields.
mkPostCustomersRequestBodyTaxIdData' ::
  -- | 'postCustomersRequestBodyTaxIdData'Type'
  PostCustomersRequestBodyTaxIdData'Type' ->
  -- | 'postCustomersRequestBodyTaxIdData'Value'
  Data.Text.Internal.Text ->
  PostCustomersRequestBodyTaxIdData'
mkPostCustomersRequestBodyTaxIdData' :: PostCustomersRequestBodyTaxIdData'Type'
-> Text -> PostCustomersRequestBodyTaxIdData'
mkPostCustomersRequestBodyTaxIdData' PostCustomersRequestBodyTaxIdData'Type'
postCustomersRequestBodyTaxIdData'Type Text
postCustomersRequestBodyTaxIdData'Value =
  PostCustomersRequestBodyTaxIdData' :: PostCustomersRequestBodyTaxIdData'Type'
-> Text -> PostCustomersRequestBodyTaxIdData'
PostCustomersRequestBodyTaxIdData'
    { postCustomersRequestBodyTaxIdData'Type :: PostCustomersRequestBodyTaxIdData'Type'
postCustomersRequestBodyTaxIdData'Type = PostCustomersRequestBodyTaxIdData'Type'
postCustomersRequestBodyTaxIdData'Type,
      postCustomersRequestBodyTaxIdData'Value :: Text
postCustomersRequestBodyTaxIdData'Value = Text
postCustomersRequestBodyTaxIdData'Value
    }

-- | Defines the enum schema located at @paths.\/v1\/customers.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.tax_id_data.items.properties.type@ in the specification.
data PostCustomersRequestBodyTaxIdData'Type'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostCustomersRequestBodyTaxIdData'Type'Other Data.Aeson.Types.Internal.Value
  | -- | This constructor can be used to send values to the server which are not present in the specification yet.
    PostCustomersRequestBodyTaxIdData'Type'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"ae_trn"@
    PostCustomersRequestBodyTaxIdData'Type'EnumAeTrn
  | -- | Represents the JSON value @"au_abn"@
    PostCustomersRequestBodyTaxIdData'Type'EnumAuAbn
  | -- | Represents the JSON value @"br_cnpj"@
    PostCustomersRequestBodyTaxIdData'Type'EnumBrCnpj
  | -- | Represents the JSON value @"br_cpf"@
    PostCustomersRequestBodyTaxIdData'Type'EnumBrCpf
  | -- | Represents the JSON value @"ca_bn"@
    PostCustomersRequestBodyTaxIdData'Type'EnumCaBn
  | -- | Represents the JSON value @"ca_gst_hst"@
    PostCustomersRequestBodyTaxIdData'Type'EnumCaGstHst
  | -- | Represents the JSON value @"ca_pst_bc"@
    PostCustomersRequestBodyTaxIdData'Type'EnumCaPstBc
  | -- | Represents the JSON value @"ca_pst_mb"@
    PostCustomersRequestBodyTaxIdData'Type'EnumCaPstMb
  | -- | Represents the JSON value @"ca_pst_sk"@
    PostCustomersRequestBodyTaxIdData'Type'EnumCaPstSk
  | -- | Represents the JSON value @"ca_qst"@
    PostCustomersRequestBodyTaxIdData'Type'EnumCaQst
  | -- | Represents the JSON value @"ch_vat"@
    PostCustomersRequestBodyTaxIdData'Type'EnumChVat
  | -- | Represents the JSON value @"cl_tin"@
    PostCustomersRequestBodyTaxIdData'Type'EnumClTin
  | -- | Represents the JSON value @"es_cif"@
    PostCustomersRequestBodyTaxIdData'Type'EnumEsCif
  | -- | Represents the JSON value @"eu_vat"@
    PostCustomersRequestBodyTaxIdData'Type'EnumEuVat
  | -- | Represents the JSON value @"gb_vat"@
    PostCustomersRequestBodyTaxIdData'Type'EnumGbVat
  | -- | Represents the JSON value @"hk_br"@
    PostCustomersRequestBodyTaxIdData'Type'EnumHkBr
  | -- | Represents the JSON value @"id_npwp"@
    PostCustomersRequestBodyTaxIdData'Type'EnumIdNpwp
  | -- | Represents the JSON value @"il_vat"@
    PostCustomersRequestBodyTaxIdData'Type'EnumIlVat
  | -- | Represents the JSON value @"in_gst"@
    PostCustomersRequestBodyTaxIdData'Type'EnumInGst
  | -- | Represents the JSON value @"jp_cn"@
    PostCustomersRequestBodyTaxIdData'Type'EnumJpCn
  | -- | Represents the JSON value @"jp_rn"@
    PostCustomersRequestBodyTaxIdData'Type'EnumJpRn
  | -- | Represents the JSON value @"kr_brn"@
    PostCustomersRequestBodyTaxIdData'Type'EnumKrBrn
  | -- | Represents the JSON value @"li_uid"@
    PostCustomersRequestBodyTaxIdData'Type'EnumLiUid
  | -- | Represents the JSON value @"mx_rfc"@
    PostCustomersRequestBodyTaxIdData'Type'EnumMxRfc
  | -- | Represents the JSON value @"my_frp"@
    PostCustomersRequestBodyTaxIdData'Type'EnumMyFrp
  | -- | Represents the JSON value @"my_itn"@
    PostCustomersRequestBodyTaxIdData'Type'EnumMyItn
  | -- | Represents the JSON value @"my_sst"@
    PostCustomersRequestBodyTaxIdData'Type'EnumMySst
  | -- | Represents the JSON value @"no_vat"@
    PostCustomersRequestBodyTaxIdData'Type'EnumNoVat
  | -- | Represents the JSON value @"nz_gst"@
    PostCustomersRequestBodyTaxIdData'Type'EnumNzGst
  | -- | Represents the JSON value @"ru_inn"@
    PostCustomersRequestBodyTaxIdData'Type'EnumRuInn
  | -- | Represents the JSON value @"ru_kpp"@
    PostCustomersRequestBodyTaxIdData'Type'EnumRuKpp
  | -- | Represents the JSON value @"sa_vat"@
    PostCustomersRequestBodyTaxIdData'Type'EnumSaVat
  | -- | Represents the JSON value @"sg_gst"@
    PostCustomersRequestBodyTaxIdData'Type'EnumSgGst
  | -- | Represents the JSON value @"sg_uen"@
    PostCustomersRequestBodyTaxIdData'Type'EnumSgUen
  | -- | Represents the JSON value @"th_vat"@
    PostCustomersRequestBodyTaxIdData'Type'EnumThVat
  | -- | Represents the JSON value @"tw_vat"@
    PostCustomersRequestBodyTaxIdData'Type'EnumTwVat
  | -- | Represents the JSON value @"us_ein"@
    PostCustomersRequestBodyTaxIdData'Type'EnumUsEin
  | -- | Represents the JSON value @"za_vat"@
    PostCustomersRequestBodyTaxIdData'Type'EnumZaVat
  deriving (Int -> PostCustomersRequestBodyTaxIdData'Type' -> ShowS
[PostCustomersRequestBodyTaxIdData'Type'] -> ShowS
PostCustomersRequestBodyTaxIdData'Type' -> String
(Int -> PostCustomersRequestBodyTaxIdData'Type' -> ShowS)
-> (PostCustomersRequestBodyTaxIdData'Type' -> String)
-> ([PostCustomersRequestBodyTaxIdData'Type'] -> ShowS)
-> Show PostCustomersRequestBodyTaxIdData'Type'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostCustomersRequestBodyTaxIdData'Type'] -> ShowS
$cshowList :: [PostCustomersRequestBodyTaxIdData'Type'] -> ShowS
show :: PostCustomersRequestBodyTaxIdData'Type' -> String
$cshow :: PostCustomersRequestBodyTaxIdData'Type' -> String
showsPrec :: Int -> PostCustomersRequestBodyTaxIdData'Type' -> ShowS
$cshowsPrec :: Int -> PostCustomersRequestBodyTaxIdData'Type' -> ShowS
GHC.Show.Show, PostCustomersRequestBodyTaxIdData'Type'
-> PostCustomersRequestBodyTaxIdData'Type' -> Bool
(PostCustomersRequestBodyTaxIdData'Type'
 -> PostCustomersRequestBodyTaxIdData'Type' -> Bool)
-> (PostCustomersRequestBodyTaxIdData'Type'
    -> PostCustomersRequestBodyTaxIdData'Type' -> Bool)
-> Eq PostCustomersRequestBodyTaxIdData'Type'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostCustomersRequestBodyTaxIdData'Type'
-> PostCustomersRequestBodyTaxIdData'Type' -> Bool
$c/= :: PostCustomersRequestBodyTaxIdData'Type'
-> PostCustomersRequestBodyTaxIdData'Type' -> Bool
== :: PostCustomersRequestBodyTaxIdData'Type'
-> PostCustomersRequestBodyTaxIdData'Type' -> Bool
$c== :: PostCustomersRequestBodyTaxIdData'Type'
-> PostCustomersRequestBodyTaxIdData'Type' -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostCustomersRequestBodyTaxIdData'Type' where
  toJSON :: PostCustomersRequestBodyTaxIdData'Type' -> Value
toJSON (PostCustomersRequestBodyTaxIdData'Type'Other Value
val) = Value
val
  toJSON (PostCustomersRequestBodyTaxIdData'Type'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumAeTrn) = Value
"ae_trn"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumAuAbn) = Value
"au_abn"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumBrCnpj) = Value
"br_cnpj"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumBrCpf) = Value
"br_cpf"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumCaBn) = Value
"ca_bn"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumCaGstHst) = Value
"ca_gst_hst"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumCaPstBc) = Value
"ca_pst_bc"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumCaPstMb) = Value
"ca_pst_mb"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumCaPstSk) = Value
"ca_pst_sk"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumCaQst) = Value
"ca_qst"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumChVat) = Value
"ch_vat"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumClTin) = Value
"cl_tin"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumEsCif) = Value
"es_cif"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumEuVat) = Value
"eu_vat"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumGbVat) = Value
"gb_vat"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumHkBr) = Value
"hk_br"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumIdNpwp) = Value
"id_npwp"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumIlVat) = Value
"il_vat"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumInGst) = Value
"in_gst"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumJpCn) = Value
"jp_cn"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumJpRn) = Value
"jp_rn"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumKrBrn) = Value
"kr_brn"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumLiUid) = Value
"li_uid"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumMxRfc) = Value
"mx_rfc"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumMyFrp) = Value
"my_frp"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumMyItn) = Value
"my_itn"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumMySst) = Value
"my_sst"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumNoVat) = Value
"no_vat"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumNzGst) = Value
"nz_gst"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumRuInn) = Value
"ru_inn"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumRuKpp) = Value
"ru_kpp"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumSaVat) = Value
"sa_vat"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumSgGst) = Value
"sg_gst"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumSgUen) = Value
"sg_uen"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumThVat) = Value
"th_vat"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumTwVat) = Value
"tw_vat"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumUsEin) = Value
"us_ein"
  toJSON (PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumZaVat) = Value
"za_vat"

instance Data.Aeson.Types.FromJSON.FromJSON PostCustomersRequestBodyTaxIdData'Type' where
  parseJSON :: Value -> Parser PostCustomersRequestBodyTaxIdData'Type'
parseJSON Value
val =
    PostCustomersRequestBodyTaxIdData'Type'
-> Parser PostCustomersRequestBodyTaxIdData'Type'
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure
      ( if
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ae_trn" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumAeTrn
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"au_abn" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumAuAbn
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"br_cnpj" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumBrCnpj
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"br_cpf" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumBrCpf
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ca_bn" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumCaBn
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ca_gst_hst" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumCaGstHst
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ca_pst_bc" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumCaPstBc
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ca_pst_mb" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumCaPstMb
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ca_pst_sk" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumCaPstSk
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ca_qst" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumCaQst
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ch_vat" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumChVat
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"cl_tin" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumClTin
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"es_cif" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumEsCif
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"eu_vat" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumEuVat
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"gb_vat" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumGbVat
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"hk_br" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumHkBr
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"id_npwp" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumIdNpwp
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"il_vat" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumIlVat
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"in_gst" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumInGst
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"jp_cn" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumJpCn
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"jp_rn" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumJpRn
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"kr_brn" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumKrBrn
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"li_uid" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumLiUid
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"mx_rfc" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumMxRfc
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"my_frp" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumMyFrp
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"my_itn" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumMyItn
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"my_sst" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumMySst
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"no_vat" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumNoVat
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"nz_gst" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumNzGst
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ru_inn" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumRuInn
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ru_kpp" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumRuKpp
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"sa_vat" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumSaVat
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"sg_gst" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumSgGst
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"sg_uen" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumSgUen
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"th_vat" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumThVat
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"tw_vat" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumTwVat
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"us_ein" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumUsEin
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"za_vat" -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'EnumZaVat
            | Bool
GHC.Base.otherwise -> Value -> PostCustomersRequestBodyTaxIdData'Type'
PostCustomersRequestBodyTaxIdData'Type'Other Value
val
      )

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