{-# 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 getSubscriptions
module StripeAPI.Operations.GetSubscriptions 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

-- | > GET /v1/subscriptions
--
-- \<p>By default, returns a list of subscriptions that have not been canceled. In order to list canceled subscriptions, specify \<code>status=canceled\<\/code>.\<\/p>
getSubscriptions ::
  forall m.
  StripeAPI.Common.MonadHTTP m =>
  -- | Contains all available parameters of this operation (query and path parameters)
  GetSubscriptionsParameters ->
  -- | Monadic computation which returns the result of the operation
  StripeAPI.Common.StripeT m (Network.HTTP.Client.Types.Response GetSubscriptionsResponse)
getSubscriptions :: GetSubscriptionsParameters
-> StripeT m (Response GetSubscriptionsResponse)
getSubscriptions GetSubscriptionsParameters
parameters =
  (Response ByteString -> Response GetSubscriptionsResponse)
-> StripeT m (Response ByteString)
-> StripeT m (Response GetSubscriptionsResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
    ( \Response ByteString
response_0 ->
        (ByteString -> GetSubscriptionsResponse)
-> Response ByteString -> Response GetSubscriptionsResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
          ( (String -> GetSubscriptionsResponse)
-> (GetSubscriptionsResponse -> GetSubscriptionsResponse)
-> Either String GetSubscriptionsResponse
-> GetSubscriptionsResponse
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Data.Either.either String -> GetSubscriptionsResponse
GetSubscriptionsResponseError GetSubscriptionsResponse -> GetSubscriptionsResponse
forall a. a -> a
GHC.Base.id
              (Either String GetSubscriptionsResponse
 -> GetSubscriptionsResponse)
-> (ByteString -> Either String GetSubscriptionsResponse)
-> ByteString
-> GetSubscriptionsResponse
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) ->
                                   GetSubscriptionsResponseBody200 -> GetSubscriptionsResponse
GetSubscriptionsResponse200
                                     (GetSubscriptionsResponseBody200 -> GetSubscriptionsResponse)
-> Either String GetSubscriptionsResponseBody200
-> Either String GetSubscriptionsResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> ( ByteString -> Either String GetSubscriptionsResponseBody200
forall a. FromJSON a => ByteString -> Either String a
Data.Aeson.eitherDecodeStrict ByteString
body ::
                                                          Data.Either.Either
                                                            GHC.Base.String
                                                            GetSubscriptionsResponseBody200
                                                      )
                                 | 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 -> GetSubscriptionsResponse
GetSubscriptionsResponseDefault
                                     (Error -> GetSubscriptionsResponse)
-> Either String Error -> Either String GetSubscriptionsResponse
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 GetSubscriptionsResponse
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] -> StripeT m (Response ByteString)
forall (m :: * -> *).
MonadHTTP m =>
Text -> Text -> [QueryParameter] -> StripeT m (Response ByteString)
StripeAPI.Common.doCallWithConfigurationM
        (Text -> Text
Data.Text.toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
GHC.Base.$ String -> Text
Data.Text.pack String
"GET")
        (String -> Text
Data.Text.pack String
"/v1/subscriptions")
        [ Text -> Maybe Value -> Text -> Bool -> QueryParameter
StripeAPI.Common.QueryParameter (String -> Text
Data.Text.pack String
"collection_method") (GetSubscriptionsParametersQueryCollectionMethod' -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (GetSubscriptionsParametersQueryCollectionMethod' -> Value)
-> Maybe GetSubscriptionsParametersQueryCollectionMethod'
-> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> GetSubscriptionsParameters
-> Maybe GetSubscriptionsParametersQueryCollectionMethod'
getSubscriptionsParametersQueryCollectionMethod GetSubscriptionsParameters
parameters) (String -> Text
Data.Text.pack String
"form") Bool
GHC.Types.True,
          Text -> Maybe Value -> Text -> Bool -> QueryParameter
StripeAPI.Common.QueryParameter (String -> Text
Data.Text.pack String
"created") (GetSubscriptionsParametersQueryCreated'Variants -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (GetSubscriptionsParametersQueryCreated'Variants -> Value)
-> Maybe GetSubscriptionsParametersQueryCreated'Variants
-> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> GetSubscriptionsParameters
-> Maybe GetSubscriptionsParametersQueryCreated'Variants
getSubscriptionsParametersQueryCreated GetSubscriptionsParameters
parameters) (String -> Text
Data.Text.pack String
"deepObject") Bool
GHC.Types.True,
          Text -> Maybe Value -> Text -> Bool -> QueryParameter
StripeAPI.Common.QueryParameter (String -> Text
Data.Text.pack String
"current_period_end") (GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants -> Value)
-> Maybe GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
-> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> GetSubscriptionsParameters
-> Maybe GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
getSubscriptionsParametersQueryCurrentPeriodEnd GetSubscriptionsParameters
parameters) (String -> Text
Data.Text.pack String
"deepObject") Bool
GHC.Types.True,
          Text -> Maybe Value -> Text -> Bool -> QueryParameter
StripeAPI.Common.QueryParameter (String -> Text
Data.Text.pack String
"current_period_start") (GetSubscriptionsParametersQueryCurrentPeriodStart'Variants -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
 -> Value)
-> Maybe GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
-> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> GetSubscriptionsParameters
-> Maybe GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
getSubscriptionsParametersQueryCurrentPeriodStart GetSubscriptionsParameters
parameters) (String -> Text
Data.Text.pack String
"deepObject") Bool
GHC.Types.True,
          Text -> Maybe Value -> Text -> Bool -> QueryParameter
StripeAPI.Common.QueryParameter (String -> Text
Data.Text.pack String
"customer") (Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> GetSubscriptionsParameters -> Maybe Text
getSubscriptionsParametersQueryCustomer GetSubscriptionsParameters
parameters) (String -> Text
Data.Text.pack String
"form") Bool
GHC.Types.True,
          Text -> Maybe Value -> Text -> Bool -> QueryParameter
StripeAPI.Common.QueryParameter (String -> Text
Data.Text.pack String
"ending_before") (Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> GetSubscriptionsParameters -> Maybe Text
getSubscriptionsParametersQueryEndingBefore GetSubscriptionsParameters
parameters) (String -> Text
Data.Text.pack String
"form") Bool
GHC.Types.True,
          Text -> Maybe Value -> Text -> Bool -> QueryParameter
StripeAPI.Common.QueryParameter (String -> Text
Data.Text.pack String
"expand") ([Text] -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON ([Text] -> Value) -> Maybe [Text] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> GetSubscriptionsParameters -> Maybe [Text]
getSubscriptionsParametersQueryExpand GetSubscriptionsParameters
parameters) (String -> Text
Data.Text.pack String
"deepObject") Bool
GHC.Types.True,
          Text -> Maybe Value -> Text -> Bool -> QueryParameter
StripeAPI.Common.QueryParameter (String -> Text
Data.Text.pack String
"limit") (Int -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (Int -> Value) -> Maybe Int -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> GetSubscriptionsParameters -> Maybe Int
getSubscriptionsParametersQueryLimit GetSubscriptionsParameters
parameters) (String -> Text
Data.Text.pack String
"form") Bool
GHC.Types.True,
          Text -> Maybe Value -> Text -> Bool -> QueryParameter
StripeAPI.Common.QueryParameter (String -> Text
Data.Text.pack String
"price") (Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> GetSubscriptionsParameters -> Maybe Text
getSubscriptionsParametersQueryPrice GetSubscriptionsParameters
parameters) (String -> Text
Data.Text.pack String
"form") Bool
GHC.Types.True,
          Text -> Maybe Value -> Text -> Bool -> QueryParameter
StripeAPI.Common.QueryParameter (String -> Text
Data.Text.pack String
"starting_after") (Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> GetSubscriptionsParameters -> Maybe Text
getSubscriptionsParametersQueryStartingAfter GetSubscriptionsParameters
parameters) (String -> Text
Data.Text.pack String
"form") Bool
GHC.Types.True,
          Text -> Maybe Value -> Text -> Bool -> QueryParameter
