{-# 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 getIssuingAuthorizations
module StripeAPI.Operations.GetIssuingAuthorizations 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/authorizations
--
-- \<p>Returns a list of Issuing \<code>Authorization\<\/code> objects. The objects are sorted in descending order by creation date, with the most recently created object appearing first.\<\/p>
getIssuingAuthorizations ::
  forall m.
  StripeAPI.Common.MonadHTTP m =>
  -- | Contains all available parameters of this operation (query and path parameters)
  GetIssuingAuthorizationsParameters ->
  -- | Monadic computation which returns the result of the operation
  StripeAPI.Common.StripeT m (Network.HTTP.Client.Types.Response GetIssuingAuthorizationsResponse)
getIssuingAuthorizations :: GetIssuingAuthorizationsParameters
-> StripeT m (Response GetIssuingAuthorizationsResponse)
getIssuingAuthorizations GetIssuingAuthorizationsParameters
parameters =
  (Response ByteString -> Response GetIssuingAuthorizationsResponse)
-> StripeT m (Response ByteString)
-> StripeT m (Response GetIssuingAuthorizationsResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
    ( \Response ByteString
response_0 ->
        (ByteString -> GetIssuingAuthorizationsResponse)
-> Response ByteString -> Response GetIssuingAuthorizationsResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
          ( (String -> GetIssuingAuthorizationsResponse)
-> (GetIssuingAuthorizationsResponse
    -> GetIssuingAuthorizationsResponse)
-> Either String GetIssuingAuthorizationsResponse
-> GetIssuingAuthorizationsResponse
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Data.Either.either String -> GetIssuingAuthorizationsResponse
GetIssuingAuthorizationsResponseError GetIssuingAuthorizationsResponse
-> GetIssuingAuthorizationsResponse
forall a. a -> a
GHC.Base.id
              (Either String GetIssuingAuthorizationsResponse
 -> GetIssuingAuthorizationsResponse)
-> (ByteString -> Either String GetIssuingAuthorizationsResponse)
-> ByteString
-> GetIssuingAuthorizationsResponse
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) ->
                                   GetIssuingAuthorizationsResponseBody200
-> GetIssuingAuthorizationsResponse
GetIssuingAuthorizationsResponse200
                                     (GetIssuingAuthorizationsResponseBody200
 -> GetIssuingAuthorizationsResponse)
-> Either String GetIssuingAuthorizationsResponseBody200
-> Either String GetIssuingAuthorizationsResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> ( ByteString -> Either String GetIssuingAuthorizationsResponseBody200
forall a. FromJSON a => ByteString -> Either String a
Data.Aeson.eitherDecodeStrict ByteString
body ::
                                                          Data.Either.Either
                                                            GHC.Base.String
                                                            GetIssuingAuthorizationsResponseBody200
                                                      )
                                 | 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 -> GetIssuingAuthorizationsResponse
GetIssuingAuthorizationsResponseDefault
                                     (Error -> GetIssuingAuthorizationsResponse)
-> Either String Error
-> Either String GetIssuingAuthorizationsResponse
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 GetIssuingAuthorizationsResponse
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/issuing/authorizations")
        [ Text -> Maybe Value -> Text -> Bool -> QueryParameter
StripeAPI.Common.QueryParameter (String -> Text
Data.Text.pack String
"card") (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.<$> GetIssuingAuthorizationsParameters -> Maybe Text
getIssuingAuthorizationsParametersQueryCard GetIssuingAuthorizationsParameters
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
"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.<$> GetIssuingAuthorizationsParameters -> Maybe Text
getIssuingAuthorizationsParametersQueryCardholder GetIssuingAuthorizationsParameters
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") (GetIssuingAuthorizationsParametersQueryCreated'Variants -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (GetIssuingAuthorizationsParametersQueryCreated'Variants -> Value)
-> Maybe GetIssuingAuthorizationsParametersQueryCreated'Variants
-> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> GetIssuingAuthorizationsParameters
-> Maybe GetIssuingAuthorizationsParametersQueryCreated'Variants
getIssuingAuthorizationsParametersQueryCreated GetIssuingAuthorizationsParameters
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.<$> GetIssuingAuthorizationsParameters -> Maybe Text
getIssuingAuthorizationsParametersQueryEndingBefore GetIssuingAuthorizationsParameters
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.<$> GetIssuingAuthorizationsParameters -> Maybe [Text]
getIssuingAuthorizationsParametersQueryExpand GetIssuingAuthorizationsParameters
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.<$> GetIssuingAuthorizationsParameters -> Maybe Int
getIssuingAuthorizationsParametersQueryLimit GetIssuingAuthorizationsParameters
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.<$> GetIssuingAuthorizationsParameters -> Maybe Text
getIssuingAuthorizationsParametersQueryStartingAfter GetIssuingAuthorizationsParameters
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") (GetIssuingAuthorizationsParametersQueryStatus' -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (GetIssuingAuthorizationsParametersQueryStatus' -> Value)
-> Maybe GetIssuingAuthorizationsParametersQueryStatus'
-> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> GetIssuingAuthorizationsParameters
-> Maybe GetIssuingAuthorizationsParametersQueryStatus'
getIssuingAuthorizationsParametersQueryStatus GetIssuingAuthorizationsParameters
parameters) (String -> Text
Data.Text.pack String
"form") Bool
GHC.Types.True
        ]
    )

-- | Defines the object schema located at @paths.\/v1\/issuing\/authorizations.GET.parameters@ in the specification.
data GetIssuingAuthorizationsParameters = GetIssuingAuthorizationsParameters
  { -- | queryCard: Represents the parameter named \'card\'
    --
    -- Only return authorizations that belong to the given card.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    GetIssuingAuthorizationsParameters -> Maybe Text
getIssuingAuthorizationsParametersQueryCard :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | queryCardholder: Represents the parameter named \'cardholder\'
    --
    -- Only return authorizations that belong to the given cardholder.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    GetIssuingAuthorizationsParameters -> Maybe Text
getIssuingAuthorizationsParametersQueryCardholder :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | queryCreated: Represents the parameter named \'created\'
    --
    -- Only return authorizations that were created during the given date interval.
    GetIssuingAuthorizationsParameters
-> Maybe GetIssuingAuthorizationsParametersQueryCreated'Variants
getIssuingAuthorizationsParametersQueryCreated :: (GHC.Maybe.Maybe GetIssuingAuthorizationsParametersQueryCreated'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
    GetIssuingAuthorizationsParameters -> Maybe Text
getIssuingAuthorizationsParametersQueryEndingBefore :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | queryExpand: Represents the parameter named \'expand\'
    --
    -- Specifies which fields in the response should be expanded.
    GetIssuingAuthorizationsParameters -> Maybe [Text]
getIssuingAuthorizationsParametersQueryExpand :: (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.
    GetIssuingAuthorizationsParameters -> Maybe Int
getIssuingAuthorizationsParametersQueryLimit :: (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
    GetIssuingAuthorizationsParameters -> Maybe Text
getIssuingAuthorizationsParametersQueryStartingAfter :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | queryStatus: Represents the parameter named \'status\'
    --
    -- Only return authorizations with the given status. One of \`pending\`, \`closed\`, or \`reversed\`.
    GetIssuingAuthorizationsParameters
-> Maybe GetIssuingAuthorizationsParametersQueryStatus'
getIssuingAuthorizationsParametersQueryStatus :: (GHC.Maybe.Maybe GetIssuingAuthorizationsParametersQueryStatus')
  }
  deriving
    ( Int -> GetIssuingAuthorizationsParameters -> ShowS
[GetIssuingAuthorizationsParameters] -> ShowS
GetIssuingAuthorizationsParameters -> String
(Int -> GetIssuingAuthorizationsParameters -> ShowS)
-> (GetIssuingAuthorizationsParameters -> String)
-> ([GetIssuingAuthorizationsParameters] -> ShowS)
-> Show GetIssuingAuthorizationsParameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetIssuingAuthorizationsParameters] -> ShowS
$cshowList :: [GetIssuingAuthorizationsParameters] -> ShowS
show :: GetIssuingAuthorizationsParameters -> String
$cshow :: GetIssuingAuthorizationsParameters -> String
showsPrec :: Int -> GetIssuingAuthorizationsParameters -> ShowS
$cshowsPrec :: Int -> GetIssuingAuthorizationsParameters -> ShowS
GHC.Show.Show,
      GetIssuingAuthorizationsParameters
-> GetIssuingAuthorizationsParameters -> Bool
(GetIssuingAuthorizationsParameters
 -> GetIssuingAuthorizationsParameters -> Bool)
-> (GetIssuingAuthorizationsParameters
    -> GetIssuingAuthorizationsParameters -> Bool)
-> Eq GetIssuingAuthorizationsParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetIssuingAuthorizationsParameters
-> GetIssuingAuthorizationsParameters -> Bool
$c/= :: GetIssuingAuthorizationsParameters
-> GetIssuingAuthorizationsParameters -> Bool
== :: GetIssuingAuthorizationsParameters
-> GetIssuingAuthorizationsParameters -> Bool
$c== :: GetIssuingAuthorizationsParameters
-> GetIssuingAuthorizationsParameters -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON GetIssuingAuthorizationsParameters where
  toJSON :: GetIssuingAuthorizationsParameters -> Value
toJSON GetIssuingAuthorizationsParameters
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"queryCard" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingAuthorizationsParameters -> Maybe Text
getIssuingAuthorizationsParametersQueryCard GetIssuingAuthorizationsParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryCardholder" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingAuthorizationsParameters -> Maybe Text
getIssuingAuthorizationsParametersQueryCardholder GetIssuingAuthorizationsParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryCreated" Text
-> Maybe GetIssuingAuthorizationsParametersQueryCreated'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingAuthorizationsParameters
-> Maybe GetIssuingAuthorizationsParametersQueryCreated'Variants
getIssuingAuthorizationsParametersQueryCreated GetIssuingAuthorizationsParameters
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..= GetIssuingAuthorizationsParameters -> Maybe Text
getIssuingAuthorizationsParametersQueryEndingBefore GetIssuingAuthorizationsParameters
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..= GetIssuingAuthorizationsParameters -> Maybe [Text]
getIssuingAuthorizationsParametersQueryExpand GetIssuingAuthorizationsParameters
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..= GetIssuingAuthorizationsParameters -> Maybe Int
getIssuingAuthorizationsParametersQueryLimit GetIssuingAuthorizationsParameters
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..= GetIssuingAuthorizationsParameters -> Maybe Text
getIssuingAuthorizationsParametersQueryStartingAfter GetIssuingAuthorizationsParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryStatus" Text
-> Maybe GetIssuingAuthorizationsParametersQueryStatus' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingAuthorizationsParameters
-> Maybe GetIssuingAuthorizationsParametersQueryStatus'
getIssuingAuthorizationsParametersQueryStatus GetIssuingAuthorizationsParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: GetIssuingAuthorizationsParameters -> Encoding
toEncoding GetIssuingAuthorizationsParameters
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"queryCard" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingAuthorizationsParameters -> Maybe Text
getIssuingAuthorizationsParametersQueryCard GetIssuingAuthorizationsParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"queryCardholder" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingAuthorizationsParameters -> Maybe Text
getIssuingAuthorizationsParametersQueryCardholder GetIssuingAuthorizationsParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"queryCreated" Text
-> Maybe GetIssuingAuthorizationsParametersQueryCreated'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingAuthorizationsParameters
-> Maybe GetIssuingAuthorizationsParametersQueryCreated'Variants
getIssuingAuthorizationsParametersQueryCreated GetIssuingAuthorizationsParameters
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..= GetIssuingAuthorizationsParameters -> Maybe Text
getIssuingAuthorizationsParametersQueryEndingBefore GetIssuingAuthorizationsParameters
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..= GetIssuingAuthorizationsParameters -> Maybe [Text]
getIssuingAuthorizationsParametersQueryExpand GetIssuingAuthorizationsParameters
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..= GetIssuingAuthorizationsParameters -> Maybe Int
getIssuingAuthorizationsParametersQueryLimit GetIssuingAuthorizationsParameters
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..= GetIssuingAuthorizationsParameters -> Maybe Text
getIssuingAuthorizationsParametersQueryStartingAfter GetIssuingAuthorizationsParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"queryStatus" Text
-> Maybe GetIssuingAuthorizationsParametersQueryStatus' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingAuthorizationsParameters
-> Maybe GetIssuingAuthorizationsParametersQueryStatus'
getIssuingAuthorizationsParametersQueryStatus GetIssuingAuthorizationsParameters
obj))))))))

instance Data.Aeson.Types.FromJSON.FromJSON GetIssuingAuthorizationsParameters where
  parseJSON :: Value -> Parser GetIssuingAuthorizationsParameters
parseJSON = String
-> (Object -> Parser GetIssuingAuthorizationsParameters)
-> Value
-> Parser GetIssuingAuthorizationsParameters
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"GetIssuingAuthorizationsParameters" (\Object
obj -> ((((((((Maybe Text
 -> Maybe Text
 -> Maybe GetIssuingAuthorizationsParametersQueryCreated'Variants
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe Int
 -> Maybe Text
 -> Maybe GetIssuingAuthorizationsParametersQueryStatus'
 -> GetIssuingAuthorizationsParameters)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe GetIssuingAuthorizationsParametersQueryCreated'Variants
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Int
      -> Maybe Text
      -> Maybe GetIssuingAuthorizationsParametersQueryStatus'
      -> GetIssuingAuthorizationsParameters)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe Text
-> Maybe GetIssuingAuthorizationsParametersQueryCreated'Variants
-> Maybe Text
-> Maybe [Text]
-> Maybe Int
-> Maybe Text
-> Maybe GetIssuingAuthorizationsParametersQueryStatus'
-> GetIssuingAuthorizationsParameters
GetIssuingAuthorizationsParameters Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe GetIssuingAuthorizationsParametersQueryCreated'Variants
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Int
   -> Maybe Text
   -> Maybe GetIssuingAuthorizationsParametersQueryStatus'
   -> GetIssuingAuthorizationsParameters)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe GetIssuingAuthorizationsParametersQueryCreated'Variants
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Int
      -> Maybe Text
      -> Maybe GetIssuingAuthorizationsParametersQueryStatus'
      -> GetIssuingAuthorizationsParameters)
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
"queryCard")) Parser
  (Maybe Text
   -> Maybe GetIssuingAuthorizationsParametersQueryCreated'Variants
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Int
   -> Maybe Text
   -> Maybe GetIssuingAuthorizationsParametersQueryStatus'
   -> GetIssuingAuthorizationsParameters)
-> Parser (Maybe Text)
-> Parser
     (Maybe GetIssuingAuthorizationsParametersQueryCreated'Variants
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Int
      -> Maybe Text
      -> Maybe GetIssuingAuthorizationsParametersQueryStatus'
      -> GetIssuingAuthorizationsParameters)
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 GetIssuingAuthorizationsParametersQueryCreated'Variants
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Int
   -> Maybe Text
   -> Maybe GetIssuingAuthorizationsParametersQueryStatus'
   -> GetIssuingAuthorizationsParameters)
-> Parser
     (Maybe GetIssuingAuthorizationsParametersQueryCreated'Variants)
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Maybe Int
      -> Maybe Text
      -> Maybe GetIssuingAuthorizationsParametersQueryStatus'
      -> GetIssuingAuthorizationsParameters)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe GetIssuingAuthorizationsParametersQueryCreated'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"queryCreated")) Parser
  (Maybe Text
   -> Maybe [Text]
   -> Maybe Int
   -> Maybe Text
   -> Maybe GetIssuingAuthorizationsParametersQueryStatus'
   -> GetIssuingAuthorizationsParameters)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text]
      -> Maybe Int
      -> Maybe Text
      -> Maybe GetIssuingAuthorizationsParametersQueryStatus'
      -> GetIssuingAuthorizationsParameters)
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 GetIssuingAuthorizationsParametersQueryStatus'
   -> GetIssuingAuthorizationsParameters)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Maybe GetIssuingAuthorizationsParametersQueryStatus'
      -> GetIssuingAuthorizationsParameters)
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 GetIssuingAuthorizationsParametersQueryStatus'
   -> GetIssuingAuthorizationsParameters)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe GetIssuingAuthorizationsParametersQueryStatus'
      -> GetIssuingAuthorizationsParameters)
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 GetIssuingAuthorizationsParametersQueryStatus'
   -> GetIssuingAuthorizationsParameters)
-> Parser (Maybe Text)
-> Parser
     (Maybe GetIssuingAuthorizationsParametersQueryStatus'
      -> GetIssuingAuthorizationsParameters)
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 GetIssuingAuthorizationsParametersQueryStatus'
   -> GetIssuingAuthorizationsParameters)
-> Parser (Maybe GetIssuingAuthorizationsParametersQueryStatus')
-> Parser GetIssuingAuthorizationsParameters
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe GetIssuingAuthorizationsParametersQueryStatus')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"queryStatus"))

-- | Create a new 'GetIssuingAuthorizationsParameters' with all required fields.
mkGetIssuingAuthorizationsParameters :: GetIssuingAuthorizationsParameters
mkGetIssuingAuthorizationsParameters :: GetIssuingAuthorizationsParameters
mkGetIssuingAuthorizationsParameters =
  GetIssuingAuthorizationsParameters :: Maybe Text
-> Maybe Text
-> Maybe GetIssuingAuthorizationsParametersQueryCreated'Variants
-> Maybe Text
-> Maybe [Text]
-> Maybe Int
-> Maybe Text
-> Maybe GetIssuingAuthorizationsParametersQueryStatus'
-> GetIssuingAuthorizationsParameters
GetIssuingAuthorizationsParameters
    { getIssuingAuthorizationsParametersQueryCard :: Maybe Text
getIssuingAuthorizationsParametersQueryCard = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      getIssuingAuthorizationsParametersQueryCardholder :: Maybe Text
getIssuingAuthorizationsParametersQueryCardholder = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      getIssuingAuthorizationsParametersQueryCreated :: Maybe GetIssuingAuthorizationsParametersQueryCreated'Variants
getIssuingAuthorizationsParametersQueryCreated = Maybe GetIssuingAuthorizationsParametersQueryCreated'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      getIssuingAuthorizationsParametersQueryEndingBefore :: Maybe Text
getIssuingAuthorizationsParametersQueryEndingBefore = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      getIssuingAuthorizationsParametersQueryExpand :: Maybe [Text]
getIssuingAuthorizationsParametersQueryExpand = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing,
      getIssuingAuthorizationsParametersQueryLimit :: Maybe Int
getIssuingAuthorizationsParametersQueryLimit = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      getIssuingAuthorizationsParametersQueryStartingAfter :: Maybe Text
getIssuingAuthorizationsParametersQueryStartingAfter = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      getIssuingAuthorizationsParametersQueryStatus :: Maybe GetIssuingAuthorizationsParametersQueryStatus'
getIssuingAuthorizationsParametersQueryStatus = Maybe GetIssuingAuthorizationsParametersQueryStatus'
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

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

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

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

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

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

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

instance Data.Aeson.Types.ToJSON.ToJSON GetIssuingAuthorizationsParametersQueryStatus' where
  toJSON :: GetIssuingAuthorizationsParametersQueryStatus' -> Value
toJSON (GetIssuingAuthorizationsParametersQueryStatus'Other Value
val) = Value
val
  toJSON (GetIssuingAuthorizationsParametersQueryStatus'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (GetIssuingAuthorizationsParametersQueryStatus'
GetIssuingAuthorizationsParametersQueryStatus'EnumClosed) = Value
"closed"
  toJSON (GetIssuingAuthorizationsParametersQueryStatus'
GetIssuingAuthorizationsParametersQueryStatus'EnumPending) = Value
"pending"
  toJSON (GetIssuingAuthorizationsParametersQueryStatus'
GetIssuingAuthorizationsParametersQueryStatus'EnumReversed) = Value
"reversed"

instance Data.Aeson.Types.FromJSON.FromJSON GetIssuingAuthorizationsParametersQueryStatus' where
  parseJSON :: Value -> Parser GetIssuingAuthorizationsParametersQueryStatus'
parseJSON Value
val =
    GetIssuingAuthorizationsParametersQueryStatus'
-> Parser GetIssuingAuthorizationsParametersQueryStatus'
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
"closed" -> GetIssuingAuthorizationsParametersQueryStatus'
GetIssuingAuthorizationsParametersQueryStatus'EnumClosed
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"pending" -> GetIssuingAuthorizationsParametersQueryStatus'
GetIssuingAuthorizationsParametersQueryStatus'EnumPending
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"reversed" -> GetIssuingAuthorizationsParametersQueryStatus'
GetIssuingAuthorizationsParametersQueryStatus'EnumReversed
            | Bool
GHC.Base.otherwise -> Value -> GetIssuingAuthorizationsParametersQueryStatus'
GetIssuingAuthorizationsParametersQueryStatus'Other Value
val
      )

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

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

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