{-# 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 postPrices
module StripeAPI.Operations.PostPrices 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/prices
--
-- \<p>Creates a new price for an existing product. The price can be recurring or one-time.\<\/p>
postPrices ::
  forall m.
  StripeAPI.Common.MonadHTTP m =>
  -- | The request body to send
  PostPricesRequestBody ->
  -- | Monadic computation which returns the result of the operation
  StripeAPI.Common.StripeT m (Network.HTTP.Client.Types.Response PostPricesResponse)
postPrices :: PostPricesRequestBody -> StripeT m (Response PostPricesResponse)
postPrices PostPricesRequestBody
body =
  (Response ByteString -> Response PostPricesResponse)
-> StripeT m (Response ByteString)
-> StripeT m (Response PostPricesResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
    ( \Response ByteString
response_0 ->
        (ByteString -> PostPricesResponse)
-> Response ByteString -> Response PostPricesResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
          ( (String -> PostPricesResponse)
-> (PostPricesResponse -> PostPricesResponse)
-> Either String PostPricesResponse
-> PostPricesResponse
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Data.Either.either String -> PostPricesResponse
PostPricesResponseError PostPricesResponse -> PostPricesResponse
forall a. a -> a
GHC.Base.id
              (Either String PostPricesResponse -> PostPricesResponse)
-> (ByteString -> Either String PostPricesResponse)
-> ByteString
-> PostPricesResponse
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) ->
                                   Price -> PostPricesResponse
PostPricesResponse200
                                     (Price -> PostPricesResponse)
-> Either String Price -> Either String PostPricesResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> ( ByteString -> Either String Price
forall a. FromJSON a => ByteString -> Either String a
Data.Aeson.eitherDecodeStrict ByteString
body ::
                                                          Data.Either.Either
                                                            GHC.Base.String
                                                            Price
                                                      )
                                 | 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 -> PostPricesResponse
PostPricesResponseDefault
                                     (Error -> PostPricesResponse)
-> Either String Error -> Either String PostPricesResponse
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 PostPricesResponse
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 PostPricesRequestBody
-> RequestBodyEncoding
-> StripeT m (Response ByteString)
forall (m :: * -> *) body.
(MonadHTTP m, ToJSON body) =>
Text
-> Text
-> [QueryParameter]
-> Maybe body
-> RequestBodyEncoding
-> StripeT m (Response ByteString)
StripeAPI.Common.doBodyCallWithConfigurationM (Text -> Text
Data.Text.toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
GHC.Base.$ String -> Text
Data.Text.pack String
"POST") (String -> Text
Data.Text.pack String
"/v1/prices") [QueryParameter]
forall a. Monoid a => a
GHC.Base.mempty (PostPricesRequestBody -> Maybe PostPricesRequestBody
forall a. a -> Maybe a
GHC.Maybe.Just PostPricesRequestBody
body) RequestBodyEncoding
StripeAPI.Common.RequestBodyEncodingFormData)

-- | Defines the object schema located at @paths.\/v1\/prices.POST.requestBody.content.application\/x-www-form-urlencoded.schema@ in the specification.
data PostPricesRequestBody = PostPricesRequestBody
  { -- | active: Whether the price can be used for new purchases. Defaults to \`true\`.
    PostPricesRequestBody -> Maybe Bool
postPricesRequestBodyActive :: (GHC.Maybe.Maybe GHC.Types.Bool),
    -- | billing_scheme: Describes how to compute the price per period. Either \`per_unit\` or \`tiered\`. \`per_unit\` indicates that the fixed amount (specified in \`unit_amount\` or \`unit_amount_decimal\`) will be charged per unit in \`quantity\` (for prices with \`usage_type=licensed\`), or per unit of total usage (for prices with \`usage_type=metered\`). \`tiered\` indicates that the unit pricing will be computed using a tiering strategy as defined using the \`tiers\` and \`tiers_mode\` attributes.
    PostPricesRequestBody -> Maybe PostPricesRequestBodyBillingScheme'
postPricesRequestBodyBillingScheme :: (GHC.Maybe.Maybe PostPricesRequestBodyBillingScheme'),
    -- | currency: Three-letter [ISO currency code](https:\/\/www.iso.org\/iso-4217-currency-codes.html), in lowercase. Must be a [supported currency](https:\/\/stripe.com\/docs\/currencies).
    PostPricesRequestBody -> Text
postPricesRequestBodyCurrency :: Data.Text.Internal.Text,
    -- | expand: Specifies which fields in the response should be expanded.
    PostPricesRequestBody -> Maybe [Text]
postPricesRequestBodyExpand :: (GHC.Maybe.Maybe ([Data.Text.Internal.Text])),
    -- | lookup_key: A lookup key used to retrieve prices dynamically from a static string.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPricesRequestBody -> Maybe Text
postPricesRequestBodyLookupKey :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | metadata: Set of [key-value pairs](https:\/\/stripe.com\/docs\/api\/metadata) that you can attach to an object. This can be useful for storing additional information about the object in a structured format. Individual keys can be unset by posting an empty value to them. All keys can be unset by posting an empty value to \`metadata\`.
    PostPricesRequestBody -> Maybe Object
postPricesRequestBodyMetadata :: (GHC.Maybe.Maybe Data.Aeson.Types.Internal.Object),
    -- | nickname: A brief description of the price, hidden from customers.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPricesRequestBody -> Maybe Text
postPricesRequestBodyNickname :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | product: The ID of the product that this price will belong to.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPricesRequestBody -> Maybe Text
postPricesRequestBodyProduct :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | product_data: These fields can be used to create a new product that this price will belong to.
    PostPricesRequestBody -> Maybe PostPricesRequestBodyProductData'
postPricesRequestBodyProductData :: (GHC.Maybe.Maybe PostPricesRequestBodyProductData'),
    -- | recurring: The recurring components of a price such as \`interval\` and \`usage_type\`.
    PostPricesRequestBody -> Maybe PostPricesRequestBodyRecurring'
postPricesRequestBodyRecurring :: (GHC.Maybe.Maybe PostPricesRequestBodyRecurring'),
    -- | tax_behavior: Specifies whether the price is considered inclusive of taxes or exclusive of taxes. One of \`inclusive\`, \`exclusive\`, or \`unspecified\`. Once specified as either \`inclusive\` or \`exclusive\`, it cannot be changed.
    PostPricesRequestBody -> Maybe PostPricesRequestBodyTaxBehavior'
postPricesRequestBodyTaxBehavior :: (GHC.Maybe.Maybe PostPricesRequestBodyTaxBehavior'),
    -- | tiers: Each element represents a pricing tier. This parameter requires \`billing_scheme\` to be set to \`tiered\`. See also the documentation for \`billing_scheme\`.
    PostPricesRequestBody -> Maybe [PostPricesRequestBodyTiers']
postPricesRequestBodyTiers :: (GHC.Maybe.Maybe ([PostPricesRequestBodyTiers'])),
    -- | tiers_mode: Defines if the tiering price should be \`graduated\` or \`volume\` based. In \`volume\`-based tiering, the maximum quantity within a period determines the per unit price, in \`graduated\` tiering pricing can successively change as the quantity grows.
    PostPricesRequestBody -> Maybe PostPricesRequestBodyTiersMode'
postPricesRequestBodyTiersMode :: (GHC.Maybe.Maybe PostPricesRequestBodyTiersMode'),
    -- | transfer_lookup_key: If set to true, will atomically remove the lookup key from the existing price, and assign it to this price.
    PostPricesRequestBody -> Maybe Bool
postPricesRequestBodyTransferLookupKey :: (GHC.Maybe.Maybe GHC.Types.Bool),
    -- | transform_quantity: Apply a transformation to the reported usage or set quantity before computing the billed price. Cannot be combined with \`tiers\`.
    PostPricesRequestBody
-> Maybe PostPricesRequestBodyTransformQuantity'
postPricesRequestBodyTransformQuantity :: (GHC.Maybe.Maybe PostPricesRequestBodyTransformQuantity'),
    -- | unit_amount: A positive integer in %s (or 0 for a free price) representing how much to charge.
    PostPricesRequestBody -> Maybe Int
postPricesRequestBodyUnitAmount :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | unit_amount_decimal: Same as \`unit_amount\`, but accepts a decimal value in %s with at most 12 decimal places. Only one of \`unit_amount\` and \`unit_amount_decimal\` can be set.
    PostPricesRequestBody -> Maybe Text
postPricesRequestBodyUnitAmountDecimal :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int -> PostPricesRequestBody -> ShowS
[PostPricesRequestBody] -> ShowS
PostPricesRequestBody -> String
(Int -> PostPricesRequestBody -> ShowS)
-> (PostPricesRequestBody -> String)
-> ([PostPricesRequestBody] -> ShowS)
-> Show PostPricesRequestBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPricesRequestBody] -> ShowS
$cshowList :: [PostPricesRequestBody] -> ShowS
show :: PostPricesRequestBody -> String
$cshow :: PostPricesRequestBody -> String
showsPrec :: Int -> PostPricesRequestBody -> ShowS
$cshowsPrec :: Int -> PostPricesRequestBody -> ShowS
GHC.Show.Show,
      PostPricesRequestBody -> PostPricesRequestBody -> Bool
(PostPricesRequestBody -> PostPricesRequestBody -> Bool)
-> (PostPricesRequestBody -> PostPricesRequestBody -> Bool)
-> Eq PostPricesRequestBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPricesRequestBody -> PostPricesRequestBody -> Bool
$c/= :: PostPricesRequestBody -> PostPricesRequestBody -> Bool
== :: PostPricesRequestBody -> PostPricesRequestBody -> Bool
$c== :: PostPricesRequestBody -> PostPricesRequestBody -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPricesRequestBody where
  toJSON :: PostPricesRequestBody -> Value
toJSON PostPricesRequestBody
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"active" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe Bool
postPricesRequestBodyActive PostPricesRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"billing_scheme" Text -> Maybe PostPricesRequestBodyBillingScheme' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe PostPricesRequestBodyBillingScheme'
postPricesRequestBodyBillingScheme PostPricesRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"currency" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Text
postPricesRequestBodyCurrency PostPricesRequestBody
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..= PostPricesRequestBody -> Maybe [Text]
postPricesRequestBodyExpand PostPricesRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"lookup_key" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe Text
postPricesRequestBodyLookupKey PostPricesRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"metadata" Text -> Maybe Object -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe Object
postPricesRequestBodyMetadata PostPricesRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"nickname" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe Text
postPricesRequestBodyNickname PostPricesRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"product" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe Text
postPricesRequestBodyProduct PostPricesRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"product_data" Text -> Maybe PostPricesRequestBodyProductData' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe PostPricesRequestBodyProductData'
postPricesRequestBodyProductData PostPricesRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"recurring" Text -> Maybe PostPricesRequestBodyRecurring' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe PostPricesRequestBodyRecurring'
postPricesRequestBodyRecurring PostPricesRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"tax_behavior" Text -> Maybe PostPricesRequestBodyTaxBehavior' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe PostPricesRequestBodyTaxBehavior'
postPricesRequestBodyTaxBehavior PostPricesRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"tiers" Text -> Maybe [PostPricesRequestBodyTiers'] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe [PostPricesRequestBodyTiers']
postPricesRequestBodyTiers PostPricesRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"tiers_mode" Text -> Maybe PostPricesRequestBodyTiersMode' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe PostPricesRequestBodyTiersMode'
postPricesRequestBodyTiersMode PostPricesRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"transfer_lookup_key" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe Bool
postPricesRequestBodyTransferLookupKey PostPricesRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"transform_quantity" Text -> Maybe PostPricesRequestBodyTransformQuantity' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody
-> Maybe PostPricesRequestBodyTransformQuantity'
postPricesRequestBodyTransformQuantity PostPricesRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"unit_amount" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe Int
postPricesRequestBodyUnitAmount PostPricesRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"unit_amount_decimal" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe Text
postPricesRequestBodyUnitAmountDecimal PostPricesRequestBody
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPricesRequestBody -> Encoding
toEncoding PostPricesRequestBody
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"active" Text -> Maybe Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe Bool
postPricesRequestBodyActive PostPricesRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"billing_scheme" Text -> Maybe PostPricesRequestBodyBillingScheme' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe PostPricesRequestBodyBillingScheme'
postPricesRequestBodyBillingScheme PostPricesRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"currency" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Text
postPricesRequestBodyCurrency PostPricesRequestBody
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..= PostPricesRequestBody -> Maybe [Text]
postPricesRequestBodyExpand PostPricesRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"lookup_key" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe Text
postPricesRequestBodyLookupKey PostPricesRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"metadata" Text -> Maybe Object -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe Object
postPricesRequestBodyMetadata PostPricesRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"nickname" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe Text
postPricesRequestBodyNickname PostPricesRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"product" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe Text
postPricesRequestBodyProduct PostPricesRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"product_data" Text -> Maybe PostPricesRequestBodyProductData' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe PostPricesRequestBodyProductData'
postPricesRequestBodyProductData PostPricesRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"recurring" Text -> Maybe PostPricesRequestBodyRecurring' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe PostPricesRequestBodyRecurring'
postPricesRequestBodyRecurring PostPricesRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"tax_behavior" Text -> Maybe PostPricesRequestBodyTaxBehavior' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe PostPricesRequestBodyTaxBehavior'
postPricesRequestBodyTaxBehavior PostPricesRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"tiers" Text -> Maybe [PostPricesRequestBodyTiers'] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe [PostPricesRequestBodyTiers']
postPricesRequestBodyTiers PostPricesRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"tiers_mode" Text -> Maybe PostPricesRequestBodyTiersMode' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe PostPricesRequestBodyTiersMode'
postPricesRequestBodyTiersMode PostPricesRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"transfer_lookup_key" Text -> Maybe Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe Bool
postPricesRequestBodyTransferLookupKey PostPricesRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"transform_quantity" Text -> Maybe PostPricesRequestBodyTransformQuantity' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody
-> Maybe PostPricesRequestBodyTransformQuantity'
postPricesRequestBodyTransformQuantity PostPricesRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"unit_amount" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe Int
postPricesRequestBodyUnitAmount PostPricesRequestBody
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"unit_amount_decimal" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBody -> Maybe Text
postPricesRequestBodyUnitAmountDecimal PostPricesRequestBody
obj)))))))))))))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostPricesRequestBody where
  parseJSON :: Value -> Parser PostPricesRequestBody
parseJSON = String
-> (Object -> Parser PostPricesRequestBody)
-> Value
-> Parser PostPricesRequestBody
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPricesRequestBody" (\Object
obj -> (((((((((((((((((Maybe Bool
 -> Maybe PostPricesRequestBodyBillingScheme'
 -> Text
 -> Maybe [Text]
 -> Maybe Text
 -> Maybe Object
 -> Maybe Text
 -> Maybe Text
 -> Maybe PostPricesRequestBodyProductData'
 -> Maybe PostPricesRequestBodyRecurring'
 -> Maybe PostPricesRequestBodyTaxBehavior'
 -> Maybe [PostPricesRequestBodyTiers']
 -> Maybe PostPricesRequestBodyTiersMode'
 -> Maybe Bool
 -> Maybe PostPricesRequestBodyTransformQuantity'
 -> Maybe Int
 -> Maybe Text
 -> PostPricesRequestBody)
-> Parser
     (Maybe Bool
      -> Maybe PostPricesRequestBodyBillingScheme'
      -> Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Object
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostPricesRequestBodyProductData'
      -> Maybe PostPricesRequestBodyRecurring'
      -> Maybe PostPricesRequestBodyTaxBehavior'
      -> Maybe [PostPricesRequestBodyTiers']
      -> Maybe PostPricesRequestBodyTiersMode'
      -> Maybe Bool
      -> Maybe PostPricesRequestBodyTransformQuantity'
      -> Maybe Int
      -> Maybe Text
      -> PostPricesRequestBody)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Bool
-> Maybe PostPricesRequestBodyBillingScheme'
-> Text
-> Maybe [Text]
-> Maybe Text
-> Maybe Object
-> Maybe Text
-> Maybe Text
-> Maybe PostPricesRequestBodyProductData'
-> Maybe PostPricesRequestBodyRecurring'
-> Maybe PostPricesRequestBodyTaxBehavior'
-> Maybe [PostPricesRequestBodyTiers']
-> Maybe PostPricesRequestBodyTiersMode'
-> Maybe Bool
-> Maybe PostPricesRequestBodyTransformQuantity'
-> Maybe Int
-> Maybe Text
-> PostPricesRequestBody
PostPricesRequestBody Parser
  (Maybe Bool
   -> Maybe PostPricesRequestBodyBillingScheme'
   -> Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Object
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostPricesRequestBodyProductData'
   -> Maybe PostPricesRequestBodyRecurring'
   -> Maybe PostPricesRequestBodyTaxBehavior'
   -> Maybe [PostPricesRequestBodyTiers']
   -> Maybe PostPricesRequestBodyTiersMode'
   -> Maybe Bool
   -> Maybe PostPricesRequestBodyTransformQuantity'
   -> Maybe Int
   -> Maybe Text
   -> PostPricesRequestBody)
-> Parser (Maybe Bool)
-> Parser
     (Maybe PostPricesRequestBodyBillingScheme'
      -> Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Object
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostPricesRequestBodyProductData'
      -> Maybe PostPricesRequestBodyRecurring'
      -> Maybe PostPricesRequestBodyTaxBehavior'
      -> Maybe [PostPricesRequestBodyTiers']
      -> Maybe PostPricesRequestBodyTiersMode'
      -> Maybe Bool
      -> Maybe PostPricesRequestBodyTransformQuantity'
      -> Maybe Int
      -> Maybe Text
      -> PostPricesRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"active")) Parser
  (Maybe PostPricesRequestBodyBillingScheme'
   -> Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Object
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostPricesRequestBodyProductData'
   -> Maybe PostPricesRequestBodyRecurring'
   -> Maybe PostPricesRequestBodyTaxBehavior'
   -> Maybe [PostPricesRequestBodyTiers']
   -> Maybe PostPricesRequestBodyTiersMode'
   -> Maybe Bool
   -> Maybe PostPricesRequestBodyTransformQuantity'
   -> Maybe Int
   -> Maybe Text
   -> PostPricesRequestBody)
-> Parser (Maybe PostPricesRequestBodyBillingScheme')
-> Parser
     (Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Object
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostPricesRequestBodyProductData'
      -> Maybe PostPricesRequestBodyRecurring'
      -> Maybe PostPricesRequestBodyTaxBehavior'
      -> Maybe [PostPricesRequestBodyTiers']
      -> Maybe PostPricesRequestBodyTiersMode'
      -> Maybe Bool
      -> Maybe PostPricesRequestBodyTransformQuantity'
      -> Maybe Int
      -> Maybe Text
      -> PostPricesRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe PostPricesRequestBodyBillingScheme')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"billing_scheme")) Parser
  (Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Object
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostPricesRequestBodyProductData'
   -> Maybe PostPricesRequestBodyRecurring'
   -> Maybe PostPricesRequestBodyTaxBehavior'
   -> Maybe [PostPricesRequestBodyTiers']
   -> Maybe PostPricesRequestBodyTiersMode'
   -> Maybe Bool
   -> Maybe PostPricesRequestBodyTransformQuantity'
   -> Maybe Int
   -> Maybe Text
   -> PostPricesRequestBody)
-> Parser Text
-> Parser
     (Maybe [Text]
      -> Maybe Text
      -> Maybe Object
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostPricesRequestBodyProductData'
      -> Maybe PostPricesRequestBodyRecurring'
      -> Maybe PostPricesRequestBodyTaxBehavior'
      -> Maybe [PostPricesRequestBodyTiers']
      -> Maybe PostPricesRequestBodyTiersMode'
      -> Maybe Bool
      -> Maybe PostPricesRequestBodyTransformQuantity'
      -> Maybe Int
      -> Maybe Text
      -> PostPricesRequestBody)
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
"currency")) Parser
  (Maybe [Text]
   -> Maybe Text
   -> Maybe Object
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostPricesRequestBodyProductData'
   -> Maybe PostPricesRequestBodyRecurring'
   -> Maybe PostPricesRequestBodyTaxBehavior'
   -> Maybe [PostPricesRequestBodyTiers']
   -> Maybe PostPricesRequestBodyTiersMode'
   -> Maybe Bool
   -> Maybe PostPricesRequestBodyTransformQuantity'
   -> Maybe Int
   -> Maybe Text
   -> PostPricesRequestBody)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Text
      -> Maybe Object
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostPricesRequestBodyProductData'
      -> Maybe PostPricesRequestBodyRecurring'
      -> Maybe PostPricesRequestBodyTaxBehavior'
      -> Maybe [PostPricesRequestBodyTiers']
      -> Maybe PostPricesRequestBodyTiersMode'
      -> Maybe Bool
      -> Maybe PostPricesRequestBodyTransformQuantity'
      -> Maybe Int
      -> Maybe Text
      -> PostPricesRequestBody)
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 Object
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostPricesRequestBodyProductData'
   -> Maybe PostPricesRequestBodyRecurring'
   -> Maybe PostPricesRequestBodyTaxBehavior'
   -> Maybe [PostPricesRequestBodyTiers']
   -> Maybe PostPricesRequestBodyTiersMode'
   -> Maybe Bool
   -> Maybe PostPricesRequestBodyTransformQuantity'
   -> Maybe Int
   -> Maybe Text
   -> PostPricesRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Object
      -> Maybe Text
      -> Maybe Text
      -> Maybe PostPricesRequestBodyProductData'
      -> Maybe PostPricesRequestBodyRecurring'
      -> Maybe PostPricesRequestBodyTaxBehavior'
      -> Maybe [PostPricesRequestBodyTiers']
      -> Maybe PostPricesRequestBodyTiersMode'
      -> Maybe Bool
      -> Maybe PostPricesRequestBodyTransformQuantity'
      -> Maybe Int
      -> Maybe Text
      -> PostPricesRequestBody)
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
"lookup_key")) Parser
  (Maybe Object
   -> Maybe Text
   -> Maybe Text
   -> Maybe PostPricesRequestBodyProductData'
   -> Maybe PostPricesRequestBodyRecurring'
   -> Maybe PostPricesRequestBodyTaxBehavior'
   -> Maybe [PostPricesRequestBodyTiers']
   -> Maybe PostPricesRequestBodyTiersMode'
   -> Maybe Bool
   -> Maybe PostPricesRequestBodyTransformQuantity'
   -> Maybe Int
   -> Maybe Text
   -> PostPricesRequestBody)
-> Parser (Maybe Object)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe PostPricesRequestBodyProductData'
      -> Maybe PostPricesRequestBodyRecurring'
      -> Maybe PostPricesRequestBodyTaxBehavior'
      -> Maybe [PostPricesRequestBodyTiers']
      -> Maybe PostPricesRequestBodyTiersMode'
      -> Maybe Bool
      -> Maybe PostPricesRequestBodyTransformQuantity'
      -> Maybe Int
      -> Maybe Text
      -> PostPricesRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"metadata")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe PostPricesRequestBodyProductData'
   -> Maybe PostPricesRequestBodyRecurring'
   -> Maybe PostPricesRequestBodyTaxBehavior'
   -> Maybe [PostPricesRequestBodyTiers']
   -> Maybe PostPricesRequestBodyTiersMode'
   -> Maybe Bool
   -> Maybe PostPricesRequestBodyTransformQuantity'
   -> Maybe Int
   -> Maybe Text
   -> PostPricesRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe PostPricesRequestBodyProductData'
      -> Maybe PostPricesRequestBodyRecurring'
      -> Maybe PostPricesRequestBodyTaxBehavior'
      -> Maybe [PostPricesRequestBodyTiers']
      -> Maybe PostPricesRequestBodyTiersMode'
      -> Maybe Bool
      -> Maybe PostPricesRequestBodyTransformQuantity'
      -> Maybe Int
      -> Maybe Text
      -> PostPricesRequestBody)
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
"nickname")) Parser
  (Maybe Text
   -> Maybe PostPricesRequestBodyProductData'
   -> Maybe PostPricesRequestBodyRecurring'
   -> Maybe PostPricesRequestBodyTaxBehavior'
   -> Maybe [PostPricesRequestBodyTiers']
   -> Maybe PostPricesRequestBodyTiersMode'
   -> Maybe Bool
   -> Maybe PostPricesRequestBodyTransformQuantity'
   -> Maybe Int
   -> Maybe Text
   -> PostPricesRequestBody)
-> Parser (Maybe Text)
-> Parser
     (Maybe PostPricesRequestBodyProductData'
      -> Maybe PostPricesRequestBodyRecurring'
      -> Maybe PostPricesRequestBodyTaxBehavior'
      -> Maybe [PostPricesRequestBodyTiers']
      -> Maybe PostPricesRequestBodyTiersMode'
      -> Maybe Bool
      -> Maybe PostPricesRequestBodyTransformQuantity'
      -> Maybe Int
      -> Maybe Text
      -> PostPricesRequestBody)
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
"product")) Parser
  (Maybe PostPricesRequestBodyProductData'
   -> Maybe PostPricesRequestBodyRecurring'
   -> Maybe PostPricesRequestBodyTaxBehavior'
   -> Maybe [PostPricesRequestBodyTiers']
   -> Maybe PostPricesRequestBodyTiersMode'
   -> Maybe Bool
   -> Maybe PostPricesRequestBodyTransformQuantity'
   -> Maybe Int
   -> Maybe Text
   -> PostPricesRequestBody)
-> Parser (Maybe PostPricesRequestBodyProductData')
-> Parser
     (Maybe PostPricesRequestBodyRecurring'
      -> Maybe PostPricesRequestBodyTaxBehavior'
      -> Maybe [PostPricesRequestBodyTiers']
      -> Maybe PostPricesRequestBodyTiersMode'
      -> Maybe Bool
      -> Maybe PostPricesRequestBodyTransformQuantity'
      -> Maybe Int
      -> Maybe Text
      -> PostPricesRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe PostPricesRequestBodyProductData')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"product_data")) Parser
  (Maybe PostPricesRequestBodyRecurring'
   -> Maybe PostPricesRequestBodyTaxBehavior'
   -> Maybe [PostPricesRequestBodyTiers']
   -> Maybe PostPricesRequestBodyTiersMode'
   -> Maybe Bool
   -> Maybe PostPricesRequestBodyTransformQuantity'
   -> Maybe Int
   -> Maybe Text
   -> PostPricesRequestBody)
-> Parser (Maybe PostPricesRequestBodyRecurring')
-> Parser
     (Maybe PostPricesRequestBodyTaxBehavior'
      -> Maybe [PostPricesRequestBodyTiers']
      -> Maybe PostPricesRequestBodyTiersMode'
      -> Maybe Bool
      -> Maybe PostPricesRequestBodyTransformQuantity'
      -> Maybe Int
      -> Maybe Text
      -> PostPricesRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe PostPricesRequestBodyRecurring')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"recurring")) Parser
  (Maybe PostPricesRequestBodyTaxBehavior'
   -> Maybe [PostPricesRequestBodyTiers']
   -> Maybe PostPricesRequestBodyTiersMode'
   -> Maybe Bool
   -> Maybe PostPricesRequestBodyTransformQuantity'
   -> Maybe Int
   -> Maybe Text
   -> PostPricesRequestBody)
-> Parser (Maybe PostPricesRequestBodyTaxBehavior')
-> Parser
     (Maybe [PostPricesRequestBodyTiers']
      -> Maybe PostPricesRequestBodyTiersMode'
      -> Maybe Bool
      -> Maybe PostPricesRequestBodyTransformQuantity'
      -> Maybe Int
      -> Maybe Text
      -> PostPricesRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe PostPricesRequestBodyTaxBehavior')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"tax_behavior")) Parser
  (Maybe [PostPricesRequestBodyTiers']
   -> Maybe PostPricesRequestBodyTiersMode'
   -> Maybe Bool
   -> Maybe PostPricesRequestBodyTransformQuantity'
   -> Maybe Int
   -> Maybe Text
   -> PostPricesRequestBody)
-> Parser (Maybe [PostPricesRequestBodyTiers'])
-> Parser
     (Maybe PostPricesRequestBodyTiersMode'
      -> Maybe Bool
      -> Maybe PostPricesRequestBodyTransformQuantity'
      -> Maybe Int
      -> Maybe Text
      -> PostPricesRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe [PostPricesRequestBodyTiers'])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"tiers")) Parser
  (Maybe PostPricesRequestBodyTiersMode'
   -> Maybe Bool
   -> Maybe PostPricesRequestBodyTransformQuantity'
   -> Maybe Int
   -> Maybe Text
   -> PostPricesRequestBody)
-> Parser (Maybe PostPricesRequestBodyTiersMode')
-> Parser
     (Maybe Bool
      -> Maybe PostPricesRequestBodyTransformQuantity'
      -> Maybe Int
      -> Maybe Text
      -> PostPricesRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe PostPricesRequestBodyTiersMode')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"tiers_mode")) Parser
  (Maybe Bool
   -> Maybe PostPricesRequestBodyTransformQuantity'
   -> Maybe Int
   -> Maybe Text
   -> PostPricesRequestBody)
-> Parser (Maybe Bool)
-> Parser
     (Maybe PostPricesRequestBodyTransformQuantity'
      -> Maybe Int -> Maybe Text -> PostPricesRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"transfer_lookup_key")) Parser
  (Maybe PostPricesRequestBodyTransformQuantity'
   -> Maybe Int -> Maybe Text -> PostPricesRequestBody)
-> Parser (Maybe PostPricesRequestBodyTransformQuantity')
-> Parser (Maybe Int -> Maybe Text -> PostPricesRequestBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe PostPricesRequestBodyTransformQuantity')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"transform_quantity")) Parser (Maybe Int -> Maybe Text -> PostPricesRequestBody)
-> Parser (Maybe Int)
-> Parser (Maybe Text -> PostPricesRequestBody)
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
"unit_amount")) Parser (Maybe Text -> PostPricesRequestBody)
-> Parser (Maybe Text) -> Parser PostPricesRequestBody
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
"unit_amount_decimal"))

-- | Create a new 'PostPricesRequestBody' with all required fields.
mkPostPricesRequestBody ::
  -- | 'postPricesRequestBodyCurrency'
  Data.Text.Internal.Text ->
  PostPricesRequestBody
mkPostPricesRequestBody :: Text -> PostPricesRequestBody
mkPostPricesRequestBody Text
postPricesRequestBodyCurrency =
  PostPricesRequestBody :: Maybe Bool
-> Maybe PostPricesRequestBodyBillingScheme'
-> Text
-> Maybe [Text]
-> Maybe Text
-> Maybe Object
-> Maybe Text
-> Maybe Text
-> Maybe PostPricesRequestBodyProductData'
-> Maybe PostPricesRequestBodyRecurring'
-> Maybe PostPricesRequestBodyTaxBehavior'
-> Maybe [PostPricesRequestBodyTiers']
-> Maybe PostPricesRequestBodyTiersMode'
-> Maybe Bool
-> Maybe PostPricesRequestBodyTransformQuantity'
-> Maybe Int
-> Maybe Text
-> PostPricesRequestBody
PostPricesRequestBody
    { postPricesRequestBodyActive :: Maybe Bool
postPricesRequestBodyActive = Maybe Bool
forall a. Maybe a
GHC.Maybe.Nothing,
      postPricesRequestBodyBillingScheme :: Maybe PostPricesRequestBodyBillingScheme'
postPricesRequestBodyBillingScheme = Maybe PostPricesRequestBodyBillingScheme'
forall a. Maybe a
GHC.Maybe.Nothing,
      postPricesRequestBodyCurrency :: Text
postPricesRequestBodyCurrency = Text
postPricesRequestBodyCurrency,
      postPricesRequestBodyExpand :: Maybe [Text]
postPricesRequestBodyExpand = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing,
      postPricesRequestBodyLookupKey :: Maybe Text
postPricesRequestBodyLookupKey = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPricesRequestBodyMetadata :: Maybe Object
postPricesRequestBodyMetadata = Maybe Object
forall a. Maybe a
GHC.Maybe.Nothing,
      postPricesRequestBodyNickname :: Maybe Text
postPricesRequestBodyNickname = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPricesRequestBodyProduct :: Maybe Text
postPricesRequestBodyProduct = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPricesRequestBodyProductData :: Maybe PostPricesRequestBodyProductData'
postPricesRequestBodyProductData = Maybe PostPricesRequestBodyProductData'
forall a. Maybe a
GHC.Maybe.Nothing,
      postPricesRequestBodyRecurring :: Maybe PostPricesRequestBodyRecurring'
postPricesRequestBodyRecurring = Maybe PostPricesRequestBodyRecurring'
forall a. Maybe a
GHC.Maybe.Nothing,
      postPricesRequestBodyTaxBehavior :: Maybe PostPricesRequestBodyTaxBehavior'
postPricesRequestBodyTaxBehavior = Maybe PostPricesRequestBodyTaxBehavior'
forall a. Maybe a
GHC.Maybe.Nothing,
      postPricesRequestBodyTiers :: Maybe [PostPricesRequestBodyTiers']
postPricesRequestBodyTiers = Maybe [PostPricesRequestBodyTiers']
forall a. Maybe a
GHC.Maybe.Nothing,
      postPricesRequestBodyTiersMode :: Maybe PostPricesRequestBodyTiersMode'
postPricesRequestBodyTiersMode = Maybe PostPricesRequestBodyTiersMode'
forall a. Maybe a
GHC.Maybe.Nothing,
      postPricesRequestBodyTransferLookupKey :: Maybe Bool
postPricesRequestBodyTransferLookupKey = Maybe Bool
forall a. Maybe a
GHC.Maybe.Nothing,
      postPricesRequestBodyTransformQuantity :: Maybe PostPricesRequestBodyTransformQuantity'
postPricesRequestBodyTransformQuantity = Maybe PostPricesRequestBodyTransformQuantity'
forall a. Maybe a
GHC.Maybe.Nothing,
      postPricesRequestBodyUnitAmount :: Maybe Int
postPricesRequestBodyUnitAmount = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      postPricesRequestBodyUnitAmountDecimal :: Maybe Text
postPricesRequestBodyUnitAmountDecimal = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the enum schema located at @paths.\/v1\/prices.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.billing_scheme@ in the specification.
--
-- Describes how to compute the price per period. Either \`per_unit\` or \`tiered\`. \`per_unit\` indicates that the fixed amount (specified in \`unit_amount\` or \`unit_amount_decimal\`) will be charged per unit in \`quantity\` (for prices with \`usage_type=licensed\`), or per unit of total usage (for prices with \`usage_type=metered\`). \`tiered\` indicates that the unit pricing will be computed using a tiering strategy as defined using the \`tiers\` and \`tiers_mode\` attributes.
data PostPricesRequestBodyBillingScheme'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostPricesRequestBodyBillingScheme'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.
    PostPricesRequestBodyBillingScheme'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"per_unit"@
    PostPricesRequestBodyBillingScheme'EnumPerUnit
  | -- | Represents the JSON value @"tiered"@
    PostPricesRequestBodyBillingScheme'EnumTiered
  deriving (Int -> PostPricesRequestBodyBillingScheme' -> ShowS
[PostPricesRequestBodyBillingScheme'] -> ShowS
PostPricesRequestBodyBillingScheme' -> String
(Int -> PostPricesRequestBodyBillingScheme' -> ShowS)
-> (PostPricesRequestBodyBillingScheme' -> String)
-> ([PostPricesRequestBodyBillingScheme'] -> ShowS)
-> Show PostPricesRequestBodyBillingScheme'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPricesRequestBodyBillingScheme'] -> ShowS
$cshowList :: [PostPricesRequestBodyBillingScheme'] -> ShowS
show :: PostPricesRequestBodyBillingScheme' -> String
$cshow :: PostPricesRequestBodyBillingScheme' -> String
showsPrec :: Int -> PostPricesRequestBodyBillingScheme' -> ShowS
$cshowsPrec :: Int -> PostPricesRequestBodyBillingScheme' -> ShowS
GHC.Show.Show, PostPricesRequestBodyBillingScheme'
-> PostPricesRequestBodyBillingScheme' -> Bool
(PostPricesRequestBodyBillingScheme'
 -> PostPricesRequestBodyBillingScheme' -> Bool)
-> (PostPricesRequestBodyBillingScheme'
    -> PostPricesRequestBodyBillingScheme' -> Bool)
-> Eq PostPricesRequestBodyBillingScheme'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPricesRequestBodyBillingScheme'
-> PostPricesRequestBodyBillingScheme' -> Bool
$c/= :: PostPricesRequestBodyBillingScheme'
-> PostPricesRequestBodyBillingScheme' -> Bool
== :: PostPricesRequestBodyBillingScheme'
-> PostPricesRequestBodyBillingScheme' -> Bool
$c== :: PostPricesRequestBodyBillingScheme'
-> PostPricesRequestBodyBillingScheme' -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPricesRequestBodyBillingScheme' where
  toJSON :: PostPricesRequestBodyBillingScheme' -> Value
toJSON (PostPricesRequestBodyBillingScheme'Other Value
val) = Value
val
  toJSON (PostPricesRequestBodyBillingScheme'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (PostPricesRequestBodyBillingScheme'
PostPricesRequestBodyBillingScheme'EnumPerUnit) = Value
"per_unit"
  toJSON (PostPricesRequestBodyBillingScheme'
PostPricesRequestBodyBillingScheme'EnumTiered) = Value
"tiered"

instance Data.Aeson.Types.FromJSON.FromJSON PostPricesRequestBodyBillingScheme' where
  parseJSON :: Value -> Parser PostPricesRequestBodyBillingScheme'
parseJSON Value
val =
    PostPricesRequestBodyBillingScheme'
-> Parser PostPricesRequestBodyBillingScheme'
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
"per_unit" -> PostPricesRequestBodyBillingScheme'
PostPricesRequestBodyBillingScheme'EnumPerUnit
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"tiered" -> PostPricesRequestBodyBillingScheme'
PostPricesRequestBodyBillingScheme'EnumTiered
            | Bool
GHC.Base.otherwise -> Value -> PostPricesRequestBodyBillingScheme'
PostPricesRequestBodyBillingScheme'Other Value
val
      )

-- | Defines the object schema located at @paths.\/v1\/prices.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.product_data@ in the specification.
--
-- These fields can be used to create a new product that this price will belong to.
data PostPricesRequestBodyProductData' = PostPricesRequestBodyProductData'
  { -- | active
    PostPricesRequestBodyProductData' -> Maybe Bool
postPricesRequestBodyProductData'Active :: (GHC.Maybe.Maybe GHC.Types.Bool),
    -- | id
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPricesRequestBodyProductData' -> Maybe Text
postPricesRequestBodyProductData'Id :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | metadata
    PostPricesRequestBodyProductData' -> Maybe Object
postPricesRequestBodyProductData'Metadata :: (GHC.Maybe.Maybe Data.Aeson.Types.Internal.Object),
    -- | name
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPricesRequestBodyProductData' -> Text
postPricesRequestBodyProductData'Name :: Data.Text.Internal.Text,
    -- | statement_descriptor
    --
    -- Constraints:
    --
    -- * Maximum length of 22
    PostPricesRequestBodyProductData' -> Maybe Text
postPricesRequestBodyProductData'StatementDescriptor :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | tax_code
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    PostPricesRequestBodyProductData' -> Maybe Text
postPricesRequestBodyProductData'TaxCode :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | unit_label
    --
    -- Constraints:
    --
    -- * Maximum length of 12
    PostPricesRequestBodyProductData' -> Maybe Text
postPricesRequestBodyProductData'UnitLabel :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int -> PostPricesRequestBodyProductData' -> ShowS
[PostPricesRequestBodyProductData'] -> ShowS
PostPricesRequestBodyProductData' -> String
(Int -> PostPricesRequestBodyProductData' -> ShowS)
-> (PostPricesRequestBodyProductData' -> String)
-> ([PostPricesRequestBodyProductData'] -> ShowS)
-> Show PostPricesRequestBodyProductData'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPricesRequestBodyProductData'] -> ShowS
$cshowList :: [PostPricesRequestBodyProductData'] -> ShowS
show :: PostPricesRequestBodyProductData' -> String
$cshow :: PostPricesRequestBodyProductData' -> String
showsPrec :: Int -> PostPricesRequestBodyProductData' -> ShowS
$cshowsPrec :: Int -> PostPricesRequestBodyProductData' -> ShowS
GHC.Show.Show,
      PostPricesRequestBodyProductData'
-> PostPricesRequestBodyProductData' -> Bool
(PostPricesRequestBodyProductData'
 -> PostPricesRequestBodyProductData' -> Bool)
-> (PostPricesRequestBodyProductData'
    -> PostPricesRequestBodyProductData' -> Bool)
-> Eq PostPricesRequestBodyProductData'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPricesRequestBodyProductData'
-> PostPricesRequestBodyProductData' -> Bool
$c/= :: PostPricesRequestBodyProductData'
-> PostPricesRequestBodyProductData' -> Bool
== :: PostPricesRequestBodyProductData'
-> PostPricesRequestBodyProductData' -> Bool
$c== :: PostPricesRequestBodyProductData'
-> PostPricesRequestBodyProductData' -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPricesRequestBodyProductData' where
  toJSON :: PostPricesRequestBodyProductData' -> Value
toJSON PostPricesRequestBodyProductData'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"active" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyProductData' -> Maybe Bool
postPricesRequestBodyProductData'Active PostPricesRequestBodyProductData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"id" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyProductData' -> Maybe Text
postPricesRequestBodyProductData'Id PostPricesRequestBodyProductData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"metadata" Text -> Maybe Object -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyProductData' -> Maybe Object
postPricesRequestBodyProductData'Metadata PostPricesRequestBodyProductData'
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..= PostPricesRequestBodyProductData' -> Text
postPricesRequestBodyProductData'Name PostPricesRequestBodyProductData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"statement_descriptor" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyProductData' -> Maybe Text
postPricesRequestBodyProductData'StatementDescriptor PostPricesRequestBodyProductData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"tax_code" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyProductData' -> Maybe Text
postPricesRequestBodyProductData'TaxCode PostPricesRequestBodyProductData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"unit_label" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyProductData' -> Maybe Text
postPricesRequestBodyProductData'UnitLabel PostPricesRequestBodyProductData'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPricesRequestBodyProductData' -> Encoding
toEncoding PostPricesRequestBodyProductData'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"active" Text -> Maybe Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyProductData' -> Maybe Bool
postPricesRequestBodyProductData'Active PostPricesRequestBodyProductData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"id" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyProductData' -> Maybe Text
postPricesRequestBodyProductData'Id PostPricesRequestBodyProductData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"metadata" Text -> Maybe Object -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyProductData' -> Maybe Object
postPricesRequestBodyProductData'Metadata PostPricesRequestBodyProductData'
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..= PostPricesRequestBodyProductData' -> Text
postPricesRequestBodyProductData'Name PostPricesRequestBodyProductData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"statement_descriptor" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyProductData' -> Maybe Text
postPricesRequestBodyProductData'StatementDescriptor PostPricesRequestBodyProductData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"tax_code" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyProductData' -> Maybe Text
postPricesRequestBodyProductData'TaxCode PostPricesRequestBodyProductData'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"unit_label" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyProductData' -> Maybe Text
postPricesRequestBodyProductData'UnitLabel PostPricesRequestBodyProductData'
obj)))))))

instance Data.Aeson.Types.FromJSON.FromJSON PostPricesRequestBodyProductData' where
  parseJSON :: Value -> Parser PostPricesRequestBodyProductData'
parseJSON = String
-> (Object -> Parser PostPricesRequestBodyProductData')
-> Value
-> Parser PostPricesRequestBodyProductData'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPricesRequestBodyProductData'" (\Object
obj -> (((((((Maybe Bool
 -> Maybe Text
 -> Maybe Object
 -> Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> PostPricesRequestBodyProductData')
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Object
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostPricesRequestBodyProductData')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Bool
-> Maybe Text
-> Maybe Object
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPricesRequestBodyProductData'
PostPricesRequestBodyProductData' Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Object
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostPricesRequestBodyProductData')
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Object
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostPricesRequestBodyProductData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"active")) Parser
  (Maybe Text
   -> Maybe Object
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostPricesRequestBodyProductData')
-> Parser (Maybe Text)
-> Parser
     (Maybe Object
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostPricesRequestBodyProductData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"id")) Parser
  (Maybe Object
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostPricesRequestBodyProductData')
-> Parser (Maybe Object)
-> Parser
     (Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PostPricesRequestBodyProductData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"metadata")) Parser
  (Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PostPricesRequestBodyProductData')
-> Parser Text
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe Text -> PostPricesRequestBodyProductData')
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
   -> Maybe Text -> Maybe Text -> PostPricesRequestBodyProductData')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Text -> PostPricesRequestBodyProductData')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"statement_descriptor")) Parser
  (Maybe Text -> Maybe Text -> PostPricesRequestBodyProductData')
-> Parser (Maybe Text)
-> Parser (Maybe Text -> PostPricesRequestBodyProductData')
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
"tax_code")) Parser (Maybe Text -> PostPricesRequestBodyProductData')
-> Parser (Maybe Text) -> Parser PostPricesRequestBodyProductData'
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
"unit_label"))

-- | Create a new 'PostPricesRequestBodyProductData'' with all required fields.
mkPostPricesRequestBodyProductData' ::
  -- | 'postPricesRequestBodyProductData'Name'
  Data.Text.Internal.Text ->
  PostPricesRequestBodyProductData'
mkPostPricesRequestBodyProductData' :: Text -> PostPricesRequestBodyProductData'
mkPostPricesRequestBodyProductData' Text
postPricesRequestBodyProductData'Name =
  PostPricesRequestBodyProductData' :: Maybe Bool
-> Maybe Text
-> Maybe Object
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PostPricesRequestBodyProductData'
PostPricesRequestBodyProductData'
    { postPricesRequestBodyProductData'Active :: Maybe Bool
postPricesRequestBodyProductData'Active = Maybe Bool
forall a. Maybe a
GHC.Maybe.Nothing,
      postPricesRequestBodyProductData'Id :: Maybe Text
postPricesRequestBodyProductData'Id = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPricesRequestBodyProductData'Metadata :: Maybe Object
postPricesRequestBodyProductData'Metadata = Maybe Object
forall a. Maybe a
GHC.Maybe.Nothing,
      postPricesRequestBodyProductData'Name :: Text
postPricesRequestBodyProductData'Name = Text
postPricesRequestBodyProductData'Name,
      postPricesRequestBodyProductData'StatementDescriptor :: Maybe Text
postPricesRequestBodyProductData'StatementDescriptor = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPricesRequestBodyProductData'TaxCode :: Maybe Text
postPricesRequestBodyProductData'TaxCode = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPricesRequestBodyProductData'UnitLabel :: Maybe Text
postPricesRequestBodyProductData'UnitLabel = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the object schema located at @paths.\/v1\/prices.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.recurring@ in the specification.
--
-- The recurring components of a price such as \`interval\` and \`usage_type\`.
data PostPricesRequestBodyRecurring' = PostPricesRequestBodyRecurring'
  { -- | aggregate_usage
    PostPricesRequestBodyRecurring'
-> Maybe PostPricesRequestBodyRecurring'AggregateUsage'
postPricesRequestBodyRecurring'AggregateUsage :: (GHC.Maybe.Maybe PostPricesRequestBodyRecurring'AggregateUsage'),
    -- | interval
    PostPricesRequestBodyRecurring'
-> PostPricesRequestBodyRecurring'Interval'
postPricesRequestBodyRecurring'Interval :: PostPricesRequestBodyRecurring'Interval',
    -- | interval_count
    PostPricesRequestBodyRecurring' -> Maybe Int
postPricesRequestBodyRecurring'IntervalCount :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | usage_type
    PostPricesRequestBodyRecurring'
-> Maybe PostPricesRequestBodyRecurring'UsageType'
postPricesRequestBodyRecurring'UsageType :: (GHC.Maybe.Maybe PostPricesRequestBodyRecurring'UsageType')
  }
  deriving
    ( Int -> PostPricesRequestBodyRecurring' -> ShowS
[PostPricesRequestBodyRecurring'] -> ShowS
PostPricesRequestBodyRecurring' -> String
(Int -> PostPricesRequestBodyRecurring' -> ShowS)
-> (PostPricesRequestBodyRecurring' -> String)
-> ([PostPricesRequestBodyRecurring'] -> ShowS)
-> Show PostPricesRequestBodyRecurring'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPricesRequestBodyRecurring'] -> ShowS
$cshowList :: [PostPricesRequestBodyRecurring'] -> ShowS
show :: PostPricesRequestBodyRecurring' -> String
$cshow :: PostPricesRequestBodyRecurring' -> String
showsPrec :: Int -> PostPricesRequestBodyRecurring' -> ShowS
$cshowsPrec :: Int -> PostPricesRequestBodyRecurring' -> ShowS
GHC.Show.Show,
      PostPricesRequestBodyRecurring'
-> PostPricesRequestBodyRecurring' -> Bool
(PostPricesRequestBodyRecurring'
 -> PostPricesRequestBodyRecurring' -> Bool)
-> (PostPricesRequestBodyRecurring'
    -> PostPricesRequestBodyRecurring' -> Bool)
-> Eq PostPricesRequestBodyRecurring'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPricesRequestBodyRecurring'
-> PostPricesRequestBodyRecurring' -> Bool
$c/= :: PostPricesRequestBodyRecurring'
-> PostPricesRequestBodyRecurring' -> Bool
== :: PostPricesRequestBodyRecurring'
-> PostPricesRequestBodyRecurring' -> Bool
$c== :: PostPricesRequestBodyRecurring'
-> PostPricesRequestBodyRecurring' -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPricesRequestBodyRecurring' where
  toJSON :: PostPricesRequestBodyRecurring' -> Value
toJSON PostPricesRequestBodyRecurring'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"aggregate_usage" Text
-> Maybe PostPricesRequestBodyRecurring'AggregateUsage' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyRecurring'
-> Maybe PostPricesRequestBodyRecurring'AggregateUsage'
postPricesRequestBodyRecurring'AggregateUsage PostPricesRequestBodyRecurring'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"interval" Text -> PostPricesRequestBodyRecurring'Interval' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyRecurring'
-> PostPricesRequestBodyRecurring'Interval'
postPricesRequestBodyRecurring'Interval PostPricesRequestBodyRecurring'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"interval_count" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyRecurring' -> Maybe Int
postPricesRequestBodyRecurring'IntervalCount PostPricesRequestBodyRecurring'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"usage_type" Text -> Maybe PostPricesRequestBodyRecurring'UsageType' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyRecurring'
-> Maybe PostPricesRequestBodyRecurring'UsageType'
postPricesRequestBodyRecurring'UsageType PostPricesRequestBodyRecurring'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPricesRequestBodyRecurring' -> Encoding
toEncoding PostPricesRequestBodyRecurring'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"aggregate_usage" Text
-> Maybe PostPricesRequestBodyRecurring'AggregateUsage' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyRecurring'
-> Maybe PostPricesRequestBodyRecurring'AggregateUsage'
postPricesRequestBodyRecurring'AggregateUsage PostPricesRequestBodyRecurring'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"interval" Text -> PostPricesRequestBodyRecurring'Interval' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyRecurring'
-> PostPricesRequestBodyRecurring'Interval'
postPricesRequestBodyRecurring'Interval PostPricesRequestBodyRecurring'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"interval_count" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyRecurring' -> Maybe Int
postPricesRequestBodyRecurring'IntervalCount PostPricesRequestBodyRecurring'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"usage_type" Text -> Maybe PostPricesRequestBodyRecurring'UsageType' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyRecurring'
-> Maybe PostPricesRequestBodyRecurring'UsageType'
postPricesRequestBodyRecurring'UsageType PostPricesRequestBodyRecurring'
obj))))

instance Data.Aeson.Types.FromJSON.FromJSON PostPricesRequestBodyRecurring' where
  parseJSON :: Value -> Parser PostPricesRequestBodyRecurring'
parseJSON = String
-> (Object -> Parser PostPricesRequestBodyRecurring')
-> Value
-> Parser PostPricesRequestBodyRecurring'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPricesRequestBodyRecurring'" (\Object
obj -> ((((Maybe PostPricesRequestBodyRecurring'AggregateUsage'
 -> PostPricesRequestBodyRecurring'Interval'
 -> Maybe Int
 -> Maybe PostPricesRequestBodyRecurring'UsageType'
 -> PostPricesRequestBodyRecurring')
-> Parser
     (Maybe PostPricesRequestBodyRecurring'AggregateUsage'
      -> PostPricesRequestBodyRecurring'Interval'
      -> Maybe Int
      -> Maybe PostPricesRequestBodyRecurring'UsageType'
      -> PostPricesRequestBodyRecurring')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe PostPricesRequestBodyRecurring'AggregateUsage'
-> PostPricesRequestBodyRecurring'Interval'
-> Maybe Int
-> Maybe PostPricesRequestBodyRecurring'UsageType'
-> PostPricesRequestBodyRecurring'
PostPricesRequestBodyRecurring' Parser
  (Maybe PostPricesRequestBodyRecurring'AggregateUsage'
   -> PostPricesRequestBodyRecurring'Interval'
   -> Maybe Int
   -> Maybe PostPricesRequestBodyRecurring'UsageType'
   -> PostPricesRequestBodyRecurring')
-> Parser (Maybe PostPricesRequestBodyRecurring'AggregateUsage')
-> Parser
     (PostPricesRequestBodyRecurring'Interval'
      -> Maybe Int
      -> Maybe PostPricesRequestBodyRecurring'UsageType'
      -> PostPricesRequestBodyRecurring')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe PostPricesRequestBodyRecurring'AggregateUsage')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"aggregate_usage")) Parser
  (PostPricesRequestBodyRecurring'Interval'
   -> Maybe Int
   -> Maybe PostPricesRequestBodyRecurring'UsageType'
   -> PostPricesRequestBodyRecurring')
-> Parser PostPricesRequestBodyRecurring'Interval'
-> Parser
     (Maybe Int
      -> Maybe PostPricesRequestBodyRecurring'UsageType'
      -> PostPricesRequestBodyRecurring')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser PostPricesRequestBodyRecurring'Interval'
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"interval")) Parser
  (Maybe Int
   -> Maybe PostPricesRequestBodyRecurring'UsageType'
   -> PostPricesRequestBodyRecurring')
-> Parser (Maybe Int)
-> Parser
     (Maybe PostPricesRequestBodyRecurring'UsageType'
      -> PostPricesRequestBodyRecurring')
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
"interval_count")) Parser
  (Maybe PostPricesRequestBodyRecurring'UsageType'
   -> PostPricesRequestBodyRecurring')
-> Parser (Maybe PostPricesRequestBodyRecurring'UsageType')
-> Parser PostPricesRequestBodyRecurring'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe PostPricesRequestBodyRecurring'UsageType')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"usage_type"))

-- | Create a new 'PostPricesRequestBodyRecurring'' with all required fields.
mkPostPricesRequestBodyRecurring' ::
  -- | 'postPricesRequestBodyRecurring'Interval'
  PostPricesRequestBodyRecurring'Interval' ->
  PostPricesRequestBodyRecurring'
mkPostPricesRequestBodyRecurring' :: PostPricesRequestBodyRecurring'Interval'
-> PostPricesRequestBodyRecurring'
mkPostPricesRequestBodyRecurring' PostPricesRequestBodyRecurring'Interval'
postPricesRequestBodyRecurring'Interval =
  PostPricesRequestBodyRecurring' :: Maybe PostPricesRequestBodyRecurring'AggregateUsage'
-> PostPricesRequestBodyRecurring'Interval'
-> Maybe Int
-> Maybe PostPricesRequestBodyRecurring'UsageType'
-> PostPricesRequestBodyRecurring'
PostPricesRequestBodyRecurring'
    { postPricesRequestBodyRecurring'AggregateUsage :: Maybe PostPricesRequestBodyRecurring'AggregateUsage'
postPricesRequestBodyRecurring'AggregateUsage = Maybe PostPricesRequestBodyRecurring'AggregateUsage'
forall a. Maybe a
GHC.Maybe.Nothing,
      postPricesRequestBodyRecurring'Interval :: PostPricesRequestBodyRecurring'Interval'
postPricesRequestBodyRecurring'Interval = PostPricesRequestBodyRecurring'Interval'
postPricesRequestBodyRecurring'Interval,
      postPricesRequestBodyRecurring'IntervalCount :: Maybe Int
postPricesRequestBodyRecurring'IntervalCount = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      postPricesRequestBodyRecurring'UsageType :: Maybe PostPricesRequestBodyRecurring'UsageType'
postPricesRequestBodyRecurring'UsageType = Maybe PostPricesRequestBodyRecurring'UsageType'
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the enum schema located at @paths.\/v1\/prices.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.recurring.properties.aggregate_usage@ in the specification.
data PostPricesRequestBodyRecurring'AggregateUsage'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostPricesRequestBodyRecurring'AggregateUsage'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.
    PostPricesRequestBodyRecurring'AggregateUsage'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"last_during_period"@
    PostPricesRequestBodyRecurring'AggregateUsage'EnumLastDuringPeriod
  | -- | Represents the JSON value @"last_ever"@
    PostPricesRequestBodyRecurring'AggregateUsage'EnumLastEver
  | -- | Represents the JSON value @"max"@
    PostPricesRequestBodyRecurring'AggregateUsage'EnumMax
  | -- | Represents the JSON value @"sum"@
    PostPricesRequestBodyRecurring'AggregateUsage'EnumSum
  deriving (Int -> PostPricesRequestBodyRecurring'AggregateUsage' -> ShowS
[PostPricesRequestBodyRecurring'AggregateUsage'] -> ShowS
PostPricesRequestBodyRecurring'AggregateUsage' -> String
(Int -> PostPricesRequestBodyRecurring'AggregateUsage' -> ShowS)
-> (PostPricesRequestBodyRecurring'AggregateUsage' -> String)
-> ([PostPricesRequestBodyRecurring'AggregateUsage'] -> ShowS)
-> Show PostPricesRequestBodyRecurring'AggregateUsage'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPricesRequestBodyRecurring'AggregateUsage'] -> ShowS
$cshowList :: [PostPricesRequestBodyRecurring'AggregateUsage'] -> ShowS
show :: PostPricesRequestBodyRecurring'AggregateUsage' -> String
$cshow :: PostPricesRequestBodyRecurring'AggregateUsage' -> String
showsPrec :: Int -> PostPricesRequestBodyRecurring'AggregateUsage' -> ShowS
$cshowsPrec :: Int -> PostPricesRequestBodyRecurring'AggregateUsage' -> ShowS
GHC.Show.Show, PostPricesRequestBodyRecurring'AggregateUsage'
-> PostPricesRequestBodyRecurring'AggregateUsage' -> Bool
(PostPricesRequestBodyRecurring'AggregateUsage'
 -> PostPricesRequestBodyRecurring'AggregateUsage' -> Bool)
-> (PostPricesRequestBodyRecurring'AggregateUsage'
    -> PostPricesRequestBodyRecurring'AggregateUsage' -> Bool)
-> Eq PostPricesRequestBodyRecurring'AggregateUsage'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPricesRequestBodyRecurring'AggregateUsage'
-> PostPricesRequestBodyRecurring'AggregateUsage' -> Bool
$c/= :: PostPricesRequestBodyRecurring'AggregateUsage'
-> PostPricesRequestBodyRecurring'AggregateUsage' -> Bool
== :: PostPricesRequestBodyRecurring'AggregateUsage'
-> PostPricesRequestBodyRecurring'AggregateUsage' -> Bool
$c== :: PostPricesRequestBodyRecurring'AggregateUsage'
-> PostPricesRequestBodyRecurring'AggregateUsage' -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPricesRequestBodyRecurring'AggregateUsage' where
  toJSON :: PostPricesRequestBodyRecurring'AggregateUsage' -> Value
toJSON (PostPricesRequestBodyRecurring'AggregateUsage'Other Value
val) = Value
val
  toJSON (PostPricesRequestBodyRecurring'AggregateUsage'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (PostPricesRequestBodyRecurring'AggregateUsage'
PostPricesRequestBodyRecurring'AggregateUsage'EnumLastDuringPeriod) = Value
"last_during_period"
  toJSON (PostPricesRequestBodyRecurring'AggregateUsage'
PostPricesRequestBodyRecurring'AggregateUsage'EnumLastEver) = Value
"last_ever"
  toJSON (PostPricesRequestBodyRecurring'AggregateUsage'
PostPricesRequestBodyRecurring'AggregateUsage'EnumMax) = Value
"max"
  toJSON (PostPricesRequestBodyRecurring'AggregateUsage'
PostPricesRequestBodyRecurring'AggregateUsage'EnumSum) = Value
"sum"

instance Data.Aeson.Types.FromJSON.FromJSON PostPricesRequestBodyRecurring'AggregateUsage' where
  parseJSON :: Value -> Parser PostPricesRequestBodyRecurring'AggregateUsage'
parseJSON Value
val =
    PostPricesRequestBodyRecurring'AggregateUsage'
-> Parser PostPricesRequestBodyRecurring'AggregateUsage'
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
"last_during_period" -> PostPricesRequestBodyRecurring'AggregateUsage'
PostPricesRequestBodyRecurring'AggregateUsage'EnumLastDuringPeriod
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"last_ever" -> PostPricesRequestBodyRecurring'AggregateUsage'
PostPricesRequestBodyRecurring'AggregateUsage'EnumLastEver
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"max" -> PostPricesRequestBodyRecurring'AggregateUsage'
PostPricesRequestBodyRecurring'AggregateUsage'EnumMax
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"sum" -> PostPricesRequestBodyRecurring'AggregateUsage'
PostPricesRequestBodyRecurring'AggregateUsage'EnumSum
            | Bool
GHC.Base.otherwise -> Value -> PostPricesRequestBodyRecurring'AggregateUsage'
PostPricesRequestBodyRecurring'AggregateUsage'Other Value
val
      )

-- | Defines the enum schema located at @paths.\/v1\/prices.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.recurring.properties.interval@ in the specification.
data PostPricesRequestBodyRecurring'Interval'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostPricesRequestBodyRecurring'Interval'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.
    PostPricesRequestBodyRecurring'Interval'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"day"@
    PostPricesRequestBodyRecurring'Interval'EnumDay
  | -- | Represents the JSON value @"month"@
    PostPricesRequestBodyRecurring'Interval'EnumMonth
  | -- | Represents the JSON value @"week"@
    PostPricesRequestBodyRecurring'Interval'EnumWeek
  | -- | Represents the JSON value @"year"@
    PostPricesRequestBodyRecurring'Interval'EnumYear
  deriving (Int -> PostPricesRequestBodyRecurring'Interval' -> ShowS
[PostPricesRequestBodyRecurring'Interval'] -> ShowS
PostPricesRequestBodyRecurring'Interval' -> String
(Int -> PostPricesRequestBodyRecurring'Interval' -> ShowS)
-> (PostPricesRequestBodyRecurring'Interval' -> String)
-> ([PostPricesRequestBodyRecurring'Interval'] -> ShowS)
-> Show PostPricesRequestBodyRecurring'Interval'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPricesRequestBodyRecurring'Interval'] -> ShowS
$cshowList :: [PostPricesRequestBodyRecurring'Interval'] -> ShowS
show :: PostPricesRequestBodyRecurring'Interval' -> String
$cshow :: PostPricesRequestBodyRecurring'Interval' -> String
showsPrec :: Int -> PostPricesRequestBodyRecurring'Interval' -> ShowS
$cshowsPrec :: Int -> PostPricesRequestBodyRecurring'Interval' -> ShowS
GHC.Show.Show, PostPricesRequestBodyRecurring'Interval'
-> PostPricesRequestBodyRecurring'Interval' -> Bool
(PostPricesRequestBodyRecurring'Interval'
 -> PostPricesRequestBodyRecurring'Interval' -> Bool)
-> (PostPricesRequestBodyRecurring'Interval'
    -> PostPricesRequestBodyRecurring'Interval' -> Bool)
-> Eq PostPricesRequestBodyRecurring'Interval'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPricesRequestBodyRecurring'Interval'
-> PostPricesRequestBodyRecurring'Interval' -> Bool
$c/= :: PostPricesRequestBodyRecurring'Interval'
-> PostPricesRequestBodyRecurring'Interval' -> Bool
== :: PostPricesRequestBodyRecurring'Interval'
-> PostPricesRequestBodyRecurring'Interval' -> Bool
$c== :: PostPricesRequestBodyRecurring'Interval'
-> PostPricesRequestBodyRecurring'Interval' -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPricesRequestBodyRecurring'Interval' where
  toJSON :: PostPricesRequestBodyRecurring'Interval' -> Value
toJSON (PostPricesRequestBodyRecurring'Interval'Other Value
val) = Value
val
  toJSON (PostPricesRequestBodyRecurring'Interval'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (PostPricesRequestBodyRecurring'Interval'
PostPricesRequestBodyRecurring'Interval'EnumDay) = Value
"day"
  toJSON (PostPricesRequestBodyRecurring'Interval'
PostPricesRequestBodyRecurring'Interval'EnumMonth) = Value
"month"
  toJSON (PostPricesRequestBodyRecurring'Interval'
PostPricesRequestBodyRecurring'Interval'EnumWeek) = Value
"week"
  toJSON (PostPricesRequestBodyRecurring'Interval'
PostPricesRequestBodyRecurring'Interval'EnumYear) = Value
"year"

instance Data.Aeson.Types.FromJSON.FromJSON PostPricesRequestBodyRecurring'Interval' where
  parseJSON :: Value -> Parser PostPricesRequestBodyRecurring'Interval'
parseJSON Value
val =
    PostPricesRequestBodyRecurring'Interval'
-> Parser PostPricesRequestBodyRecurring'Interval'
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
"day" -> PostPricesRequestBodyRecurring'Interval'
PostPricesRequestBodyRecurring'Interval'EnumDay
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"month" -> PostPricesRequestBodyRecurring'Interval'
PostPricesRequestBodyRecurring'Interval'EnumMonth
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"week" -> PostPricesRequestBodyRecurring'Interval'
PostPricesRequestBodyRecurring'Interval'EnumWeek
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"year" -> PostPricesRequestBodyRecurring'Interval'
PostPricesRequestBodyRecurring'Interval'EnumYear
            | Bool
GHC.Base.otherwise -> Value -> PostPricesRequestBodyRecurring'Interval'
PostPricesRequestBodyRecurring'Interval'Other Value
val
      )

-- | Defines the enum schema located at @paths.\/v1\/prices.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.recurring.properties.usage_type@ in the specification.
data PostPricesRequestBodyRecurring'UsageType'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostPricesRequestBodyRecurring'UsageType'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.
    PostPricesRequestBodyRecurring'UsageType'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"licensed"@
    PostPricesRequestBodyRecurring'UsageType'EnumLicensed
  | -- | Represents the JSON value @"metered"@
    PostPricesRequestBodyRecurring'UsageType'EnumMetered
  deriving (Int -> PostPricesRequestBodyRecurring'UsageType' -> ShowS
[PostPricesRequestBodyRecurring'UsageType'] -> ShowS
PostPricesRequestBodyRecurring'UsageType' -> String
(Int -> PostPricesRequestBodyRecurring'UsageType' -> ShowS)
-> (PostPricesRequestBodyRecurring'UsageType' -> String)
-> ([PostPricesRequestBodyRecurring'UsageType'] -> ShowS)
-> Show PostPricesRequestBodyRecurring'UsageType'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPricesRequestBodyRecurring'UsageType'] -> ShowS
$cshowList :: [PostPricesRequestBodyRecurring'UsageType'] -> ShowS
show :: PostPricesRequestBodyRecurring'UsageType' -> String
$cshow :: PostPricesRequestBodyRecurring'UsageType' -> String
showsPrec :: Int -> PostPricesRequestBodyRecurring'UsageType' -> ShowS
$cshowsPrec :: Int -> PostPricesRequestBodyRecurring'UsageType' -> ShowS
GHC.Show.Show, PostPricesRequestBodyRecurring'UsageType'
-> PostPricesRequestBodyRecurring'UsageType' -> Bool
(PostPricesRequestBodyRecurring'UsageType'
 -> PostPricesRequestBodyRecurring'UsageType' -> Bool)
-> (PostPricesRequestBodyRecurring'UsageType'
    -> PostPricesRequestBodyRecurring'UsageType' -> Bool)
-> Eq PostPricesRequestBodyRecurring'UsageType'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPricesRequestBodyRecurring'UsageType'
-> PostPricesRequestBodyRecurring'UsageType' -> Bool
$c/= :: PostPricesRequestBodyRecurring'UsageType'
-> PostPricesRequestBodyRecurring'UsageType' -> Bool
== :: PostPricesRequestBodyRecurring'UsageType'
-> PostPricesRequestBodyRecurring'UsageType' -> Bool
$c== :: PostPricesRequestBodyRecurring'UsageType'
-> PostPricesRequestBodyRecurring'UsageType' -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPricesRequestBodyRecurring'UsageType' where
  toJSON :: PostPricesRequestBodyRecurring'UsageType' -> Value
toJSON (PostPricesRequestBodyRecurring'UsageType'Other Value
val) = Value
val
  toJSON (PostPricesRequestBodyRecurring'UsageType'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (PostPricesRequestBodyRecurring'UsageType'
PostPricesRequestBodyRecurring'UsageType'EnumLicensed) = Value
"licensed"
  toJSON (PostPricesRequestBodyRecurring'UsageType'
PostPricesRequestBodyRecurring'UsageType'EnumMetered) = Value
"metered"

instance Data.Aeson.Types.FromJSON.FromJSON PostPricesRequestBodyRecurring'UsageType' where
  parseJSON :: Value -> Parser PostPricesRequestBodyRecurring'UsageType'
parseJSON Value
val =
    PostPricesRequestBodyRecurring'UsageType'
-> Parser PostPricesRequestBodyRecurring'UsageType'
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
"licensed" -> PostPricesRequestBodyRecurring'UsageType'
PostPricesRequestBodyRecurring'UsageType'EnumLicensed
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"metered" -> PostPricesRequestBodyRecurring'UsageType'
PostPricesRequestBodyRecurring'UsageType'EnumMetered
            | Bool
GHC.Base.otherwise -> Value -> PostPricesRequestBodyRecurring'UsageType'
PostPricesRequestBodyRecurring'UsageType'Other Value
val
      )

-- | Defines the enum schema located at @paths.\/v1\/prices.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.tax_behavior@ in the specification.
--
-- Specifies whether the price is considered inclusive of taxes or exclusive of taxes. One of \`inclusive\`, \`exclusive\`, or \`unspecified\`. Once specified as either \`inclusive\` or \`exclusive\`, it cannot be changed.
data PostPricesRequestBodyTaxBehavior'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostPricesRequestBodyTaxBehavior'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.
    PostPricesRequestBodyTaxBehavior'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"exclusive"@
    PostPricesRequestBodyTaxBehavior'EnumExclusive
  | -- | Represents the JSON value @"inclusive"@
    PostPricesRequestBodyTaxBehavior'EnumInclusive
  | -- | Represents the JSON value @"unspecified"@
    PostPricesRequestBodyTaxBehavior'EnumUnspecified
  deriving (Int -> PostPricesRequestBodyTaxBehavior' -> ShowS
[PostPricesRequestBodyTaxBehavior'] -> ShowS
PostPricesRequestBodyTaxBehavior' -> String
(Int -> PostPricesRequestBodyTaxBehavior' -> ShowS)
-> (PostPricesRequestBodyTaxBehavior' -> String)
-> ([PostPricesRequestBodyTaxBehavior'] -> ShowS)
-> Show PostPricesRequestBodyTaxBehavior'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPricesRequestBodyTaxBehavior'] -> ShowS
$cshowList :: [PostPricesRequestBodyTaxBehavior'] -> ShowS
show :: PostPricesRequestBodyTaxBehavior' -> String
$cshow :: PostPricesRequestBodyTaxBehavior' -> String
showsPrec :: Int -> PostPricesRequestBodyTaxBehavior' -> ShowS
$cshowsPrec :: Int -> PostPricesRequestBodyTaxBehavior' -> ShowS
GHC.Show.Show, PostPricesRequestBodyTaxBehavior'
-> PostPricesRequestBodyTaxBehavior' -> Bool
(PostPricesRequestBodyTaxBehavior'
 -> PostPricesRequestBodyTaxBehavior' -> Bool)
-> (PostPricesRequestBodyTaxBehavior'
    -> PostPricesRequestBodyTaxBehavior' -> Bool)
-> Eq PostPricesRequestBodyTaxBehavior'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPricesRequestBodyTaxBehavior'
-> PostPricesRequestBodyTaxBehavior' -> Bool
$c/= :: PostPricesRequestBodyTaxBehavior'
-> PostPricesRequestBodyTaxBehavior' -> Bool
== :: PostPricesRequestBodyTaxBehavior'
-> PostPricesRequestBodyTaxBehavior' -> Bool
$c== :: PostPricesRequestBodyTaxBehavior'
-> PostPricesRequestBodyTaxBehavior' -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPricesRequestBodyTaxBehavior' where
  toJSON :: PostPricesRequestBodyTaxBehavior' -> Value
toJSON (PostPricesRequestBodyTaxBehavior'Other Value
val) = Value
val
  toJSON (PostPricesRequestBodyTaxBehavior'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (PostPricesRequestBodyTaxBehavior'
PostPricesRequestBodyTaxBehavior'EnumExclusive) = Value
"exclusive"
  toJSON (PostPricesRequestBodyTaxBehavior'
PostPricesRequestBodyTaxBehavior'EnumInclusive) = Value
"inclusive"
  toJSON (PostPricesRequestBodyTaxBehavior'
PostPricesRequestBodyTaxBehavior'EnumUnspecified) = Value
"unspecified"

instance Data.Aeson.Types.FromJSON.FromJSON PostPricesRequestBodyTaxBehavior' where
  parseJSON :: Value -> Parser PostPricesRequestBodyTaxBehavior'
parseJSON Value
val =
    PostPricesRequestBodyTaxBehavior'
-> Parser PostPricesRequestBodyTaxBehavior'
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
"exclusive" -> PostPricesRequestBodyTaxBehavior'
PostPricesRequestBodyTaxBehavior'EnumExclusive
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"inclusive" -> PostPricesRequestBodyTaxBehavior'
PostPricesRequestBodyTaxBehavior'EnumInclusive
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"unspecified" -> PostPricesRequestBodyTaxBehavior'
PostPricesRequestBodyTaxBehavior'EnumUnspecified
            | Bool
GHC.Base.otherwise -> Value -> PostPricesRequestBodyTaxBehavior'
PostPricesRequestBodyTaxBehavior'Other Value
val
      )

-- | Defines the object schema located at @paths.\/v1\/prices.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.tiers.items@ in the specification.
data PostPricesRequestBodyTiers' = PostPricesRequestBodyTiers'
  { -- | flat_amount
    PostPricesRequestBodyTiers' -> Maybe Int
postPricesRequestBodyTiers'FlatAmount :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | flat_amount_decimal
    PostPricesRequestBodyTiers' -> Maybe Text
postPricesRequestBodyTiers'FlatAmountDecimal :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | unit_amount
    PostPricesRequestBodyTiers' -> Maybe Int
postPricesRequestBodyTiers'UnitAmount :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | unit_amount_decimal
    PostPricesRequestBodyTiers' -> Maybe Text
postPricesRequestBodyTiers'UnitAmountDecimal :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | up_to
    PostPricesRequestBodyTiers'
-> PostPricesRequestBodyTiers'UpTo'Variants
postPricesRequestBodyTiers'UpTo :: PostPricesRequestBodyTiers'UpTo'Variants
  }
  deriving
    ( Int -> PostPricesRequestBodyTiers' -> ShowS
[PostPricesRequestBodyTiers'] -> ShowS
PostPricesRequestBodyTiers' -> String
(Int -> PostPricesRequestBodyTiers' -> ShowS)
-> (PostPricesRequestBodyTiers' -> String)
-> ([PostPricesRequestBodyTiers'] -> ShowS)
-> Show PostPricesRequestBodyTiers'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPricesRequestBodyTiers'] -> ShowS
$cshowList :: [PostPricesRequestBodyTiers'] -> ShowS
show :: PostPricesRequestBodyTiers' -> String
$cshow :: PostPricesRequestBodyTiers' -> String
showsPrec :: Int -> PostPricesRequestBodyTiers' -> ShowS
$cshowsPrec :: Int -> PostPricesRequestBodyTiers' -> ShowS
GHC.Show.Show,
      PostPricesRequestBodyTiers' -> PostPricesRequestBodyTiers' -> Bool
(PostPricesRequestBodyTiers'
 -> PostPricesRequestBodyTiers' -> Bool)
-> (PostPricesRequestBodyTiers'
    -> PostPricesRequestBodyTiers' -> Bool)
-> Eq PostPricesRequestBodyTiers'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPricesRequestBodyTiers' -> PostPricesRequestBodyTiers' -> Bool
$c/= :: PostPricesRequestBodyTiers' -> PostPricesRequestBodyTiers' -> Bool
== :: PostPricesRequestBodyTiers' -> PostPricesRequestBodyTiers' -> Bool
$c== :: PostPricesRequestBodyTiers' -> PostPricesRequestBodyTiers' -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPricesRequestBodyTiers' where
  toJSON :: PostPricesRequestBodyTiers' -> Value
toJSON PostPricesRequestBodyTiers'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"flat_amount" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyTiers' -> Maybe Int
postPricesRequestBodyTiers'FlatAmount PostPricesRequestBodyTiers'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"flat_amount_decimal" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyTiers' -> Maybe Text
postPricesRequestBodyTiers'FlatAmountDecimal PostPricesRequestBodyTiers'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"unit_amount" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyTiers' -> Maybe Int
postPricesRequestBodyTiers'UnitAmount PostPricesRequestBodyTiers'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"unit_amount_decimal" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyTiers' -> Maybe Text
postPricesRequestBodyTiers'UnitAmountDecimal PostPricesRequestBodyTiers'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"up_to" Text -> PostPricesRequestBodyTiers'UpTo'Variants -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyTiers'
-> PostPricesRequestBodyTiers'UpTo'Variants
postPricesRequestBodyTiers'UpTo PostPricesRequestBodyTiers'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPricesRequestBodyTiers' -> Encoding
toEncoding PostPricesRequestBodyTiers'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"flat_amount" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyTiers' -> Maybe Int
postPricesRequestBodyTiers'FlatAmount PostPricesRequestBodyTiers'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"flat_amount_decimal" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyTiers' -> Maybe Text
postPricesRequestBodyTiers'FlatAmountDecimal PostPricesRequestBodyTiers'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"unit_amount" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyTiers' -> Maybe Int
postPricesRequestBodyTiers'UnitAmount PostPricesRequestBodyTiers'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"unit_amount_decimal" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyTiers' -> Maybe Text
postPricesRequestBodyTiers'UnitAmountDecimal PostPricesRequestBodyTiers'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"up_to" Text -> PostPricesRequestBodyTiers'UpTo'Variants -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyTiers'
-> PostPricesRequestBodyTiers'UpTo'Variants
postPricesRequestBodyTiers'UpTo PostPricesRequestBodyTiers'
obj)))))

instance Data.Aeson.Types.FromJSON.FromJSON PostPricesRequestBodyTiers' where
  parseJSON :: Value -> Parser PostPricesRequestBodyTiers'
parseJSON = String
-> (Object -> Parser PostPricesRequestBodyTiers')
-> Value
-> Parser PostPricesRequestBodyTiers'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPricesRequestBodyTiers'" (\Object
obj -> (((((Maybe Int
 -> Maybe Text
 -> Maybe Int
 -> Maybe Text
 -> PostPricesRequestBodyTiers'UpTo'Variants
 -> PostPricesRequestBodyTiers')
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> PostPricesRequestBodyTiers'UpTo'Variants
      -> PostPricesRequestBodyTiers')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Int
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> PostPricesRequestBodyTiers'UpTo'Variants
-> PostPricesRequestBodyTiers'
PostPricesRequestBodyTiers' Parser
  (Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> PostPricesRequestBodyTiers'UpTo'Variants
   -> PostPricesRequestBodyTiers')
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> PostPricesRequestBodyTiers'UpTo'Variants
      -> PostPricesRequestBodyTiers')
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
"flat_amount")) Parser
  (Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> PostPricesRequestBodyTiers'UpTo'Variants
   -> PostPricesRequestBodyTiers')
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe Text
      -> PostPricesRequestBodyTiers'UpTo'Variants
      -> PostPricesRequestBodyTiers')
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
"flat_amount_decimal")) Parser
  (Maybe Int
   -> Maybe Text
   -> PostPricesRequestBodyTiers'UpTo'Variants
   -> PostPricesRequestBodyTiers')
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> PostPricesRequestBodyTiers'UpTo'Variants
      -> PostPricesRequestBodyTiers')
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
"unit_amount")) Parser
  (Maybe Text
   -> PostPricesRequestBodyTiers'UpTo'Variants
   -> PostPricesRequestBodyTiers')
-> Parser (Maybe Text)
-> Parser
     (PostPricesRequestBodyTiers'UpTo'Variants
      -> PostPricesRequestBodyTiers')
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
"unit_amount_decimal")) Parser
  (PostPricesRequestBodyTiers'UpTo'Variants
   -> PostPricesRequestBodyTiers')
-> Parser PostPricesRequestBodyTiers'UpTo'Variants
-> Parser PostPricesRequestBodyTiers'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser PostPricesRequestBodyTiers'UpTo'Variants
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"up_to"))

-- | Create a new 'PostPricesRequestBodyTiers'' with all required fields.
mkPostPricesRequestBodyTiers' ::
  -- | 'postPricesRequestBodyTiers'UpTo'
  PostPricesRequestBodyTiers'UpTo'Variants ->
  PostPricesRequestBodyTiers'
mkPostPricesRequestBodyTiers' :: PostPricesRequestBodyTiers'UpTo'Variants
-> PostPricesRequestBodyTiers'
mkPostPricesRequestBodyTiers' PostPricesRequestBodyTiers'UpTo'Variants
postPricesRequestBodyTiers'UpTo =
  PostPricesRequestBodyTiers' :: Maybe Int
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> PostPricesRequestBodyTiers'UpTo'Variants
-> PostPricesRequestBodyTiers'
PostPricesRequestBodyTiers'
    { postPricesRequestBodyTiers'FlatAmount :: Maybe Int
postPricesRequestBodyTiers'FlatAmount = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      postPricesRequestBodyTiers'FlatAmountDecimal :: Maybe Text
postPricesRequestBodyTiers'FlatAmountDecimal = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPricesRequestBodyTiers'UnitAmount :: Maybe Int
postPricesRequestBodyTiers'UnitAmount = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      postPricesRequestBodyTiers'UnitAmountDecimal :: Maybe Text
postPricesRequestBodyTiers'UnitAmountDecimal = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      postPricesRequestBodyTiers'UpTo :: PostPricesRequestBodyTiers'UpTo'Variants
postPricesRequestBodyTiers'UpTo = PostPricesRequestBodyTiers'UpTo'Variants
postPricesRequestBodyTiers'UpTo
    }

-- | Defines the oneOf schema located at @paths.\/v1\/prices.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.tiers.items.properties.up_to.anyOf@ in the specification.
data PostPricesRequestBodyTiers'UpTo'Variants
  = -- | Represents the JSON value @"inf"@
    PostPricesRequestBodyTiers'UpTo'Inf
  | PostPricesRequestBodyTiers'UpTo'Int GHC.Types.Int
  deriving (Int -> PostPricesRequestBodyTiers'UpTo'Variants -> ShowS
[PostPricesRequestBodyTiers'UpTo'Variants] -> ShowS
PostPricesRequestBodyTiers'UpTo'Variants -> String
(Int -> PostPricesRequestBodyTiers'UpTo'Variants -> ShowS)
-> (PostPricesRequestBodyTiers'UpTo'Variants -> String)
-> ([PostPricesRequestBodyTiers'UpTo'Variants] -> ShowS)
-> Show PostPricesRequestBodyTiers'UpTo'Variants
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPricesRequestBodyTiers'UpTo'Variants] -> ShowS
$cshowList :: [PostPricesRequestBodyTiers'UpTo'Variants] -> ShowS
show :: PostPricesRequestBodyTiers'UpTo'Variants -> String
$cshow :: PostPricesRequestBodyTiers'UpTo'Variants -> String
showsPrec :: Int -> PostPricesRequestBodyTiers'UpTo'Variants -> ShowS
$cshowsPrec :: Int -> PostPricesRequestBodyTiers'UpTo'Variants -> ShowS
GHC.Show.Show, PostPricesRequestBodyTiers'UpTo'Variants
-> PostPricesRequestBodyTiers'UpTo'Variants -> Bool
(PostPricesRequestBodyTiers'UpTo'Variants
 -> PostPricesRequestBodyTiers'UpTo'Variants -> Bool)
-> (PostPricesRequestBodyTiers'UpTo'Variants
    -> PostPricesRequestBodyTiers'UpTo'Variants -> Bool)
-> Eq PostPricesRequestBodyTiers'UpTo'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPricesRequestBodyTiers'UpTo'Variants
-> PostPricesRequestBodyTiers'UpTo'Variants -> Bool
$c/= :: PostPricesRequestBodyTiers'UpTo'Variants
-> PostPricesRequestBodyTiers'UpTo'Variants -> Bool
== :: PostPricesRequestBodyTiers'UpTo'Variants
-> PostPricesRequestBodyTiers'UpTo'Variants -> Bool
$c== :: PostPricesRequestBodyTiers'UpTo'Variants
-> PostPricesRequestBodyTiers'UpTo'Variants -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPricesRequestBodyTiers'UpTo'Variants where
  toJSON :: PostPricesRequestBodyTiers'UpTo'Variants -> Value
toJSON (PostPricesRequestBodyTiers'UpTo'Int Int
a) = Int -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Int
a
  toJSON (PostPricesRequestBodyTiers'UpTo'Variants
PostPricesRequestBodyTiers'UpTo'Inf) = Value
"inf"

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

-- | Defines the enum schema located at @paths.\/v1\/prices.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.tiers_mode@ in the specification.
--
-- Defines if the tiering price should be \`graduated\` or \`volume\` based. In \`volume\`-based tiering, the maximum quantity within a period determines the per unit price, in \`graduated\` tiering pricing can successively change as the quantity grows.
data PostPricesRequestBodyTiersMode'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostPricesRequestBodyTiersMode'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.
    PostPricesRequestBodyTiersMode'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"graduated"@
    PostPricesRequestBodyTiersMode'EnumGraduated
  | -- | Represents the JSON value @"volume"@
    PostPricesRequestBodyTiersMode'EnumVolume
  deriving (Int -> PostPricesRequestBodyTiersMode' -> ShowS
[PostPricesRequestBodyTiersMode'] -> ShowS
PostPricesRequestBodyTiersMode' -> String
(Int -> PostPricesRequestBodyTiersMode' -> ShowS)
-> (PostPricesRequestBodyTiersMode' -> String)
-> ([PostPricesRequestBodyTiersMode'] -> ShowS)
-> Show PostPricesRequestBodyTiersMode'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPricesRequestBodyTiersMode'] -> ShowS
$cshowList :: [PostPricesRequestBodyTiersMode'] -> ShowS
show :: PostPricesRequestBodyTiersMode' -> String
$cshow :: PostPricesRequestBodyTiersMode' -> String
showsPrec :: Int -> PostPricesRequestBodyTiersMode' -> ShowS
$cshowsPrec :: Int -> PostPricesRequestBodyTiersMode' -> ShowS
GHC.Show.Show, PostPricesRequestBodyTiersMode'
-> PostPricesRequestBodyTiersMode' -> Bool
(PostPricesRequestBodyTiersMode'
 -> PostPricesRequestBodyTiersMode' -> Bool)
-> (PostPricesRequestBodyTiersMode'
    -> PostPricesRequestBodyTiersMode' -> Bool)
-> Eq PostPricesRequestBodyTiersMode'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPricesRequestBodyTiersMode'
-> PostPricesRequestBodyTiersMode' -> Bool
$c/= :: PostPricesRequestBodyTiersMode'
-> PostPricesRequestBodyTiersMode' -> Bool
== :: PostPricesRequestBodyTiersMode'
-> PostPricesRequestBodyTiersMode' -> Bool
$c== :: PostPricesRequestBodyTiersMode'
-> PostPricesRequestBodyTiersMode' -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPricesRequestBodyTiersMode' where
  toJSON :: PostPricesRequestBodyTiersMode' -> Value
toJSON (PostPricesRequestBodyTiersMode'Other Value
val) = Value
val
  toJSON (PostPricesRequestBodyTiersMode'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (PostPricesRequestBodyTiersMode'
PostPricesRequestBodyTiersMode'EnumGraduated) = Value
"graduated"
  toJSON (PostPricesRequestBodyTiersMode'
PostPricesRequestBodyTiersMode'EnumVolume) = Value
"volume"

instance Data.Aeson.Types.FromJSON.FromJSON PostPricesRequestBodyTiersMode' where
  parseJSON :: Value -> Parser PostPricesRequestBodyTiersMode'
parseJSON Value
val =
    PostPricesRequestBodyTiersMode'
-> Parser PostPricesRequestBodyTiersMode'
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
"graduated" -> PostPricesRequestBodyTiersMode'
PostPricesRequestBodyTiersMode'EnumGraduated
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"volume" -> PostPricesRequestBodyTiersMode'
PostPricesRequestBodyTiersMode'EnumVolume
            | Bool
GHC.Base.otherwise -> Value -> PostPricesRequestBodyTiersMode'
PostPricesRequestBodyTiersMode'Other Value
val
      )

-- | Defines the object schema located at @paths.\/v1\/prices.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.transform_quantity@ in the specification.
--
-- Apply a transformation to the reported usage or set quantity before computing the billed price. Cannot be combined with \`tiers\`.
data PostPricesRequestBodyTransformQuantity' = PostPricesRequestBodyTransformQuantity'
  { -- | divide_by
    PostPricesRequestBodyTransformQuantity' -> Int
postPricesRequestBodyTransformQuantity'DivideBy :: GHC.Types.Int,
    -- | round
    PostPricesRequestBodyTransformQuantity'
-> PostPricesRequestBodyTransformQuantity'Round'
postPricesRequestBodyTransformQuantity'Round :: PostPricesRequestBodyTransformQuantity'Round'
  }
  deriving
    ( Int -> PostPricesRequestBodyTransformQuantity' -> ShowS
[PostPricesRequestBodyTransformQuantity'] -> ShowS
PostPricesRequestBodyTransformQuantity' -> String
(Int -> PostPricesRequestBodyTransformQuantity' -> ShowS)
-> (PostPricesRequestBodyTransformQuantity' -> String)
-> ([PostPricesRequestBodyTransformQuantity'] -> ShowS)
-> Show PostPricesRequestBodyTransformQuantity'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPricesRequestBodyTransformQuantity'] -> ShowS
$cshowList :: [PostPricesRequestBodyTransformQuantity'] -> ShowS
show :: PostPricesRequestBodyTransformQuantity' -> String
$cshow :: PostPricesRequestBodyTransformQuantity' -> String
showsPrec :: Int -> PostPricesRequestBodyTransformQuantity' -> ShowS
$cshowsPrec :: Int -> PostPricesRequestBodyTransformQuantity' -> ShowS
GHC.Show.Show,
      PostPricesRequestBodyTransformQuantity'
-> PostPricesRequestBodyTransformQuantity' -> Bool
(PostPricesRequestBodyTransformQuantity'
 -> PostPricesRequestBodyTransformQuantity' -> Bool)
-> (PostPricesRequestBodyTransformQuantity'
    -> PostPricesRequestBodyTransformQuantity' -> Bool)
-> Eq PostPricesRequestBodyTransformQuantity'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPricesRequestBodyTransformQuantity'
-> PostPricesRequestBodyTransformQuantity' -> Bool
$c/= :: PostPricesRequestBodyTransformQuantity'
-> PostPricesRequestBodyTransformQuantity' -> Bool
== :: PostPricesRequestBodyTransformQuantity'
-> PostPricesRequestBodyTransformQuantity' -> Bool
$c== :: PostPricesRequestBodyTransformQuantity'
-> PostPricesRequestBodyTransformQuantity' -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON PostPricesRequestBodyTransformQuantity' where
  toJSON :: PostPricesRequestBodyTransformQuantity' -> Value
toJSON PostPricesRequestBodyTransformQuantity'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"divide_by" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyTransformQuantity' -> Int
postPricesRequestBodyTransformQuantity'DivideBy PostPricesRequestBodyTransformQuantity'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"round" Text -> PostPricesRequestBodyTransformQuantity'Round' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyTransformQuantity'
-> PostPricesRequestBodyTransformQuantity'Round'
postPricesRequestBodyTransformQuantity'Round PostPricesRequestBodyTransformQuantity'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: PostPricesRequestBodyTransformQuantity' -> Encoding
toEncoding PostPricesRequestBodyTransformQuantity'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"divide_by" Text -> Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyTransformQuantity' -> Int
postPricesRequestBodyTransformQuantity'DivideBy PostPricesRequestBodyTransformQuantity'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"round" Text -> PostPricesRequestBodyTransformQuantity'Round' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= PostPricesRequestBodyTransformQuantity'
-> PostPricesRequestBodyTransformQuantity'Round'
postPricesRequestBodyTransformQuantity'Round PostPricesRequestBodyTransformQuantity'
obj))

instance Data.Aeson.Types.FromJSON.FromJSON PostPricesRequestBodyTransformQuantity' where
  parseJSON :: Value -> Parser PostPricesRequestBodyTransformQuantity'
parseJSON = String
-> (Object -> Parser PostPricesRequestBodyTransformQuantity')
-> Value
-> Parser PostPricesRequestBodyTransformQuantity'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"PostPricesRequestBodyTransformQuantity'" (\Object
obj -> ((Int
 -> PostPricesRequestBodyTransformQuantity'Round'
 -> PostPricesRequestBodyTransformQuantity')
-> Parser
     (Int
      -> PostPricesRequestBodyTransformQuantity'Round'
      -> PostPricesRequestBodyTransformQuantity')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Int
-> PostPricesRequestBodyTransformQuantity'Round'
-> PostPricesRequestBodyTransformQuantity'
PostPricesRequestBodyTransformQuantity' Parser
  (Int
   -> PostPricesRequestBodyTransformQuantity'Round'
   -> PostPricesRequestBodyTransformQuantity')
-> Parser Int
-> Parser
     (PostPricesRequestBodyTransformQuantity'Round'
      -> PostPricesRequestBodyTransformQuantity')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"divide_by")) Parser
  (PostPricesRequestBodyTransformQuantity'Round'
   -> PostPricesRequestBodyTransformQuantity')
-> Parser PostPricesRequestBodyTransformQuantity'Round'
-> Parser PostPricesRequestBodyTransformQuantity'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser PostPricesRequestBodyTransformQuantity'Round'
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"round"))

-- | Create a new 'PostPricesRequestBodyTransformQuantity'' with all required fields.
mkPostPricesRequestBodyTransformQuantity' ::
  -- | 'postPricesRequestBodyTransformQuantity'DivideBy'
  GHC.Types.Int ->
  -- | 'postPricesRequestBodyTransformQuantity'Round'
  PostPricesRequestBodyTransformQuantity'Round' ->
  PostPricesRequestBodyTransformQuantity'
mkPostPricesRequestBodyTransformQuantity' :: Int
-> PostPricesRequestBodyTransformQuantity'Round'
-> PostPricesRequestBodyTransformQuantity'
mkPostPricesRequestBodyTransformQuantity' Int
postPricesRequestBodyTransformQuantity'DivideBy PostPricesRequestBodyTransformQuantity'Round'
postPricesRequestBodyTransformQuantity'Round =
  PostPricesRequestBodyTransformQuantity' :: Int
-> PostPricesRequestBodyTransformQuantity'Round'
-> PostPricesRequestBodyTransformQuantity'
PostPricesRequestBodyTransformQuantity'
    { postPricesRequestBodyTransformQuantity'DivideBy :: Int
postPricesRequestBodyTransformQuantity'DivideBy = Int
postPricesRequestBodyTransformQuantity'DivideBy,
      postPricesRequestBodyTransformQuantity'Round :: PostPricesRequestBodyTransformQuantity'Round'
postPricesRequestBodyTransformQuantity'Round = PostPricesRequestBodyTransformQuantity'Round'
postPricesRequestBodyTransformQuantity'Round
    }

-- | Defines the enum schema located at @paths.\/v1\/prices.POST.requestBody.content.application\/x-www-form-urlencoded.schema.properties.transform_quantity.properties.round@ in the specification.
data PostPricesRequestBodyTransformQuantity'Round'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    PostPricesRequestBodyTransformQuantity'Round'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.
    PostPricesRequestBodyTransformQuantity'Round'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"down"@
    PostPricesRequestBodyTransformQuantity'Round'EnumDown
  | -- | Represents the JSON value @"up"@
    PostPricesRequestBodyTransformQuantity'Round'EnumUp
  deriving (Int -> PostPricesRequestBodyTransformQuantity'Round' -> ShowS
[PostPricesRequestBodyTransformQuantity'Round'] -> ShowS
PostPricesRequestBodyTransformQuantity'Round' -> String
(Int -> PostPricesRequestBodyTransformQuantity'Round' -> ShowS)
-> (PostPricesRequestBodyTransformQuantity'Round' -> String)
-> ([PostPricesRequestBodyTransformQuantity'Round'] -> ShowS)
-> Show PostPricesRequestBodyTransformQuantity'Round'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostPricesRequestBodyTransformQuantity'Round'] -> ShowS
$cshowList :: [PostPricesRequestBodyTransformQuantity'Round'] -> ShowS
show :: PostPricesRequestBodyTransformQuantity'Round' -> String
$cshow :: PostPricesRequestBodyTransformQuantity'Round' -> String
showsPrec :: Int -> PostPricesRequestBodyTransformQuantity'Round' -> ShowS
$cshowsPrec :: Int -> PostPricesRequestBodyTransformQuantity'Round' -> ShowS
GHC.Show.Show, PostPricesRequestBodyTransformQuantity'Round'
-> PostPricesRequestBodyTransformQuantity'Round' -> Bool
(PostPricesRequestBodyTransformQuantity'Round'
 -> PostPricesRequestBodyTransformQuantity'Round' -> Bool)
-> (PostPricesRequestBodyTransformQuantity'Round'
    -> PostPricesRequestBodyTransformQuantity'Round' -> Bool)
-> Eq PostPricesRequestBodyTransformQuantity'Round'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostPricesRequestBodyTransformQuantity'Round'
-> PostPricesRequestBodyTransformQuantity'Round' -> Bool
$c/= :: PostPricesRequestBodyTransformQuantity'Round'
-> PostPricesRequestBodyTransformQuantity'Round' -> Bool
== :: PostPricesRequestBodyTransformQuantity'Round'
-> PostPricesRequestBodyTransformQuantity'Round' -> Bool
$c== :: PostPricesRequestBodyTransformQuantity'Round'
-> PostPricesRequestBodyTransformQuantity'Round' -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON PostPricesRequestBodyTransformQuantity'Round' where
  toJSON :: PostPricesRequestBodyTransformQuantity'Round' -> Value
toJSON (PostPricesRequestBodyTransformQuantity'Round'Other Value
val) = Value
val
  toJSON (PostPricesRequestBodyTransformQuantity'Round'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (PostPricesRequestBodyTransformQuantity'Round'
PostPricesRequestBodyTransformQuantity'Round'EnumDown) = Value
"down"
  toJSON (PostPricesRequestBodyTransformQuantity'Round'
PostPricesRequestBodyTransformQuantity'Round'EnumUp) = Value
"up"

instance Data.Aeson.Types.FromJSON.FromJSON PostPricesRequestBodyTransformQuantity'Round' where
  parseJSON :: Value -> Parser PostPricesRequestBodyTransformQuantity'Round'
parseJSON Value
val =
    PostPricesRequestBodyTransformQuantity'Round'
-> Parser PostPricesRequestBodyTransformQuantity'Round'
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
"down" -> PostPricesRequestBodyTransformQuantity'Round'
PostPricesRequestBodyTransformQuantity'Round'EnumDown
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"up" -> PostPricesRequestBodyTransformQuantity'Round'
PostPricesRequestBodyTransformQuantity'Round'EnumUp
            | Bool
GHC.Base.otherwise -> Value -> PostPricesRequestBodyTransformQuantity'Round'
PostPricesRequestBodyTransformQuantity'Round'Other Value
val
      )

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