StripeAPI.Common.QueryParameter (String -> Text
Data.Text.pack String
"status") (GetSubscriptionsParametersQueryStatus' -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (GetSubscriptionsParametersQueryStatus' -> Value)
-> Maybe GetSubscriptionsParametersQueryStatus' -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> GetSubscriptionsParameters
-> Maybe GetSubscriptionsParametersQueryStatus'
getSubscriptionsParametersQueryStatus GetSubscriptionsParameters
parameters) (String -> Text
Data.Text.pack String
"form") Bool
GHC.Types.True
        ]
    )

-- | Defines the object schema located at @paths.\/v1\/subscriptions.GET.parameters@ in the specification.
data GetSubscriptionsParameters = GetSubscriptionsParameters
  { -- | queryCollection_method: Represents the parameter named \'collection_method\'
    --
    -- The collection method of the subscriptions to retrieve. Either \`charge_automatically\` or \`send_invoice\`.
    GetSubscriptionsParameters
-> Maybe GetSubscriptionsParametersQueryCollectionMethod'
getSubscriptionsParametersQueryCollectionMethod :: (GHC.Maybe.Maybe GetSubscriptionsParametersQueryCollectionMethod'),
    -- | queryCreated: Represents the parameter named \'created\'
    GetSubscriptionsParameters
-> Maybe GetSubscriptionsParametersQueryCreated'Variants
getSubscriptionsParametersQueryCreated :: (GHC.Maybe.Maybe GetSubscriptionsParametersQueryCreated'Variants),
    -- | queryCurrent_period_end: Represents the parameter named \'current_period_end\'
    GetSubscriptionsParameters
-> Maybe GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
getSubscriptionsParametersQueryCurrentPeriodEnd :: (GHC.Maybe.Maybe GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants),
    -- | queryCurrent_period_start: Represents the parameter named \'current_period_start\'
    GetSubscriptionsParameters
-> Maybe GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
getSubscriptionsParametersQueryCurrentPeriodStart :: (GHC.Maybe.Maybe GetSubscriptionsParametersQueryCurrentPeriodStart'Variants),
    -- | queryCustomer: Represents the parameter named \'customer\'
    --
    -- The ID of the customer whose subscriptions will be retrieved.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    GetSubscriptionsParameters -> Maybe Text
getSubscriptionsParametersQueryCustomer :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | queryEnding_before: Represents the parameter named \'ending_before\'
    --
    -- A cursor for use in pagination. \`ending_before\` is an object ID that defines your place in the list. For instance, if you make a list request and receive 100 objects, starting with \`obj_bar\`, your subsequent call can include \`ending_before=obj_bar\` in order to fetch the previous page of the list.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    GetSubscriptionsParameters -> Maybe Text
getSubscriptionsParametersQueryEndingBefore :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | queryExpand: Represents the parameter named \'expand\'
    --
    -- Specifies which fields in the response should be expanded.
    GetSubscriptionsParameters -> Maybe [Text]
getSubscriptionsParametersQueryExpand :: (GHC.Maybe.Maybe ([Data.Text.Internal.Text])),
    -- | queryLimit: Represents the parameter named \'limit\'
    --
    -- A limit on the number of objects to be returned. Limit can range between 1 and 100, and the default is 10.
    GetSubscriptionsParameters -> Maybe Int
getSubscriptionsParametersQueryLimit :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | queryPrice: Represents the parameter named \'price\'
    --
    -- Filter for subscriptions that contain this recurring price ID.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    GetSubscriptionsParameters -> Maybe Text
getSubscriptionsParametersQueryPrice :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | queryStarting_after: Represents the parameter named \'starting_after\'
    --
    -- A cursor for use in pagination. \`starting_after\` is an object ID that defines your place in the list. For instance, if you make a list request and receive 100 objects, ending with \`obj_foo\`, your subsequent call can include \`starting_after=obj_foo\` in order to fetch the next page of the list.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    GetSubscriptionsParameters -> Maybe Text
getSubscriptionsParametersQueryStartingAfter :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | queryStatus: Represents the parameter named \'status\'
    --
    -- The status of the subscriptions to retrieve. Passing in a value of \`canceled\` will return all canceled subscriptions, including those belonging to deleted customers. Pass \`ended\` to find subscriptions that are canceled and subscriptions that are expired due to [incomplete payment](https:\/\/stripe.com\/docs\/billing\/subscriptions\/overview\#subscription-statuses). Passing in a value of \`all\` will return subscriptions of all statuses. If no value is supplied, all subscriptions that have not been canceled are returned.
    GetSubscriptionsParameters
-> Maybe GetSubscriptionsParametersQueryStatus'
getSubscriptionsParametersQueryStatus :: (GHC.Maybe.Maybe GetSubscriptionsParametersQueryStatus')
  }
  deriving
    ( Int -> GetSubscriptionsParameters -> ShowS
[GetSubscriptionsParameters] -> ShowS
GetSubscriptionsParameters -> String
(Int -> GetSubscriptionsParameters -> ShowS)
-> (GetSubscriptionsParameters -> String)
-> ([GetSubscriptionsParameters] -> ShowS)
-> Show GetSubscriptionsParameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSubscriptionsParameters] -> ShowS
$cshowList :: [GetSubscriptionsParameters] -> ShowS
show :: GetSubscriptionsParameters -> String
$cshow :: GetSubscriptionsParameters -> String
showsPrec :: Int -> GetSubscriptionsParameters -> ShowS
$cshowsPrec :: Int -> GetSubscriptionsParameters -> ShowS
GHC.Show.Show,
      GetSubscriptionsParameters -> GetSubscriptionsParameters -> Bool
(GetSubscriptionsParameters -> GetSubscriptionsParameters -> Bool)
-> (GetSubscriptionsParameters
    -> GetSubscriptionsParameters -> Bool)
-> Eq GetSubscriptionsParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSubscriptionsParameters -> GetSubscriptionsParameters -> Bool
$c/= :: GetSubscriptionsParameters -> GetSubscriptionsParameters -> Bool
== :: GetSubscriptionsParameters -> GetSubscriptionsParameters -> Bool
$c== :: GetSubscriptionsParameters -> GetSubscriptionsParameters -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON GetSubscriptionsParameters where
  toJSON :: GetSubscriptionsParameters -> Value
toJSON GetSubscriptionsParameters
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"queryCollection_method" Text
-> Maybe GetSubscriptionsParametersQueryCollectionMethod' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParameters
-> Maybe GetSubscriptionsParametersQueryCollectionMethod'
getSubscriptionsParametersQueryCollectionMethod GetSubscriptionsParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryCreated" Text
-> Maybe GetSubscriptionsParametersQueryCreated'Variants -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParameters
-> Maybe GetSubscriptionsParametersQueryCreated'Variants
getSubscriptionsParametersQueryCreated GetSubscriptionsParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryCurrent_period_end" Text
-> Maybe GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParameters
-> Maybe GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
getSubscriptionsParametersQueryCurrentPeriodEnd GetSubscriptionsParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryCurrent_period_start" Text
-> Maybe GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParameters
-> Maybe GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
getSubscriptionsParametersQueryCurrentPeriodStart GetSubscriptionsParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryCustomer" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParameters -> Maybe Text
getSubscriptionsParametersQueryCustomer GetSubscriptionsParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryEnding_before" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParameters -> Maybe Text
getSubscriptionsParametersQueryEndingBefore GetSubscriptionsParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryExpand" Text -> Maybe [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParameters -> Maybe [Text]
getSubscriptionsParametersQueryExpand GetSubscriptionsParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryLimit" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParameters -> Maybe Int
getSubscriptionsParametersQueryLimit GetSubscriptionsParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryPrice" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParameters -> Maybe Text
getSubscriptionsParametersQueryPrice GetSubscriptionsParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryStarting_after" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParameters -> Maybe Text
getSubscriptionsParametersQueryStartingAfter GetSubscriptionsParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryStatus" Text -> Maybe GetSubscriptionsParametersQueryStatus' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParameters
-> Maybe GetSubscriptionsParametersQueryStatus'
getSubscriptionsParametersQueryStatus GetSubscriptionsParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: GetSubscriptionsParameters -> Encoding
toEncoding GetSubscriptionsParameters
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"queryCollection_method" Text
-> Maybe GetSubscriptionsParametersQueryCollectionMethod' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParameters
-> Maybe GetSubscriptionsParametersQueryCollectionMethod'
getSubscriptionsParametersQueryCollectionMethod GetSubscriptionsParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"queryCreated" Text
-> Maybe GetSubscriptionsParametersQueryCreated'Variants -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParameters
-> Maybe GetSubscriptionsParametersQueryCreated'Variants
getSubscriptionsParametersQueryCreated GetSubscriptionsParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"queryCurrent_period_end" Text
-> Maybe GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParameters
-> Maybe GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
getSubscriptionsParametersQueryCurrentPeriodEnd GetSubscriptionsParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"queryCurrent_period_start" Text
-> Maybe GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParameters
-> Maybe GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
getSubscriptionsParametersQueryCurrentPeriodStart GetSubscriptionsParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"queryCustomer" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParameters -> Maybe Text
getSubscriptionsParametersQueryCustomer GetSubscriptionsParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"queryEnding_before" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParameters -> Maybe Text
getSubscriptionsParametersQueryEndingBefore GetSubscriptionsParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"queryExpand" Text -> Maybe [Text] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParameters -> Maybe [Text]
getSubscriptionsParametersQueryExpand GetSubscriptionsParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"queryLimit" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParameters -> Maybe Int
getSubscriptionsParametersQueryLimit GetSubscriptionsParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"queryPrice" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParameters -> Maybe Text
getSubscriptionsParametersQueryPrice GetSubscriptionsParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"queryStarting_after" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParameters -> Maybe Text
getSubscriptionsParametersQueryStartingAfter GetSubscriptionsParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"queryStatus" Text -> Maybe GetSubscriptionsParametersQueryStatus' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParameters
-> Maybe GetSubscriptionsParametersQueryStatus'
getSubscriptionsParametersQueryStatus GetSubscriptionsParameters
obj)))))))))))

instance Data.Aeson.Types.FromJSON.FromJSON GetSubscriptionsParameters where
  parseJSON :: Value -> Parser GetSubscriptionsParameters
parseJSON = String
-> (Object -> Parser GetSubscriptionsParameters)
-> Value
-> Parser GetSubscriptionsParameters
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"GetSubscriptionsParameters" (\Object
obj -> (((((((((((Maybe GetSubscriptionsParametersQueryCollectionMethod'
 -> Maybe GetSubscriptionsParametersQueryCreated'Variants
 -> Maybe GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
 -> Maybe GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
 -> Maybe Text
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe Int
 -> Maybe Text
 -> Maybe Text
 -> Maybe GetSubscriptionsParametersQueryStatus'
 -> GetSubscriptionsParameters)
-> Parser
     (Maybe GetSubscriptionsParametersQueryCollectionMethod'
      -> Maybe GetSubscriptionsParametersQueryCreated'Variants
      -> Maybe GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
      -> Maybe GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe GetSubscriptionsParametersQueryStatus'
      -> GetSubscriptionsParameters)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe GetSubscriptionsParametersQueryCollectionMethod'
-> Maybe GetSubscriptionsParametersQueryCreated'Variants
-> Maybe GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
-> Maybe GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe GetSubscriptionsParametersQueryStatus'
-> GetSubscriptionsParameters
GetSubscriptionsParameters Parser
  (Maybe GetSubscriptionsParametersQueryCollectionMethod'
   -> Maybe GetSubscriptionsParametersQueryCreated'Variants
   -> Maybe GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
   -> Maybe GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe GetSubscriptionsParametersQueryStatus'
   -> GetSubscriptionsParameters)
-> Parser (Maybe GetSubscriptionsParametersQueryCollectionMethod')
-> Parser
     (Maybe GetSubscriptionsParametersQueryCreated'Variants
      -> Maybe GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
      -> Maybe GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe GetSubscriptionsParametersQueryStatus'
      -> GetSubscriptionsParameters)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe GetSubscriptionsParametersQueryCollectionMethod')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"queryCollection_method")) Parser
  (Maybe GetSubscriptionsParametersQueryCreated'Variants
   -> Maybe GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
   -> Maybe GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe GetSubscriptionsParametersQueryStatus'
   -> GetSubscriptionsParameters)
-> Parser (Maybe GetSubscriptionsParametersQueryCreated'Variants)
-> Parser
     (Maybe GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
      -> Maybe GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe GetSubscriptionsParametersQueryStatus'
      -> GetSubscriptionsParameters)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe GetSubscriptionsParametersQueryCreated'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"queryCreated")) Parser
  (Maybe GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
   -> Maybe GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe GetSubscriptionsParametersQueryStatus'
   -> GetSubscriptionsParameters)
-> Parser
     (Maybe GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants)
-> Parser
     (Maybe GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe GetSubscriptionsParametersQueryStatus'
      -> GetSubscriptionsParameters)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"queryCurrent_period_end")) Parser
  (Maybe GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe GetSubscriptionsParametersQueryStatus'
   -> GetSubscriptionsParameters)
-> Parser
     (Maybe GetSubscriptionsParametersQueryCurrentPeriodStart'Variants)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe GetSubscriptionsParametersQueryStatus'
      -> GetSubscriptionsParameters)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe GetSubscriptionsParametersQueryCurrentPeriodStart'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"queryCurrent_period_start")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe GetSubscriptionsParametersQueryStatus'
   -> GetSubscriptionsParameters)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe GetSubscriptionsParametersQueryStatus'
      -> GetSubscriptionsParameters)
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
"queryCustomer")) Parser
  (Maybe Text
   -> Maybe [Text]
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe GetSubscriptionsParametersQueryStatus'
   -> GetSubscriptionsParameters)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text]
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe GetSubscriptionsParametersQueryStatus'
      -> GetSubscriptionsParameters)
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
"queryEnding_before")) Parser
  (Maybe [Text]
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe GetSubscriptionsParametersQueryStatus'
   -> GetSubscriptionsParameters)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe GetSubscriptionsParametersQueryStatus'
      -> GetSubscriptionsParameters)
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
"queryExpand")) Parser
  (Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe GetSubscriptionsParametersQueryStatus'
   -> GetSubscriptionsParameters)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe GetSubscriptionsParametersQueryStatus'
      -> GetSubscriptionsParameters)
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
"queryLimit")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe GetSubscriptionsParametersQueryStatus'
   -> GetSubscriptionsParameters)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe GetSubscriptionsParametersQueryStatus'
      -> GetSubscriptionsParameters)
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
"queryPrice")) Parser
  (Maybe Text
   -> Maybe GetSubscriptionsParametersQueryStatus'
   -> GetSubscriptionsParameters)
-> Parser (Maybe Text)
-> Parser
     (Maybe GetSubscriptionsParametersQueryStatus'
      -> GetSubscriptionsParameters)
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
"queryStarting_after")) Parser
  (Maybe GetSubscriptionsParametersQueryStatus'
   -> GetSubscriptionsParameters)
-> Parser (Maybe GetSubscriptionsParametersQueryStatus')
-> Parser GetSubscriptionsParameters
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe GetSubscriptionsParametersQueryStatus')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"queryStatus"))

-- | Create a new 'GetSubscriptionsParameters' with all required fields.
mkGetSubscriptionsParameters :: GetSubscriptionsParameters
mkGetSubscriptionsParameters :: GetSubscriptionsParameters
mkGetSubscriptionsParameters =
  GetSubscriptionsParameters :: Maybe GetSubscriptionsParametersQueryCollectionMethod'
-> Maybe GetSubscriptionsParametersQueryCreated'Variants
-> Maybe GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
-> Maybe GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe GetSubscriptionsParametersQueryStatus'
-> GetSubscriptionsParameters
GetSubscriptionsParameters
    { getSubscriptionsParametersQueryCollectionMethod :: Maybe GetSubscriptionsParametersQueryCollectionMethod'
getSubscriptionsParametersQueryCollectionMethod = Maybe GetSubscriptionsParametersQueryCollectionMethod'
forall a. Maybe a
GHC.Maybe.Nothing,
      getSubscriptionsParametersQueryCreated :: Maybe GetSubscriptionsParametersQueryCreated'Variants
getSubscriptionsParametersQueryCreated = Maybe GetSubscriptionsParametersQueryCreated'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      getSubscriptionsParametersQueryCurrentPeriodEnd :: Maybe GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
getSubscriptionsParametersQueryCurrentPeriodEnd = Maybe GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      getSubscriptionsParametersQueryCurrentPeriodStart :: Maybe GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
getSubscriptionsParametersQueryCurrentPeriodStart = Maybe GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      getSubscriptionsParametersQueryCustomer :: Maybe Text
getSubscriptionsParametersQueryCustomer = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      getSubscriptionsParametersQueryEndingBefore :: Maybe Text
getSubscriptionsParametersQueryEndingBefore = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      getSubscriptionsParametersQueryExpand :: Maybe [Text]
getSubscriptionsParametersQueryExpand = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing,
      getSubscriptionsParametersQueryLimit :: Maybe Int
getSubscriptionsParametersQueryLimit = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      getSubscriptionsParametersQueryPrice :: Maybe Text
getSubscriptionsParametersQueryPrice = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      getSubscriptionsParametersQueryStartingAfter :: Maybe Text
getSubscriptionsParametersQueryStartingAfter = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      getSubscriptionsParametersQueryStatus :: Maybe GetSubscriptionsParametersQueryStatus'
getSubscriptionsParametersQueryStatus = Maybe GetSubscriptionsParametersQueryStatus'
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the enum schema located at @paths.\/v1\/subscriptions.GET.parameters.properties.queryCollection_method@ in the specification.
--
-- Represents the parameter named \'collection_method\'
--
-- The collection method of the subscriptions to retrieve. Either \`charge_automatically\` or \`send_invoice\`.
data GetSubscriptionsParametersQueryCollectionMethod'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    GetSubscriptionsParametersQueryCollectionMethod'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.
    GetSubscriptionsParametersQueryCollectionMethod'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"charge_automatically"@
    GetSubscriptionsParametersQueryCollectionMethod'EnumChargeAutomatically
  | -- | Represents the JSON value @"send_invoice"@
    GetSubscriptionsParametersQueryCollectionMethod'EnumSendInvoice
  deriving (Int -> GetSubscriptionsParametersQueryCollectionMethod' -> ShowS
[GetSubscriptionsParametersQueryCollectionMethod'] -> ShowS
GetSubscriptionsParametersQueryCollectionMethod' -> String
(Int -> GetSubscriptionsParametersQueryCollectionMethod' -> ShowS)
-> (GetSubscriptionsParametersQueryCollectionMethod' -> String)
-> ([GetSubscriptionsParametersQueryCollectionMethod'] -> ShowS)
-> Show GetSubscriptionsParametersQueryCollectionMethod'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSubscriptionsParametersQueryCollectionMethod'] -> ShowS
$cshowList :: [GetSubscriptionsParametersQueryCollectionMethod'] -> ShowS
show :: GetSubscriptionsParametersQueryCollectionMethod' -> String
$cshow :: GetSubscriptionsParametersQueryCollectionMethod' -> String
showsPrec :: Int -> GetSubscriptionsParametersQueryCollectionMethod' -> ShowS
$cshowsPrec :: Int -> GetSubscriptionsParametersQueryCollectionMethod' -> ShowS
GHC.Show.Show, GetSubscriptionsParametersQueryCollectionMethod'
-> GetSubscriptionsParametersQueryCollectionMethod' -> Bool
(GetSubscriptionsParametersQueryCollectionMethod'
 -> GetSubscriptionsParametersQueryCollectionMethod' -> Bool)
-> (GetSubscriptionsParametersQueryCollectionMethod'
    -> GetSubscriptionsParametersQueryCollectionMethod' -> Bool)
-> Eq GetSubscriptionsParametersQueryCollectionMethod'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSubscriptionsParametersQueryCollectionMethod'
-> GetSubscriptionsParametersQueryCollectionMethod' -> Bool
$c/= :: GetSubscriptionsParametersQueryCollectionMethod'
-> GetSubscriptionsParametersQueryCollectionMethod' -> Bool
== :: GetSubscriptionsParametersQueryCollectionMethod'
-> GetSubscriptionsParametersQueryCollectionMethod' -> Bool
$c== :: GetSubscriptionsParametersQueryCollectionMethod'
-> GetSubscriptionsParametersQueryCollectionMethod' -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON GetSubscriptionsParametersQueryCollectionMethod' where
  toJSON :: GetSubscriptionsParametersQueryCollectionMethod' -> Value
toJSON (GetSubscriptionsParametersQueryCollectionMethod'Other Value
val) = Value
val
  toJSON (GetSubscriptionsParametersQueryCollectionMethod'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (GetSubscriptionsParametersQueryCollectionMethod'
GetSubscriptionsParametersQueryCollectionMethod'EnumChargeAutomatically) = Value
"charge_automatically"
  toJSON (GetSubscriptionsParametersQueryCollectionMethod'
GetSubscriptionsParametersQueryCollectionMethod'EnumSendInvoice) = Value
"send_invoice"

instance Data.Aeson.Types.FromJSON.FromJSON GetSubscriptionsParametersQueryCollectionMethod' where
  parseJSON :: Value -> Parser GetSubscriptionsParametersQueryCollectionMethod'
parseJSON Value
val =
    GetSubscriptionsParametersQueryCollectionMethod'
-> Parser GetSubscriptionsParametersQueryCollectionMethod'
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
"charge_automatically" -> GetSubscriptionsParametersQueryCollectionMethod'
GetSubscriptionsParametersQueryCollectionMethod'EnumChargeAutomatically
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"send_invoice" -> GetSubscriptionsParametersQueryCollectionMethod'
GetSubscriptionsParametersQueryCollectionMethod'EnumSendInvoice
            | Bool
GHC.Base.otherwise -> Value -> GetSubscriptionsParametersQueryCollectionMethod'
GetSubscriptionsParametersQueryCollectionMethod'Other Value
val
      )

-- | Defines the object schema located at @paths.\/v1\/subscriptions.GET.parameters.properties.queryCreated.anyOf@ in the specification.
data GetSubscriptionsParametersQueryCreated'OneOf1 = GetSubscriptionsParametersQueryCreated'OneOf1
  { -- | gt
    GetSubscriptionsParametersQueryCreated'OneOf1 -> Maybe Int
getSubscriptionsParametersQueryCreated'OneOf1Gt :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | gte
    GetSubscriptionsParametersQueryCreated'OneOf1 -> Maybe Int
getSubscriptionsParametersQueryCreated'OneOf1Gte :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | lt
    GetSubscriptionsParametersQueryCreated'OneOf1 -> Maybe Int
getSubscriptionsParametersQueryCreated'OneOf1Lt :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | lte
    GetSubscriptionsParametersQueryCreated'OneOf1 -> Maybe Int
getSubscriptionsParametersQueryCreated'OneOf1Lte :: (GHC.Maybe.Maybe GHC.Types.Int)
  }
  deriving
    ( Int -> GetSubscriptionsParametersQueryCreated'OneOf1 -> ShowS
[GetSubscriptionsParametersQueryCreated'OneOf1] -> ShowS
GetSubscriptionsParametersQueryCreated'OneOf1 -> String
(Int -> GetSubscriptionsParametersQueryCreated'OneOf1 -> ShowS)
-> (GetSubscriptionsParametersQueryCreated'OneOf1 -> String)
-> ([GetSubscriptionsParametersQueryCreated'OneOf1] -> ShowS)
-> Show GetSubscriptionsParametersQueryCreated'OneOf1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSubscriptionsParametersQueryCreated'OneOf1] -> ShowS
$cshowList :: [GetSubscriptionsParametersQueryCreated'OneOf1] -> ShowS
show :: GetSubscriptionsParametersQueryCreated'OneOf1 -> String
$cshow :: GetSubscriptionsParametersQueryCreated'OneOf1 -> String
showsPrec :: Int -> GetSubscriptionsParametersQueryCreated'OneOf1 -> ShowS
$cshowsPrec :: Int -> GetSubscriptionsParametersQueryCreated'OneOf1 -> ShowS
GHC.Show.Show,
      GetSubscriptionsParametersQueryCreated'OneOf1
-> GetSubscriptionsParametersQueryCreated'OneOf1 -> Bool
(GetSubscriptionsParametersQueryCreated'OneOf1
 -> GetSubscriptionsParametersQueryCreated'OneOf1 -> Bool)
-> (GetSubscriptionsParametersQueryCreated'OneOf1
    -> GetSubscriptionsParametersQueryCreated'OneOf1 -> Bool)
-> Eq GetSubscriptionsParametersQueryCreated'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSubscriptionsParametersQueryCreated'OneOf1
-> GetSubscriptionsParametersQueryCreated'OneOf1 -> Bool
$c/= :: GetSubscriptionsParametersQueryCreated'OneOf1
-> GetSubscriptionsParametersQueryCreated'OneOf1 -> Bool
== :: GetSubscriptionsParametersQueryCreated'OneOf1
-> GetSubscriptionsParametersQueryCreated'OneOf1 -> Bool
$c== :: GetSubscriptionsParametersQueryCreated'OneOf1
-> GetSubscriptionsParametersQueryCreated'OneOf1 -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON GetSubscriptionsParametersQueryCreated'OneOf1 where
  toJSON :: GetSubscriptionsParametersQueryCreated'OneOf1 -> Value
toJSON GetSubscriptionsParametersQueryCreated'OneOf1
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"gt" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParametersQueryCreated'OneOf1 -> Maybe Int
getSubscriptionsParametersQueryCreated'OneOf1Gt GetSubscriptionsParametersQueryCreated'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"gte" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParametersQueryCreated'OneOf1 -> Maybe Int
getSubscriptionsParametersQueryCreated'OneOf1Gte GetSubscriptionsParametersQueryCreated'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"lt" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParametersQueryCreated'OneOf1 -> Maybe Int
getSubscriptionsParametersQueryCreated'OneOf1Lt GetSubscriptionsParametersQueryCreated'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"lte" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParametersQueryCreated'OneOf1 -> Maybe Int
getSubscriptionsParametersQueryCreated'OneOf1Lte GetSubscriptionsParametersQueryCreated'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: GetSubscriptionsParametersQueryCreated'OneOf1 -> Encoding
toEncoding GetSubscriptionsParametersQueryCreated'OneOf1
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"gt" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParametersQueryCreated'OneOf1 -> Maybe Int
getSubscriptionsParametersQueryCreated'OneOf1Gt GetSubscriptionsParametersQueryCreated'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"gte" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParametersQueryCreated'OneOf1 -> Maybe Int
getSubscriptionsParametersQueryCreated'OneOf1Gte GetSubscriptionsParametersQueryCreated'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"lt" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParametersQueryCreated'OneOf1 -> Maybe Int
getSubscriptionsParametersQueryCreated'OneOf1Lt GetSubscriptionsParametersQueryCreated'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"lte" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParametersQueryCreated'OneOf1 -> Maybe Int
getSubscriptionsParametersQueryCreated'OneOf1Lte GetSubscriptionsParametersQueryCreated'OneOf1
obj))))

instance Data.Aeson.Types.FromJSON.FromJSON GetSubscriptionsParametersQueryCreated'OneOf1 where
  parseJSON :: Value -> Parser GetSubscriptionsParametersQueryCreated'OneOf1
parseJSON = String
-> (Object -> Parser GetSubscriptionsParametersQueryCreated'OneOf1)
-> Value
-> Parser GetSubscriptionsParametersQueryCreated'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"GetSubscriptionsParametersQueryCreated'OneOf1" (\Object
obj -> ((((Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> GetSubscriptionsParametersQueryCreated'OneOf1)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> GetSubscriptionsParametersQueryCreated'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> GetSubscriptionsParametersQueryCreated'OneOf1
GetSubscriptionsParametersQueryCreated'OneOf1 Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> GetSubscriptionsParametersQueryCreated'OneOf1)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> GetSubscriptionsParametersQueryCreated'OneOf1)
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
"gt")) Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> GetSubscriptionsParametersQueryCreated'OneOf1)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Int -> GetSubscriptionsParametersQueryCreated'OneOf1)
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
"gte")) Parser
  (Maybe Int
   -> Maybe Int -> GetSubscriptionsParametersQueryCreated'OneOf1)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int -> GetSubscriptionsParametersQueryCreated'OneOf1)
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
"lt")) Parser (Maybe Int -> GetSubscriptionsParametersQueryCreated'OneOf1)
-> Parser (Maybe Int)
-> Parser GetSubscriptionsParametersQueryCreated'OneOf1
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
"lte"))

-- | Create a new 'GetSubscriptionsParametersQueryCreated'OneOf1' with all required fields.
mkGetSubscriptionsParametersQueryCreated'OneOf1 :: GetSubscriptionsParametersQueryCreated'OneOf1
mkGetSubscriptionsParametersQueryCreated'OneOf1 :: GetSubscriptionsParametersQueryCreated'OneOf1
mkGetSubscriptionsParametersQueryCreated'OneOf1 =
  GetSubscriptionsParametersQueryCreated'OneOf1 :: Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> GetSubscriptionsParametersQueryCreated'OneOf1
GetSubscriptionsParametersQueryCreated'OneOf1
    { getSubscriptionsParametersQueryCreated'OneOf1Gt :: Maybe Int
getSubscriptionsParametersQueryCreated'OneOf1Gt = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      getSubscriptionsParametersQueryCreated'OneOf1Gte :: Maybe Int
getSubscriptionsParametersQueryCreated'OneOf1Gte = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      getSubscriptionsParametersQueryCreated'OneOf1Lt :: Maybe Int
getSubscriptionsParametersQueryCreated'OneOf1Lt = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      getSubscriptionsParametersQueryCreated'OneOf1Lte :: Maybe Int
getSubscriptionsParametersQueryCreated'OneOf1Lte = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the oneOf schema located at @paths.\/v1\/subscriptions.GET.parameters.properties.queryCreated.anyOf@ in the specification.
--
-- Represents the parameter named \'created\'
data GetSubscriptionsParametersQueryCreated'Variants
  = GetSubscriptionsParametersQueryCreated'GetSubscriptionsParametersQueryCreated'OneOf1 GetSubscriptionsParametersQueryCreated'OneOf1
  | GetSubscriptionsParametersQueryCreated'Int GHC.Types.Int
  deriving (Int -> GetSubscriptionsParametersQueryCreated'Variants -> ShowS
[GetSubscriptionsParametersQueryCreated'Variants] -> ShowS
GetSubscriptionsParametersQueryCreated'Variants -> String
(Int -> GetSubscriptionsParametersQueryCreated'Variants -> ShowS)
-> (GetSubscriptionsParametersQueryCreated'Variants -> String)
-> ([GetSubscriptionsParametersQueryCreated'Variants] -> ShowS)
-> Show GetSubscriptionsParametersQueryCreated'Variants
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSubscriptionsParametersQueryCreated'Variants] -> ShowS
$cshowList :: [GetSubscriptionsParametersQueryCreated'Variants] -> ShowS
show :: GetSubscriptionsParametersQueryCreated'Variants -> String
$cshow :: GetSubscriptionsParametersQueryCreated'Variants -> String
showsPrec :: Int -> GetSubscriptionsParametersQueryCreated'Variants -> ShowS
$cshowsPrec :: Int -> GetSubscriptionsParametersQueryCreated'Variants -> ShowS
GHC.Show.Show, GetSubscriptionsParametersQueryCreated'Variants
-> GetSubscriptionsParametersQueryCreated'Variants -> Bool
(GetSubscriptionsParametersQueryCreated'Variants
 -> GetSubscriptionsParametersQueryCreated'Variants -> Bool)
-> (GetSubscriptionsParametersQueryCreated'Variants
    -> GetSubscriptionsParametersQueryCreated'Variants -> Bool)
-> Eq GetSubscriptionsParametersQueryCreated'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSubscriptionsParametersQueryCreated'Variants
-> GetSubscriptionsParametersQueryCreated'Variants -> Bool
$c/= :: GetSubscriptionsParametersQueryCreated'Variants
-> GetSubscriptionsParametersQueryCreated'Variants -> Bool
== :: GetSubscriptionsParametersQueryCreated'Variants
-> GetSubscriptionsParametersQueryCreated'Variants -> Bool
$c== :: GetSubscriptionsParametersQueryCreated'Variants
-> GetSubscriptionsParametersQueryCreated'Variants -> Bool
GHC.Classes.Eq)

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

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

-- | Defines the object schema located at @paths.\/v1\/subscriptions.GET.parameters.properties.queryCurrent_period_end.anyOf@ in the specification.
data GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 = GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
  { -- | gt
    GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> Maybe Int
getSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1Gt :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | gte
    GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> Maybe Int
getSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1Gte :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | lt
    GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> Maybe Int
getSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1Lt :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | lte
    GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> Maybe Int
getSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1Lte :: (GHC.Maybe.Maybe GHC.Types.Int)
  }
  deriving
    ( Int
-> GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> ShowS
[GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1] -> ShowS
GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> String
(Int
 -> GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> ShowS)
-> (GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
    -> String)
-> ([GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1]
    -> ShowS)
-> Show GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1] -> ShowS
$cshowList :: [GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1] -> ShowS
show :: GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> String
$cshow :: GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> String
showsPrec :: Int
-> GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> ShowS
$cshowsPrec :: Int
-> GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> ShowS
GHC.Show.Show,
      GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
-> GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> Bool
(GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
 -> GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> Bool)
-> (GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
    -> GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> Bool)
-> Eq GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
-> GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> Bool
$c/= :: GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
-> GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> Bool
== :: GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
-> GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> Bool
$c== :: GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
-> GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 where
  toJSON :: GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> Value
toJSON GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"gt" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> Maybe Int
getSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1Gt GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"gte" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> Maybe Int
getSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1Gte GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"lt" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> Maybe Int
getSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1Lt GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"lte" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> Maybe Int
getSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1Lte GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> Encoding
toEncoding GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"gt" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> Maybe Int
getSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1Gt GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"gte" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> Maybe Int
getSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1Gte GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"lt" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> Maybe Int
getSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1Lt GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"lte" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 -> Maybe Int
getSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1Lte GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
obj))))

instance Data.Aeson.Types.FromJSON.FromJSON GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 where
  parseJSON :: Value
-> Parser GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
parseJSON = String
-> (Object
    -> Parser GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1)
-> Value
-> Parser GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1" (\Object
obj -> ((((Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1)
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
"gt")) Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1)
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
"gte")) Parser
  (Maybe Int
   -> Maybe Int
   -> GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1)
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
"lt")) Parser
  (Maybe Int
   -> GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1)
-> Parser (Maybe Int)
-> Parser GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
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
"lte"))

-- | Create a new 'GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1' with all required fields.
mkGetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 :: GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
mkGetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 :: GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
mkGetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 =
  GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 :: Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
    { getSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1Gt :: Maybe Int
getSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1Gt = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      getSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1Gte :: Maybe Int
getSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1Gte = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      getSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1Lt :: Maybe Int
getSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1Lt = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      getSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1Lte :: Maybe Int
getSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1Lte = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the oneOf schema located at @paths.\/v1\/subscriptions.GET.parameters.properties.queryCurrent_period_end.anyOf@ in the specification.
--
-- Represents the parameter named \'current_period_end\'
data GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
  = GetSubscriptionsParametersQueryCurrentPeriodEnd'GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1 GetSubscriptionsParametersQueryCurrentPeriodEnd'OneOf1
  | GetSubscriptionsParametersQueryCurrentPeriodEnd'Int GHC.Types.Int
  deriving (Int
-> GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
-> ShowS
[GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants] -> ShowS
GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants -> String
(Int
 -> GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
 -> ShowS)
-> (GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
    -> String)
-> ([GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants]
    -> ShowS)
-> Show GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants] -> ShowS
$cshowList :: [GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants] -> ShowS
show :: GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants -> String
$cshow :: GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants -> String
showsPrec :: Int
-> GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
-> ShowS
$cshowsPrec :: Int
-> GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
-> ShowS
GHC.Show.Show, GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
-> GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants -> Bool
(GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
 -> GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
 -> Bool)
-> (GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
    -> GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
    -> Bool)
-> Eq GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
-> GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants -> Bool
$c/= :: GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
-> GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants -> Bool
== :: GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
-> GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants -> Bool
$c== :: GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants
-> GetSubscriptionsParametersQueryCurrentPeriodEnd'Variants -> Bool
GHC.Classes.Eq)

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

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

-- | Defines the object schema located at @paths.\/v1\/subscriptions.GET.parameters.properties.queryCurrent_period_start.anyOf@ in the specification.
data GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1 = GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
  { -- | gt
    GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
-> Maybe Int
getSubscriptionsParametersQueryCurrentPeriodStart'OneOf1Gt :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | gte
    GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
-> Maybe Int
getSubscriptionsParametersQueryCurrentPeriodStart'OneOf1Gte :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | lt
    GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
-> Maybe Int
getSubscriptionsParametersQueryCurrentPeriodStart'OneOf1Lt :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | lte
    GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
-> Maybe Int
getSubscriptionsParametersQueryCurrentPeriodStart'OneOf1Lte :: (GHC.Maybe.Maybe GHC.Types.Int)
  }
  deriving
    ( Int
-> GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
-> ShowS
[GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1] -> ShowS
GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1 -> String
(Int
 -> GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
 -> ShowS)
-> (GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
    -> String)
-> ([GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1]
    -> ShowS)
-> Show GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1] -> ShowS
$cshowList :: [GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1] -> ShowS
show :: GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1 -> String
$cshow :: GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1 -> String
showsPrec :: Int
-> GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
-> ShowS
$cshowsPrec :: Int
-> GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
-> ShowS
GHC.Show.Show,
      GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
-> GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1 -> Bool
(GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
 -> GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
 -> Bool)
-> (GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
    -> GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
    -> Bool)
-> Eq GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
-> GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1 -> Bool
$c/= :: GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
-> GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1 -> Bool
== :: GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
-> GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1 -> Bool
$c== :: GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
-> GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1 -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1 where
  toJSON :: GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1 -> Value
toJSON GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"gt" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
-> Maybe Int
getSubscriptionsParametersQueryCurrentPeriodStart'OneOf1Gt GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"gte" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
-> Maybe Int
getSubscriptionsParametersQueryCurrentPeriodStart'OneOf1Gte GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"lt" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
-> Maybe Int
getSubscriptionsParametersQueryCurrentPeriodStart'OneOf1Lt GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"lte" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
-> Maybe Int
getSubscriptionsParametersQueryCurrentPeriodStart'OneOf1Lte GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
-> Encoding
toEncoding GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"gt" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
-> Maybe Int
getSubscriptionsParametersQueryCurrentPeriodStart'OneOf1Gt GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"gte" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
-> Maybe Int
getSubscriptionsParametersQueryCurrentPeriodStart'OneOf1Gte GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"lt" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
-> Maybe Int
getSubscriptionsParametersQueryCurrentPeriodStart'OneOf1Lt GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"lte" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
-> Maybe Int
getSubscriptionsParametersQueryCurrentPeriodStart'OneOf1Lte GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
obj))))

instance Data.Aeson.Types.FromJSON.FromJSON GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1 where
  parseJSON :: Value
-> Parser GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
parseJSON = String
-> (Object
    -> Parser GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1)
-> Value
-> Parser GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1" (\Object
obj -> ((((Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1 Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1)
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
"gt")) Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1)
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
"gte")) Parser
  (Maybe Int
   -> Maybe Int
   -> GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1)
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
"lt")) Parser
  (Maybe Int
   -> GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1)
-> Parser (Maybe Int)
-> Parser GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
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
"lte"))

-- | Create a new 'GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1' with all required fields.
mkGetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1 :: GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
mkGetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1 :: GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
mkGetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1 =
  GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1 :: Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
    { getSubscriptionsParametersQueryCurrentPeriodStart'OneOf1Gt :: Maybe Int
getSubscriptionsParametersQueryCurrentPeriodStart'OneOf1Gt = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      getSubscriptionsParametersQueryCurrentPeriodStart'OneOf1Gte :: Maybe Int
getSubscriptionsParametersQueryCurrentPeriodStart'OneOf1Gte = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      getSubscriptionsParametersQueryCurrentPeriodStart'OneOf1Lt :: Maybe Int
getSubscriptionsParametersQueryCurrentPeriodStart'OneOf1Lt = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      getSubscriptionsParametersQueryCurrentPeriodStart'OneOf1Lte :: Maybe Int
getSubscriptionsParametersQueryCurrentPeriodStart'OneOf1Lte = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the oneOf schema located at @paths.\/v1\/subscriptions.GET.parameters.properties.queryCurrent_period_start.anyOf@ in the specification.
--
-- Represents the parameter named \'current_period_start\'
data GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
  = GetSubscriptionsParametersQueryCurrentPeriodStart'GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1 GetSubscriptionsParametersQueryCurrentPeriodStart'OneOf1
  | GetSubscriptionsParametersQueryCurrentPeriodStart'Int GHC.Types.Int
  deriving (Int
-> GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
-> ShowS
[GetSubscriptionsParametersQueryCurrentPeriodStart'Variants]
-> ShowS
GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
-> String
(Int
 -> GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
 -> ShowS)
-> (GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
    -> String)
-> ([GetSubscriptionsParametersQueryCurrentPeriodStart'Variants]
    -> ShowS)
-> Show GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSubscriptionsParametersQueryCurrentPeriodStart'Variants]
-> ShowS
$cshowList :: [GetSubscriptionsParametersQueryCurrentPeriodStart'Variants]
-> ShowS
show :: GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
-> String
$cshow :: GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
-> String
showsPrec :: Int
-> GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
-> ShowS
$cshowsPrec :: Int
-> GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
-> ShowS
GHC.Show.Show, GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
-> GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
-> Bool
(GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
 -> GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
 -> Bool)
-> (GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
    -> GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
    -> Bool)
-> Eq GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
-> GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
-> Bool
$c/= :: GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
-> GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
-> Bool
== :: GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
-> GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
-> Bool
$c== :: GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
-> GetSubscriptionsParametersQueryCurrentPeriodStart'Variants
-> Bool
GHC.Classes.Eq)

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

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

-- | Defines the enum schema located at @paths.\/v1\/subscriptions.GET.parameters.properties.queryStatus@ in the specification.
--
-- Represents the parameter named \'status\'
--
-- The status of the subscriptions to retrieve. Passing in a value of \`canceled\` will return all canceled subscriptions, including those belonging to deleted customers. Pass \`ended\` to find subscriptions that are canceled and subscriptions that are expired due to [incomplete payment](https:\/\/stripe.com\/docs\/billing\/subscriptions\/overview\#subscription-statuses). Passing in a value of \`all\` will return subscriptions of all statuses. If no value is supplied, all subscriptions that have not been canceled are returned.
data GetSubscriptionsParametersQueryStatus'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    GetSubscriptionsParametersQueryStatus'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.
    GetSubscriptionsParametersQueryStatus'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"active"@
    GetSubscriptionsParametersQueryStatus'EnumActive
  | -- | Represents the JSON value @"all"@
    GetSubscriptionsParametersQueryStatus'EnumAll
  | -- | Represents the JSON value @"canceled"@
    GetSubscriptionsParametersQueryStatus'EnumCanceled
  | -- | Represents the JSON value @"ended"@
    GetSubscriptionsParametersQueryStatus'EnumEnded
  | -- | Represents the JSON value @"incomplete"@
    GetSubscriptionsParametersQueryStatus'EnumIncomplete
  | -- | Represents the JSON value @"incomplete_expired"@
    GetSubscriptionsParametersQueryStatus'EnumIncompleteExpired
  | -- | Represents the JSON value @"past_due"@
    GetSubscriptionsParametersQueryStatus'EnumPastDue
  | -- | Represents the JSON value @"trialing"@
    GetSubscriptionsParametersQueryStatus'EnumTrialing
  | -- | Represents the JSON value @"unpaid"@
    GetSubscriptionsParametersQueryStatus'EnumUnpaid
  deriving (Int -> GetSubscriptionsParametersQueryStatus' -> ShowS
[GetSubscriptionsParametersQueryStatus'] -> ShowS
GetSubscriptionsParametersQueryStatus' -> String
(Int -> GetSubscriptionsParametersQueryStatus' -> ShowS)
-> (GetSubscriptionsParametersQueryStatus' -> String)
-> ([GetSubscriptionsParametersQueryStatus'] -> ShowS)
-> Show GetSubscriptionsParametersQueryStatus'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSubscriptionsParametersQueryStatus'] -> ShowS
$cshowList :: [GetSubscriptionsParametersQueryStatus'] -> ShowS
show :: GetSubscriptionsParametersQueryStatus' -> String
$cshow :: GetSubscriptionsParametersQueryStatus' -> String
showsPrec :: Int -> GetSubscriptionsParametersQueryStatus' -> ShowS
$cshowsPrec :: Int -> GetSubscriptionsParametersQueryStatus' -> ShowS
GHC.Show.Show, GetSubscriptionsParametersQueryStatus'
-> GetSubscriptionsParametersQueryStatus' -> Bool
(GetSubscriptionsParametersQueryStatus'
 -> GetSubscriptionsParametersQueryStatus' -> Bool)
-> (GetSubscriptionsParametersQueryStatus'
    -> GetSubscriptionsParametersQueryStatus' -> Bool)
-> Eq GetSubscriptionsParametersQueryStatus'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSubscriptionsParametersQueryStatus'
-> GetSubscriptionsParametersQueryStatus' -> Bool
$c/= :: GetSubscriptionsParametersQueryStatus'
-> GetSubscriptionsParametersQueryStatus' -> Bool
== :: GetSubscriptionsParametersQueryStatus'
-> GetSubscriptionsParametersQueryStatus' -> Bool
$c== :: GetSubscriptionsParametersQueryStatus'
-> GetSubscriptionsParametersQueryStatus' -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON GetSubscriptionsParametersQueryStatus' where
  toJSON :: GetSubscriptionsParametersQueryStatus' -> Value
toJSON (GetSubscriptionsParametersQueryStatus'Other Value
val) = Value
val
  toJSON (GetSubscriptionsParametersQueryStatus'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (GetSubscriptionsParametersQueryStatus'
GetSubscriptionsParametersQueryStatus'EnumActive) = Value
"active"
  toJSON (GetSubscriptionsParametersQueryStatus'
GetSubscriptionsParametersQueryStatus'EnumAll) = Value
"all"
  toJSON (GetSubscriptionsParametersQueryStatus'
GetSubscriptionsParametersQueryStatus'EnumCanceled) = Value
"canceled"
  toJSON (GetSubscriptionsParametersQueryStatus'
GetSubscriptionsParametersQueryStatus'EnumEnded) = Value
"ended"
  toJSON (GetSubscriptionsParametersQueryStatus'
GetSubscriptionsParametersQueryStatus'EnumIncomplete) = Value
"incomplete"
  toJSON (GetSubscriptionsParametersQueryStatus'
GetSubscriptionsParametersQueryStatus'EnumIncompleteExpired) = Value
"incomplete_expired"
  toJSON (GetSubscriptionsParametersQueryStatus'
GetSubscriptionsParametersQueryStatus'EnumPastDue) = Value
"past_due"
  toJSON (GetSubscriptionsParametersQueryStatus'
GetSubscriptionsParametersQueryStatus'EnumTrialing) = Value
"trialing"
  toJSON (GetSubscriptionsParametersQueryStatus'
GetSubscriptionsParametersQueryStatus'EnumUnpaid) = Value
"unpaid"

instance Data.Aeson.Types.FromJSON.FromJSON GetSubscriptionsParametersQueryStatus' where
  parseJSON :: Value -> Parser GetSubscriptionsParametersQueryStatus'
parseJSON Value
val =
    GetSubscriptionsParametersQueryStatus'
-> Parser GetSubscriptionsParametersQueryStatus'
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
"active" -> GetSubscriptionsParametersQueryStatus'
GetSubscriptionsParametersQueryStatus'EnumActive
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"all" -> GetSubscriptionsParametersQueryStatus'
GetSubscriptionsParametersQueryStatus'EnumAll
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"canceled" -> GetSubscriptionsParametersQueryStatus'
GetSubscriptionsParametersQueryStatus'EnumCanceled
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ended" -> GetSubscriptionsParametersQueryStatus'
GetSubscriptionsParametersQueryStatus'EnumEnded
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"incomplete" -> GetSubscriptionsParametersQueryStatus'
GetSubscriptionsParametersQueryStatus'EnumIncomplete
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"incomplete_expired" -> GetSubscriptionsParametersQueryStatus'
GetSubscriptionsParametersQueryStatus'EnumIncompleteExpired
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"past_due" -> GetSubscriptionsParametersQueryStatus'
GetSubscriptionsParametersQueryStatus'EnumPastDue
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"trialing" -> GetSubscriptionsParametersQueryStatus'
GetSubscriptionsParametersQueryStatus'EnumTrialing
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"unpaid" -> GetSubscriptionsParametersQueryStatus'
GetSubscriptionsParametersQueryStatus'EnumUnpaid
            | Bool
GHC.Base.otherwise -> Value -> GetSubscriptionsParametersQueryStatus'
GetSubscriptionsParametersQueryStatus'Other Value
val
      )

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

-- | Defines the object schema located at @paths.\/v1\/subscriptions.GET.responses.200.content.application\/json.schema@ in the specification.
data GetSubscriptionsResponseBody200 = GetSubscriptionsResponseBody200
  { -- | data
    GetSubscriptionsResponseBody200 -> [Subscription]
getSubscriptionsResponseBody200Data :: ([Subscription]),
    -- | has_more: True if this list has another page of items after this one that can be fetched.
    GetSubscriptionsResponseBody200 -> Bool
getSubscriptionsResponseBody200HasMore :: GHC.Types.Bool,
    -- | url: The URL where this list can be accessed.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    -- * Must match pattern \'^\/v1\/subscriptions\'
    GetSubscriptionsResponseBody200 -> Text
getSubscriptionsResponseBody200Url :: Data.Text.Internal.Text
  }
  deriving
    ( Int -> GetSubscriptionsResponseBody200 -> ShowS
[GetSubscriptionsResponseBody200] -> ShowS
GetSubscriptionsResponseBody200 -> String
(Int -> GetSubscriptionsResponseBody200 -> ShowS)
-> (GetSubscriptionsResponseBody200 -> String)
-> ([GetSubscriptionsResponseBody200] -> ShowS)
-> Show GetSubscriptionsResponseBody200
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSubscriptionsResponseBody200] -> ShowS
$cshowList :: [GetSubscriptionsResponseBody200] -> ShowS
show :: GetSubscriptionsResponseBody200 -> String
$cshow :: GetSubscriptionsResponseBody200 -> String
showsPrec :: Int -> GetSubscriptionsResponseBody200 -> ShowS
$cshowsPrec :: Int -> GetSubscriptionsResponseBody200 -> ShowS
GHC.Show.Show,
      GetSubscriptionsResponseBody200
-> GetSubscriptionsResponseBody200 -> Bool
(GetSubscriptionsResponseBody200
 -> GetSubscriptionsResponseBody200 -> Bool)
-> (GetSubscriptionsResponseBody200
    -> GetSubscriptionsResponseBody200 -> Bool)
-> Eq GetSubscriptionsResponseBody200
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSubscriptionsResponseBody200
-> GetSubscriptionsResponseBody200 -> Bool
$c/= :: GetSubscriptionsResponseBody200
-> GetSubscriptionsResponseBody200 -> Bool
== :: GetSubscriptionsResponseBody200
-> GetSubscriptionsResponseBody200 -> Bool
$c== :: GetSubscriptionsResponseBody200
-> GetSubscriptionsResponseBody200 -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON GetSubscriptionsResponseBody200 where
  toJSON :: GetSubscriptionsResponseBody200 -> Value
toJSON GetSubscriptionsResponseBody200
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"data" Text -> [Subscription] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsResponseBody200 -> [Subscription]
getSubscriptionsResponseBody200Data GetSubscriptionsResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"has_more" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsResponseBody200 -> Bool
getSubscriptionsResponseBody200HasMore GetSubscriptionsResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"url" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsResponseBody200 -> Text
getSubscriptionsResponseBody200Url GetSubscriptionsResponseBody200
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"object" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= Text -> Value
Data.Aeson.Types.Internal.String Text
"list" Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: GetSubscriptionsResponseBody200 -> Encoding
toEncoding GetSubscriptionsResponseBody200
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"data" Text -> [Subscription] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsResponseBody200 -> [Subscription]
getSubscriptionsResponseBody200Data GetSubscriptionsResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"has_more" Text -> Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsResponseBody200 -> Bool
getSubscriptionsResponseBody200HasMore GetSubscriptionsResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"url" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetSubscriptionsResponseBody200 -> Text
getSubscriptionsResponseBody200Url GetSubscriptionsResponseBody200
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"object" Text -> Value -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= Text -> Value
Data.Aeson.Types.Internal.String Text
"list"))))

instance Data.Aeson.Types.FromJSON.FromJSON GetSubscriptionsResponseBody200 where
  parseJSON :: Value -> Parser GetSubscriptionsResponseBody200
parseJSON = String
-> (Object -> Parser GetSubscriptionsResponseBody200)
-> Value
-> Parser GetSubscriptionsResponseBody200
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"GetSubscriptionsResponseBody200" (\Object
obj -> ((([Subscription] -> Bool -> Text -> GetSubscriptionsResponseBody200)
-> Parser
     ([Subscription] -> Bool -> Text -> GetSubscriptionsResponseBody200)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure [Subscription] -> Bool -> Text -> GetSubscriptionsResponseBody200
GetSubscriptionsResponseBody200 Parser
  ([Subscription] -> Bool -> Text -> GetSubscriptionsResponseBody200)
-> Parser [Subscription]
-> Parser (Bool -> Text -> GetSubscriptionsResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser [Subscription]
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"data")) Parser (Bool -> Text -> GetSubscriptionsResponseBody200)
-> Parser Bool -> Parser (Text -> GetSubscriptionsResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"has_more")) Parser (Text -> GetSubscriptionsResponseBody200)
-> Parser Text -> Parser GetSubscriptionsResponseBody200
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
"url"))

-- | Create a new 'GetSubscriptionsResponseBody200' with all required fields.
mkGetSubscriptionsResponseBody200 ::
  -- | 'getSubscriptionsResponseBody200Data'
  [Subscription] ->
  -- | 'getSubscriptionsResponseBody200HasMore'
  GHC.Types.Bool ->
  -- | 'getSubscriptionsResponseBody200Url'
  Data.Text.Internal.Text ->
  GetSubscriptionsResponseBody200
mkGetSubscriptionsResponseBody200 :: [Subscription] -> Bool -> Text -> GetSubscriptionsResponseBody200
mkGetSubscriptionsResponseBody200 [Subscription]
getSubscriptionsResponseBody200Data Bool
getSubscriptionsResponseBody200HasMore Text
getSubscriptionsResponseBody200Url =
  GetSubscriptionsResponseBody200 :: [Subscription] -> Bool -> Text -> GetSubscriptionsResponseBody200
GetSubscriptionsResponseBody200
    { getSubscriptionsResponseBody200Data :: [Subscription]
getSubscriptionsResponseBody200Data = [Subscription]
getSubscriptionsResponseBody200Data,
      getSubscriptionsResponseBody200HasMore :: Bool
getSubscriptionsResponseBody200HasMore = Bool
getSubscriptionsResponseBody200HasMore,
      getSubscriptionsResponseBody200Url :: Text
getSubscriptionsResponseBody200Url = Text
getSubscriptionsResponseBody200Url
    }