{-# 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 getIssuingCards
module StripeAPI.Operations.GetIssuingCards 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/issuing/cards
--
-- \<p>Returns a list of Issuing \<code>Card\<\/code> objects. The objects are sorted in descending order by creation date, with the most recently created object appearing first.\<\/p>
getIssuingCards ::
  forall m.
  StripeAPI.Common.MonadHTTP m =>
  -- | Contains all available parameters of this operation (query and path parameters)
  GetIssuingCardsParameters ->
  -- | Monadic computation which returns the result of the operation
  StripeAPI.Common.ClientT m (Network.HTTP.Client.Types.Response GetIssuingCardsResponse)
getIssuingCards :: GetIssuingCardsParameters
-> ClientT m (Response GetIssuingCardsResponse)
getIssuingCards GetIssuingCardsParameters
parameters =
  (Response ByteString -> Response GetIssuingCardsResponse)
-> ClientT m (Response ByteString)
-> ClientT m (Response GetIssuingCardsResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
    ( \Response ByteString
response_0 ->
        (ByteString -> GetIssuingCardsResponse)
-> Response ByteString -> Response GetIssuingCardsResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
          ( (String -> GetIssuingCardsResponse)
-> (GetIssuingCardsResponse -> GetIssuingCardsResponse)
-> Either String GetIssuingCardsResponse
-> GetIssuingCardsResponse
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Data.Either.either String -> GetIssuingCardsResponse
GetIssuingCardsResponseError GetIssuingCardsResponse -> GetIssuingCardsResponse
forall a. a -> a
GHC.Base.id
              (Either String GetIssuingCardsResponse -> GetIssuingCardsResponse)
-> (ByteString -> Either String GetIssuingCardsResponse)
-> ByteString
-> GetIssuingCardsResponse
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) ->
                                   GetIssuingCardsResponseBody200 -> GetIssuingCardsResponse
GetIssuingCardsResponse200
                                     (GetIssuingCardsResponseBody200 -> GetIssuingCardsResponse)
-> Either String GetIssuingCardsResponseBody200
-> Either String GetIssuingCardsResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> ( ByteString -> Either String GetIssuingCardsResponseBody200
forall a. FromJSON a => ByteString -> Either String a
Data.Aeson.eitherDecodeStrict ByteString
body ::
                                                          Data.Either.Either
                                                            GHC.Base.String
                                                            GetIssuingCardsResponseBody200
                                                      )
                                 | 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 -> GetIssuingCardsResponse
GetIssuingCardsResponseDefault
                                     (Error -> GetIssuingCardsResponse)
-> Either String Error -> Either String GetIssuingCardsResponse
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 GetIssuingCardsResponse
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] -> ClientT m (Response ByteString)
forall (m :: * -> *).
MonadHTTP m =>
Text -> Text -> [QueryParameter] -> ClientT 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/issuing/cards")
        [ Text -> Maybe Value -> Text -> Bool -> QueryParameter
StripeAPI.Common.QueryParameter (String -> Text
Data.Text.pack String
"cardholder") (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.<$> GetIssuingCardsParameters -> Maybe Text
getIssuingCardsParametersQueryCardholder GetIssuingCardsParameters
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") (GetIssuingCardsParametersQueryCreated'Variants -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (GetIssuingCardsParametersQueryCreated'Variants -> Value)
-> Maybe GetIssuingCardsParametersQueryCreated'Variants
-> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> GetIssuingCardsParameters
-> Maybe GetIssuingCardsParametersQueryCreated'Variants
getIssuingCardsParametersQueryCreated GetIssuingCardsParameters
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
"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.<$> GetIssuingCardsParameters -> Maybe Text
getIssuingCardsParametersQueryEndingBefore GetIssuingCardsParameters
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
"exp_month") (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.<$> GetIssuingCardsParameters -> Maybe Int
getIssuingCardsParametersQueryExpMonth GetIssuingCardsParameters
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
"exp_year") (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.<$> GetIssuingCardsParameters -> Maybe Int
getIssuingCardsParametersQueryExpYear GetIssuingCardsParameters
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.<$> GetIssuingCardsParameters -> Maybe [Text]
getIssuingCardsParametersQueryExpand GetIssuingCardsParameters
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
"last4") (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.<$> GetIssuingCardsParameters -> Maybe Text
getIssuingCardsParametersQueryLast4 GetIssuingCardsParameters
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
"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.<$> GetIssuingCardsParameters -> Maybe Int
getIssuingCardsParametersQueryLimit GetIssuingCardsParameters
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.<$> GetIssuingCardsParameters -> Maybe Text
getIssuingCardsParametersQueryStartingAfter GetIssuingCardsParameters
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") (GetIssuingCardsParametersQueryStatus' -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (GetIssuingCardsParametersQueryStatus' -> Value)
-> Maybe GetIssuingCardsParametersQueryStatus' -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> GetIssuingCardsParameters
-> Maybe GetIssuingCardsParametersQueryStatus'
getIssuingCardsParametersQueryStatus GetIssuingCardsParameters
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
"type") (GetIssuingCardsParametersQueryType' -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (GetIssuingCardsParametersQueryType' -> Value)
-> Maybe GetIssuingCardsParametersQueryType' -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> GetIssuingCardsParameters
-> Maybe GetIssuingCardsParametersQueryType'
getIssuingCardsParametersQueryType GetIssuingCardsParameters
parameters) (String -> Text
Data.Text.pack String
"form") Bool
GHC.Types.True
        ]
    )

-- | Defines the object schema located at @paths.\/v1\/issuing\/cards.GET.parameters@ in the specification.
data GetIssuingCardsParameters = GetIssuingCardsParameters
  { -- | queryCardholder: Represents the parameter named \'cardholder\'
    --
    -- Only return cards belonging to the Cardholder with the provided ID.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    GetIssuingCardsParameters -> Maybe Text
getIssuingCardsParametersQueryCardholder :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | queryCreated: Represents the parameter named \'created\'
    --
    -- Only return cards that were issued during the given date interval.
    GetIssuingCardsParameters
-> Maybe GetIssuingCardsParametersQueryCreated'Variants
getIssuingCardsParametersQueryCreated :: (GHC.Maybe.Maybe GetIssuingCardsParametersQueryCreated'Variants),
    -- | 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
    GetIssuingCardsParameters -> Maybe Text
getIssuingCardsParametersQueryEndingBefore :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | queryExp_month: Represents the parameter named \'exp_month\'
    --
    -- Only return cards that have the given expiration month.
    GetIssuingCardsParameters -> Maybe Int
getIssuingCardsParametersQueryExpMonth :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | queryExp_year: Represents the parameter named \'exp_year\'
    --
    -- Only return cards that have the given expiration year.
    GetIssuingCardsParameters -> Maybe Int
getIssuingCardsParametersQueryExpYear :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | queryExpand: Represents the parameter named \'expand\'
    --
    -- Specifies which fields in the response should be expanded.
    GetIssuingCardsParameters -> Maybe [Text]
getIssuingCardsParametersQueryExpand :: (GHC.Maybe.Maybe ([Data.Text.Internal.Text])),
    -- | queryLast4: Represents the parameter named \'last4\'
    --
    -- Only return cards that have the given last four digits.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    GetIssuingCardsParameters -> Maybe Text
getIssuingCardsParametersQueryLast4 :: (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.
    GetIssuingCardsParameters -> Maybe Int
getIssuingCardsParametersQueryLimit :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | 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
    GetIssuingCardsParameters -> Maybe Text
getIssuingCardsParametersQueryStartingAfter :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | queryStatus: Represents the parameter named \'status\'
    --
    -- Only return cards that have the given status. One of \`active\`, \`inactive\`, or \`canceled\`.
    GetIssuingCardsParameters
-> Maybe GetIssuingCardsParametersQueryStatus'
getIssuingCardsParametersQueryStatus :: (GHC.Maybe.Maybe GetIssuingCardsParametersQueryStatus'),
    -- | queryType: Represents the parameter named \'type\'
    --
    -- Only return cards that have the given type. One of \`virtual\` or \`physical\`.
    GetIssuingCardsParameters
-> Maybe GetIssuingCardsParametersQueryType'
getIssuingCardsParametersQueryType :: (GHC.Maybe.Maybe GetIssuingCardsParametersQueryType')
  }
  deriving
    ( Int -> GetIssuingCardsParameters -> ShowS
[GetIssuingCardsParameters] -> ShowS
GetIssuingCardsParameters -> String
(Int -> GetIssuingCardsParameters -> ShowS)
-> (GetIssuingCardsParameters -> String)
-> ([GetIssuingCardsParameters] -> ShowS)
-> Show GetIssuingCardsParameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetIssuingCardsParameters] -> ShowS
$cshowList :: [GetIssuingCardsParameters] -> ShowS
show :: GetIssuingCardsParameters -> String
$cshow :: GetIssuingCardsParameters -> String
showsPrec :: Int -> GetIssuingCardsParameters -> ShowS
$cshowsPrec :: Int -> GetIssuingCardsParameters -> ShowS
GHC.Show.Show,
      GetIssuingCardsParameters -> GetIssuingCardsParameters -> Bool
(GetIssuingCardsParameters -> GetIssuingCardsParameters -> Bool)
-> (GetIssuingCardsParameters -> GetIssuingCardsParameters -> Bool)
-> Eq GetIssuingCardsParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetIssuingCardsParameters -> GetIssuingCardsParameters -> Bool
$c/= :: GetIssuingCardsParameters -> GetIssuingCardsParameters -> Bool
== :: GetIssuingCardsParameters -> GetIssuingCardsParameters -> Bool
$c== :: GetIssuingCardsParameters -> GetIssuingCardsParameters -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON GetIssuingCardsParameters where
  toJSON :: GetIssuingCardsParameters -> Value
toJSON GetIssuingCardsParameters
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"queryCardholder" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingCardsParameters -> Maybe Text
getIssuingCardsParametersQueryCardholder GetIssuingCardsParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryCreated" Text
-> Maybe GetIssuingCardsParametersQueryCreated'Variants -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingCardsParameters
-> Maybe GetIssuingCardsParametersQueryCreated'Variants
getIssuingCardsParametersQueryCreated GetIssuingCardsParameters
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..= GetIssuingCardsParameters -> Maybe Text
getIssuingCardsParametersQueryEndingBefore GetIssuingCardsParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryExp_month" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingCardsParameters -> Maybe Int
getIssuingCardsParametersQueryExpMonth GetIssuingCardsParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryExp_year" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingCardsParameters -> Maybe Int
getIssuingCardsParametersQueryExpYear GetIssuingCardsParameters
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..= GetIssuingCardsParameters -> Maybe [Text]
getIssuingCardsParametersQueryExpand GetIssuingCardsParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryLast4" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingCardsParameters -> Maybe Text
getIssuingCardsParametersQueryLast4 GetIssuingCardsParameters
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..= GetIssuingCardsParameters -> Maybe Int
getIssuingCardsParametersQueryLimit GetIssuingCardsParameters
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..= GetIssuingCardsParameters -> Maybe Text
getIssuingCardsParametersQueryStartingAfter GetIssuingCardsParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryStatus" Text -> Maybe GetIssuingCardsParametersQueryStatus' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingCardsParameters
-> Maybe GetIssuingCardsParametersQueryStatus'
getIssuingCardsParametersQueryStatus GetIssuingCardsParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryType" Text -> Maybe GetIssuingCardsParametersQueryType' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingCardsParameters
-> Maybe GetIssuingCardsParametersQueryType'
getIssuingCardsParametersQueryType GetIssuingCardsParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: GetIssuingCardsParameters -> Encoding
toEncoding GetIssuingCardsParameters
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"queryCardholder" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingCardsParameters -> Maybe Text
getIssuingCardsParametersQueryCardholder GetIssuingCardsParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"queryCreated" Text
-> Maybe GetIssuingCardsParametersQueryCreated'Variants -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingCardsParameters
-> Maybe GetIssuingCardsParametersQueryCreated'Variants
getIssuingCardsParametersQueryCreated GetIssuingCardsParameters
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..= GetIssuingCardsParameters -> Maybe Text
getIssuingCardsParametersQueryEndingBefore GetIssuingCardsParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"queryExp_month" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingCardsParameters -> Maybe Int
getIssuingCardsParametersQueryExpMonth GetIssuingCardsParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"queryExp_year" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingCardsParameters -> Maybe Int
getIssuingCardsParametersQueryExpYear GetIssuingCardsParameters
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..= GetIssuingCardsParameters -> Maybe [Text]
getIssuingCardsParametersQueryExpand GetIssuingCardsParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"queryLast4" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingCardsParameters -> Maybe Text
getIssuingCardsParametersQueryLast4 GetIssuingCardsParameters
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..= GetIssuingCardsParameters -> Maybe Int
getIssuingCardsParametersQueryLimit GetIssuingCardsParameters
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..= GetIssuingCardsParameters -> Maybe Text
getIssuingCardsParametersQueryStartingAfter GetIssuingCardsParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"queryStatus" Text -> Maybe GetIssuingCardsParametersQueryStatus' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingCardsParameters
-> Maybe GetIssuingCardsParametersQueryStatus'
getIssuingCardsParametersQueryStatus GetIssuingCardsParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"queryType" Text -> Maybe GetIssuingCardsParametersQueryType' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingCardsParameters
-> Maybe GetIssuingCardsParametersQueryType'
getIssuingCardsParametersQueryType GetIssuingCardsParameters
obj)))))))))))

instance Data.Aeson.Types.FromJSON.FromJSON GetIssuingCardsParameters where
  parseJSON :: Value -> Parser GetIssuingCardsParameters
parseJSON = String
-> (Object -> Parser GetIssuingCardsParameters)
-> Value
-> Parser GetIssuingCardsParameters
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"GetIssuingCardsParameters" (\Object
obj -> (((((((((((Maybe Text
 -> Maybe GetIssuingCardsParametersQueryCreated'Variants
 -> Maybe Text
 -> Maybe Int
 -> Maybe Int
 -> Maybe [Text]
 -> Maybe Text
 -> Maybe Int
 -> Maybe Text
 -> Maybe GetIssuingCardsParametersQueryStatus'
 -> Maybe GetIssuingCardsParametersQueryType'
 -> GetIssuingCardsParameters)
-> Parser
     (Maybe Text
      -> Maybe GetIssuingCardsParametersQueryCreated'Variants
      -> Maybe Text
      -> Maybe Int
      -> Maybe Int
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe GetIssuingCardsParametersQueryStatus'
      -> Maybe GetIssuingCardsParametersQueryType'
      -> GetIssuingCardsParameters)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe GetIssuingCardsParametersQueryCreated'Variants
-> Maybe Text
-> Maybe Int
-> Maybe Int
-> Maybe [Text]
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe GetIssuingCardsParametersQueryStatus'
-> Maybe GetIssuingCardsParametersQueryType'
-> GetIssuingCardsParameters
GetIssuingCardsParameters Parser
  (Maybe Text
   -> Maybe GetIssuingCardsParametersQueryCreated'Variants
   -> Maybe Text
   -> Maybe Int
   -> Maybe Int
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe GetIssuingCardsParametersQueryStatus'
   -> Maybe GetIssuingCardsParametersQueryType'
   -> GetIssuingCardsParameters)
-> Parser (Maybe Text)
-> Parser
     (Maybe GetIssuingCardsParametersQueryCreated'Variants
      -> Maybe Text
      -> Maybe Int
      -> Maybe Int
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe GetIssuingCardsParametersQueryStatus'
      -> Maybe GetIssuingCardsParametersQueryType'
      -> GetIssuingCardsParameters)
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
"queryCardholder")) Parser
  (Maybe GetIssuingCardsParametersQueryCreated'Variants
   -> Maybe Text
   -> Maybe Int
   -> Maybe Int
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe GetIssuingCardsParametersQueryStatus'
   -> Maybe GetIssuingCardsParametersQueryType'
   -> GetIssuingCardsParameters)
-> Parser (Maybe GetIssuingCardsParametersQueryCreated'Variants)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe Int
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe GetIssuingCardsParametersQueryStatus'
      -> Maybe GetIssuingCardsParametersQueryType'
      -> GetIssuingCardsParameters)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe GetIssuingCardsParametersQueryCreated'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"queryCreated")) Parser
  (Maybe Text
   -> Maybe Int
   -> Maybe Int
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe GetIssuingCardsParametersQueryStatus'
   -> Maybe GetIssuingCardsParametersQueryType'
   -> GetIssuingCardsParameters)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe GetIssuingCardsParametersQueryStatus'
      -> Maybe GetIssuingCardsParametersQueryType'
      -> GetIssuingCardsParameters)
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 Int
   -> Maybe Int
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe GetIssuingCardsParametersQueryStatus'
   -> Maybe GetIssuingCardsParametersQueryType'
   -> GetIssuingCardsParameters)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe GetIssuingCardsParametersQueryStatus'
      -> Maybe GetIssuingCardsParametersQueryType'
      -> GetIssuingCardsParameters)
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
"queryExp_month")) Parser
  (Maybe Int
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe GetIssuingCardsParametersQueryStatus'
   -> Maybe GetIssuingCardsParametersQueryType'
   -> GetIssuingCardsParameters)
-> Parser (Maybe Int)
-> Parser
     (Maybe [Text]
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe GetIssuingCardsParametersQueryStatus'
      -> Maybe GetIssuingCardsParametersQueryType'
      -> GetIssuingCardsParameters)
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
"queryExp_year")) Parser
  (Maybe [Text]
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe GetIssuingCardsParametersQueryStatus'
   -> Maybe GetIssuingCardsParametersQueryType'
   -> GetIssuingCardsParameters)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe GetIssuingCardsParametersQueryStatus'
      -> Maybe GetIssuingCardsParametersQueryType'
      -> GetIssuingCardsParameters)
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 Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe GetIssuingCardsParametersQueryStatus'
   -> Maybe GetIssuingCardsParametersQueryType'
   -> GetIssuingCardsParameters)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Maybe GetIssuingCardsParametersQueryStatus'
      -> Maybe GetIssuingCardsParametersQueryType'
      -> GetIssuingCardsParameters)
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
"queryLast4")) Parser
  (Maybe Int
   -> Maybe Text
   -> Maybe GetIssuingCardsParametersQueryStatus'
   -> Maybe GetIssuingCardsParametersQueryType'
   -> GetIssuingCardsParameters)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe GetIssuingCardsParametersQueryStatus'
      -> Maybe GetIssuingCardsParametersQueryType'
      -> GetIssuingCardsParameters)
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 GetIssuingCardsParametersQueryStatus'
   -> Maybe GetIssuingCardsParametersQueryType'
   -> GetIssuingCardsParameters)
-> Parser (Maybe Text)
-> Parser
     (Maybe GetIssuingCardsParametersQueryStatus'
      -> Maybe GetIssuingCardsParametersQueryType'
      -> GetIssuingCardsParameters)
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 GetIssuingCardsParametersQueryStatus'
   -> Maybe GetIssuingCardsParametersQueryType'
   -> GetIssuingCardsParameters)
-> Parser (Maybe GetIssuingCardsParametersQueryStatus')
-> Parser
     (Maybe GetIssuingCardsParametersQueryType'
      -> GetIssuingCardsParameters)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe GetIssuingCardsParametersQueryStatus')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"queryStatus")) Parser
  (Maybe GetIssuingCardsParametersQueryType'
   -> GetIssuingCardsParameters)
-> Parser (Maybe GetIssuingCardsParametersQueryType')
-> Parser GetIssuingCardsParameters
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text -> Parser (Maybe GetIssuingCardsParametersQueryType')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"queryType"))

-- | Create a new 'GetIssuingCardsParameters' with all required fields.
mkGetIssuingCardsParameters :: GetIssuingCardsParameters
mkGetIssuingCardsParameters :: GetIssuingCardsParameters
mkGetIssuingCardsParameters =
  GetIssuingCardsParameters :: Maybe Text
-> Maybe GetIssuingCardsParametersQueryCreated'Variants
-> Maybe Text
-> Maybe Int
-> Maybe Int
-> Maybe [Text]
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe GetIssuingCardsParametersQueryStatus'
-> Maybe GetIssuingCardsParametersQueryType'
-> GetIssuingCardsParameters
GetIssuingCardsParameters
    { getIssuingCardsParametersQueryCardholder :: Maybe Text
getIssuingCardsParametersQueryCardholder = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      getIssuingCardsParametersQueryCreated :: Maybe GetIssuingCardsParametersQueryCreated'Variants
getIssuingCardsParametersQueryCreated = Maybe GetIssuingCardsParametersQueryCreated'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      getIssuingCardsParametersQueryEndingBefore :: Maybe Text
getIssuingCardsParametersQueryEndingBefore = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      getIssuingCardsParametersQueryExpMonth :: Maybe Int
getIssuingCardsParametersQueryExpMonth = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      getIssuingCardsParametersQueryExpYear :: Maybe Int
getIssuingCardsParametersQueryExpYear = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      getIssuingCardsParametersQueryExpand :: Maybe [Text]
getIssuingCardsParametersQueryExpand = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing,
      getIssuingCardsParametersQueryLast4 :: Maybe Text
getIssuingCardsParametersQueryLast4 = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      getIssuingCardsParametersQueryLimit :: Maybe Int
getIssuingCardsParametersQueryLimit = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      getIssuingCardsParametersQueryStartingAfter :: Maybe Text
getIssuingCardsParametersQueryStartingAfter = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      getIssuingCardsParametersQueryStatus :: Maybe GetIssuingCardsParametersQueryStatus'
getIssuingCardsParametersQueryStatus = Maybe GetIssuingCardsParametersQueryStatus'
forall a. Maybe a
GHC.Maybe.Nothing,
      getIssuingCardsParametersQueryType :: Maybe GetIssuingCardsParametersQueryType'
getIssuingCardsParametersQueryType = Maybe GetIssuingCardsParametersQueryType'
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

instance Data.Aeson.Types.ToJSON.ToJSON GetIssuingCardsParametersQueryCreated'OneOf1 where
  toJSON :: GetIssuingCardsParametersQueryCreated'OneOf1 -> Value
toJSON GetIssuingCardsParametersQueryCreated'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..= GetIssuingCardsParametersQueryCreated'OneOf1 -> Maybe Int
getIssuingCardsParametersQueryCreated'OneOf1Gt GetIssuingCardsParametersQueryCreated'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..= GetIssuingCardsParametersQueryCreated'OneOf1 -> Maybe Int
getIssuingCardsParametersQueryCreated'OneOf1Gte GetIssuingCardsParametersQueryCreated'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..= GetIssuingCardsParametersQueryCreated'OneOf1 -> Maybe Int
getIssuingCardsParametersQueryCreated'OneOf1Lt GetIssuingCardsParametersQueryCreated'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..= GetIssuingCardsParametersQueryCreated'OneOf1 -> Maybe Int
getIssuingCardsParametersQueryCreated'OneOf1Lte GetIssuingCardsParametersQueryCreated'OneOf1
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: GetIssuingCardsParametersQueryCreated'OneOf1 -> Encoding
toEncoding GetIssuingCardsParametersQueryCreated'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..= GetIssuingCardsParametersQueryCreated'OneOf1 -> Maybe Int
getIssuingCardsParametersQueryCreated'OneOf1Gt GetIssuingCardsParametersQueryCreated'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..= GetIssuingCardsParametersQueryCreated'OneOf1 -> Maybe Int
getIssuingCardsParametersQueryCreated'OneOf1Gte GetIssuingCardsParametersQueryCreated'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..= GetIssuingCardsParametersQueryCreated'OneOf1 -> Maybe Int
getIssuingCardsParametersQueryCreated'OneOf1Lt GetIssuingCardsParametersQueryCreated'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..= GetIssuingCardsParametersQueryCreated'OneOf1 -> Maybe Int
getIssuingCardsParametersQueryCreated'OneOf1Lte GetIssuingCardsParametersQueryCreated'OneOf1
obj))))

instance Data.Aeson.Types.FromJSON.FromJSON GetIssuingCardsParametersQueryCreated'OneOf1 where
  parseJSON :: Value -> Parser GetIssuingCardsParametersQueryCreated'OneOf1
parseJSON = String
-> (Object -> Parser GetIssuingCardsParametersQueryCreated'OneOf1)
-> Value
-> Parser GetIssuingCardsParametersQueryCreated'OneOf1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"GetIssuingCardsParametersQueryCreated'OneOf1" (\Object
obj -> ((((Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> GetIssuingCardsParametersQueryCreated'OneOf1)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> GetIssuingCardsParametersQueryCreated'OneOf1)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> GetIssuingCardsParametersQueryCreated'OneOf1
GetIssuingCardsParametersQueryCreated'OneOf1 Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> GetIssuingCardsParametersQueryCreated'OneOf1)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> GetIssuingCardsParametersQueryCreated'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
   -> GetIssuingCardsParametersQueryCreated'OneOf1)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Int -> GetIssuingCardsParametersQueryCreated'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 -> GetIssuingCardsParametersQueryCreated'OneOf1)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int -> GetIssuingCardsParametersQueryCreated'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 -> GetIssuingCardsParametersQueryCreated'OneOf1)
-> Parser (Maybe Int)
-> Parser GetIssuingCardsParametersQueryCreated'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 'GetIssuingCardsParametersQueryCreated'OneOf1' with all required fields.
mkGetIssuingCardsParametersQueryCreated'OneOf1 :: GetIssuingCardsParametersQueryCreated'OneOf1
mkGetIssuingCardsParametersQueryCreated'OneOf1 :: GetIssuingCardsParametersQueryCreated'OneOf1
mkGetIssuingCardsParametersQueryCreated'OneOf1 =
  GetIssuingCardsParametersQueryCreated'OneOf1 :: Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> GetIssuingCardsParametersQueryCreated'OneOf1
GetIssuingCardsParametersQueryCreated'OneOf1
    { getIssuingCardsParametersQueryCreated'OneOf1Gt :: Maybe Int
getIssuingCardsParametersQueryCreated'OneOf1Gt = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      getIssuingCardsParametersQueryCreated'OneOf1Gte :: Maybe Int
getIssuingCardsParametersQueryCreated'OneOf1Gte = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      getIssuingCardsParametersQueryCreated'OneOf1Lt :: Maybe Int
getIssuingCardsParametersQueryCreated'OneOf1Lt = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      getIssuingCardsParametersQueryCreated'OneOf1Lte :: Maybe Int
getIssuingCardsParametersQueryCreated'OneOf1Lte = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

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

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

-- | Defines the enum schema located at @paths.\/v1\/issuing\/cards.GET.parameters.properties.queryStatus@ in the specification.
--
-- Represents the parameter named \'status\'
--
-- Only return cards that have the given status. One of \`active\`, \`inactive\`, or \`canceled\`.
data GetIssuingCardsParametersQueryStatus'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    GetIssuingCardsParametersQueryStatus'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.
    GetIssuingCardsParametersQueryStatus'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"active"@
    GetIssuingCardsParametersQueryStatus'EnumActive
  | -- | Represents the JSON value @"canceled"@
    GetIssuingCardsParametersQueryStatus'EnumCanceled
  | -- | Represents the JSON value @"inactive"@
    GetIssuingCardsParametersQueryStatus'EnumInactive
  deriving (Int -> GetIssuingCardsParametersQueryStatus' -> ShowS
[GetIssuingCardsParametersQueryStatus'] -> ShowS
GetIssuingCardsParametersQueryStatus' -> String
(Int -> GetIssuingCardsParametersQueryStatus' -> ShowS)
-> (GetIssuingCardsParametersQueryStatus' -> String)
-> ([GetIssuingCardsParametersQueryStatus'] -> ShowS)
-> Show GetIssuingCardsParametersQueryStatus'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetIssuingCardsParametersQueryStatus'] -> ShowS
$cshowList :: [GetIssuingCardsParametersQueryStatus'] -> ShowS
show :: GetIssuingCardsParametersQueryStatus' -> String
$cshow :: GetIssuingCardsParametersQueryStatus' -> String
showsPrec :: Int -> GetIssuingCardsParametersQueryStatus' -> ShowS
$cshowsPrec :: Int -> GetIssuingCardsParametersQueryStatus' -> ShowS
GHC.Show.Show, GetIssuingCardsParametersQueryStatus'
-> GetIssuingCardsParametersQueryStatus' -> Bool
(GetIssuingCardsParametersQueryStatus'
 -> GetIssuingCardsParametersQueryStatus' -> Bool)
-> (GetIssuingCardsParametersQueryStatus'
    -> GetIssuingCardsParametersQueryStatus' -> Bool)
-> Eq GetIssuingCardsParametersQueryStatus'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetIssuingCardsParametersQueryStatus'
-> GetIssuingCardsParametersQueryStatus' -> Bool
$c/= :: GetIssuingCardsParametersQueryStatus'
-> GetIssuingCardsParametersQueryStatus' -> Bool
== :: GetIssuingCardsParametersQueryStatus'
-> GetIssuingCardsParametersQueryStatus' -> Bool
$c== :: GetIssuingCardsParametersQueryStatus'
-> GetIssuingCardsParametersQueryStatus' -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON GetIssuingCardsParametersQueryStatus' where
  toJSON :: GetIssuingCardsParametersQueryStatus' -> Value
toJSON (GetIssuingCardsParametersQueryStatus'Other Value
val) = Value
val
  toJSON (GetIssuingCardsParametersQueryStatus'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (GetIssuingCardsParametersQueryStatus'
GetIssuingCardsParametersQueryStatus'EnumActive) = Value
"active"
  toJSON (GetIssuingCardsParametersQueryStatus'
GetIssuingCardsParametersQueryStatus'EnumCanceled) = Value
"canceled"
  toJSON (GetIssuingCardsParametersQueryStatus'
GetIssuingCardsParametersQueryStatus'EnumInactive) = Value
"inactive"

instance Data.Aeson.Types.FromJSON.FromJSON GetIssuingCardsParametersQueryStatus' where
  parseJSON :: Value -> Parser GetIssuingCardsParametersQueryStatus'
parseJSON Value
val =
    GetIssuingCardsParametersQueryStatus'
-> Parser GetIssuingCardsParametersQueryStatus'
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" -> GetIssuingCardsParametersQueryStatus'
GetIssuingCardsParametersQueryStatus'EnumActive
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"canceled" -> GetIssuingCardsParametersQueryStatus'
GetIssuingCardsParametersQueryStatus'EnumCanceled
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"inactive" -> GetIssuingCardsParametersQueryStatus'
GetIssuingCardsParametersQueryStatus'EnumInactive
            | Bool
GHC.Base.otherwise -> Value -> GetIssuingCardsParametersQueryStatus'
GetIssuingCardsParametersQueryStatus'Other Value
val
      )

-- | Defines the enum schema located at @paths.\/v1\/issuing\/cards.GET.parameters.properties.queryType@ in the specification.
--
-- Represents the parameter named \'type\'
--
-- Only return cards that have the given type. One of \`virtual\` or \`physical\`.
data GetIssuingCardsParametersQueryType'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    GetIssuingCardsParametersQueryType'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.
    GetIssuingCardsParametersQueryType'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"physical"@
    GetIssuingCardsParametersQueryType'EnumPhysical
  | -- | Represents the JSON value @"virtual"@
    GetIssuingCardsParametersQueryType'EnumVirtual
  deriving (Int -> GetIssuingCardsParametersQueryType' -> ShowS
[GetIssuingCardsParametersQueryType'] -> ShowS
GetIssuingCardsParametersQueryType' -> String
(Int -> GetIssuingCardsParametersQueryType' -> ShowS)
-> (GetIssuingCardsParametersQueryType' -> String)
-> ([GetIssuingCardsParametersQueryType'] -> ShowS)
-> Show GetIssuingCardsParametersQueryType'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetIssuingCardsParametersQueryType'] -> ShowS
$cshowList :: [GetIssuingCardsParametersQueryType'] -> ShowS
show :: GetIssuingCardsParametersQueryType' -> String
$cshow :: GetIssuingCardsParametersQueryType' -> String
showsPrec :: Int -> GetIssuingCardsParametersQueryType' -> ShowS
$cshowsPrec :: Int -> GetIssuingCardsParametersQueryType' -> ShowS
GHC.Show.Show, GetIssuingCardsParametersQueryType'
-> GetIssuingCardsParametersQueryType' -> Bool
(GetIssuingCardsParametersQueryType'
 -> GetIssuingCardsParametersQueryType' -> Bool)
-> (GetIssuingCardsParametersQueryType'
    -> GetIssuingCardsParametersQueryType' -> Bool)
-> Eq GetIssuingCardsParametersQueryType'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetIssuingCardsParametersQueryType'
-> GetIssuingCardsParametersQueryType' -> Bool
$c/= :: GetIssuingCardsParametersQueryType'
-> GetIssuingCardsParametersQueryType' -> Bool
== :: GetIssuingCardsParametersQueryType'
-> GetIssuingCardsParametersQueryType' -> Bool
$c== :: GetIssuingCardsParametersQueryType'
-> GetIssuingCardsParametersQueryType' -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON GetIssuingCardsParametersQueryType' where
  toJSON :: GetIssuingCardsParametersQueryType' -> Value
toJSON (GetIssuingCardsParametersQueryType'Other Value
val) = Value
val
  toJSON (GetIssuingCardsParametersQueryType'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (GetIssuingCardsParametersQueryType'
GetIssuingCardsParametersQueryType'EnumPhysical) = Value
"physical"
  toJSON (GetIssuingCardsParametersQueryType'
GetIssuingCardsParametersQueryType'EnumVirtual) = Value
"virtual"

instance Data.Aeson.Types.FromJSON.FromJSON GetIssuingCardsParametersQueryType' where
  parseJSON :: Value -> Parser GetIssuingCardsParametersQueryType'
parseJSON Value
val =
    GetIssuingCardsParametersQueryType'
-> Parser GetIssuingCardsParametersQueryType'
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
"physical" -> GetIssuingCardsParametersQueryType'
GetIssuingCardsParametersQueryType'EnumPhysical
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"virtual" -> GetIssuingCardsParametersQueryType'
GetIssuingCardsParametersQueryType'EnumVirtual
            | Bool
GHC.Base.otherwise -> Value -> GetIssuingCardsParametersQueryType'
GetIssuingCardsParametersQueryType'Other Value
val
      )

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

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

instance Data.Aeson.Types.ToJSON.ToJSON GetIssuingCardsResponseBody200 where
  toJSON :: GetIssuingCardsResponseBody200 -> Value
toJSON GetIssuingCardsResponseBody200
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"data" Text -> [Issuing'card] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingCardsResponseBody200 -> [Issuing'card]
getIssuingCardsResponseBody200Data GetIssuingCardsResponseBody200
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..= GetIssuingCardsResponseBody200 -> Bool
getIssuingCardsResponseBody200HasMore GetIssuingCardsResponseBody200
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..= GetIssuingCardsResponseBody200 -> Text
getIssuingCardsResponseBody200Url GetIssuingCardsResponseBody200
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 :: GetIssuingCardsResponseBody200 -> Encoding
toEncoding GetIssuingCardsResponseBody200
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"data" Text -> [Issuing'card] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingCardsResponseBody200 -> [Issuing'card]
getIssuingCardsResponseBody200Data GetIssuingCardsResponseBody200
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..= GetIssuingCardsResponseBody200 -> Bool
getIssuingCardsResponseBody200HasMore GetIssuingCardsResponseBody200
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..= GetIssuingCardsResponseBody200 -> Text
getIssuingCardsResponseBody200Url GetIssuingCardsResponseBody200
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 GetIssuingCardsResponseBody200 where
  parseJSON :: Value -> Parser GetIssuingCardsResponseBody200
parseJSON = String
-> (Object -> Parser GetIssuingCardsResponseBody200)
-> Value
-> Parser GetIssuingCardsResponseBody200
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"GetIssuingCardsResponseBody200" (\Object
obj -> ((([Issuing'card] -> Bool -> Text -> GetIssuingCardsResponseBody200)
-> Parser
     ([Issuing'card] -> Bool -> Text -> GetIssuingCardsResponseBody200)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure [Issuing'card] -> Bool -> Text -> GetIssuingCardsResponseBody200
GetIssuingCardsResponseBody200 Parser
  ([Issuing'card] -> Bool -> Text -> GetIssuingCardsResponseBody200)
-> Parser [Issuing'card]
-> Parser (Bool -> Text -> GetIssuingCardsResponseBody200)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser [Issuing'card]
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"data")) Parser (Bool -> Text -> GetIssuingCardsResponseBody200)
-> Parser Bool -> Parser (Text -> GetIssuingCardsResponseBody200)
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 -> GetIssuingCardsResponseBody200)
-> Parser Text -> Parser GetIssuingCardsResponseBody200
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 'GetIssuingCardsResponseBody200' with all required fields.
mkGetIssuingCardsResponseBody200 ::
  -- | 'getIssuingCardsResponseBody200Data'
  [Issuing'card] ->
  -- | 'getIssuingCardsResponseBody200HasMore'
  GHC.Types.Bool ->
  -- | 'getIssuingCardsResponseBody200Url'
  Data.Text.Internal.Text ->
  GetIssuingCardsResponseBody200
mkGetIssuingCardsResponseBody200 :: [Issuing'card] -> Bool -> Text -> GetIssuingCardsResponseBody200
mkGetIssuingCardsResponseBody200 [Issuing'card]
getIssuingCardsResponseBody200Data Bool
getIssuingCardsResponseBody200HasMore Text
getIssuingCardsResponseBody200Url =
  GetIssuingCardsResponseBody200 :: [Issuing'card] -> Bool -> Text -> GetIssuingCardsResponseBody200
GetIssuingCardsResponseBody200
    { getIssuingCardsResponseBody200Data :: [Issuing'card]
getIssuingCardsResponseBody200Data = [Issuing'card]
getIssuingCardsResponseBody200Data,
      getIssuingCardsResponseBody200HasMore :: Bool
getIssuingCardsResponseBody200HasMore = Bool
getIssuingCardsResponseBody200HasMore,
      getIssuingCardsResponseBody200Url :: Text
getIssuingCardsResponseBody200Url = Text
getIssuingCardsResponseBody200Url
    }