{-# 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 getIssuingDisputes
module StripeAPI.Operations.GetIssuingDisputes 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/disputes
--
-- \<p>Returns a list of Issuing \<code>Dispute\<\/code> objects. The objects are sorted in descending order by creation date, with the most recently created object appearing first.\<\/p>
getIssuingDisputes ::
  forall m.
  StripeAPI.Common.MonadHTTP m =>
  -- | Contains all available parameters of this operation (query and path parameters)
  GetIssuingDisputesParameters ->
  -- | Monadic computation which returns the result of the operation
  StripeAPI.Common.StripeT m (Network.HTTP.Client.Types.Response GetIssuingDisputesResponse)
getIssuingDisputes :: GetIssuingDisputesParameters
-> StripeT m (Response GetIssuingDisputesResponse)
getIssuingDisputes GetIssuingDisputesParameters
parameters =
  (Response ByteString -> Response GetIssuingDisputesResponse)
-> StripeT m (Response ByteString)
-> StripeT m (Response GetIssuingDisputesResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
    ( \Response ByteString
response_0 ->
        (ByteString -> GetIssuingDisputesResponse)
-> Response ByteString -> Response GetIssuingDisputesResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
          ( (String -> GetIssuingDisputesResponse)
-> (GetIssuingDisputesResponse -> GetIssuingDisputesResponse)
-> Either String GetIssuingDisputesResponse
-> GetIssuingDisputesResponse
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Data.Either.either String -> GetIssuingDisputesResponse
GetIssuingDisputesResponseError GetIssuingDisputesResponse -> GetIssuingDisputesResponse
forall a. a -> a
GHC.Base.id
              (Either String GetIssuingDisputesResponse
 -> GetIssuingDisputesResponse)
-> (ByteString -> Either String GetIssuingDisputesResponse)
-> ByteString
-> GetIssuingDisputesResponse
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) ->
                                   GetIssuingDisputesResponseBody200 -> GetIssuingDisputesResponse
GetIssuingDisputesResponse200
                                     (GetIssuingDisputesResponseBody200 -> GetIssuingDisputesResponse)
-> Either String GetIssuingDisputesResponseBody200
-> Either String GetIssuingDisputesResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> ( ByteString -> Either String GetIssuingDisputesResponseBody200
forall a. FromJSON a => ByteString -> Either String a
Data.Aeson.eitherDecodeStrict ByteString
body ::
                                                          Data.Either.Either
                                                            GHC.Base.String
                                                            GetIssuingDisputesResponseBody200
                                                      )
                                 | 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 -> GetIssuingDisputesResponse
GetIssuingDisputesResponseDefault
                                     (Error -> GetIssuingDisputesResponse)
-> Either String Error -> Either String GetIssuingDisputesResponse
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 GetIssuingDisputesResponse
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/disputes")
        [ Text -> Maybe Value -> Text -> Bool -> QueryParameter
StripeAPI.Common.QueryParameter (String -> Text
Data.Text.pack String
"created") (GetIssuingDisputesParametersQueryCreated'Variants -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (GetIssuingDisputesParametersQueryCreated'Variants -> Value)
-> Maybe GetIssuingDisputesParametersQueryCreated'Variants
-> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> GetIssuingDisputesParameters
-> Maybe GetIssuingDisputesParametersQueryCreated'Variants
getIssuingDisputesParametersQueryCreated GetIssuingDisputesParameters
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.<$> GetIssuingDisputesParameters -> Maybe Text
getIssuingDisputesParametersQueryEndingBefore GetIssuingDisputesParameters
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.<$> GetIssuingDisputesParameters -> Maybe [Text]
getIssuingDisputesParametersQueryExpand GetIssuingDisputesParameters
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.<$> GetIssuingDisputesParameters -> Maybe Int
getIssuingDisputesParametersQueryLimit GetIssuingDisputesParameters
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.<$> GetIssuingDisputesParameters -> Maybe Text
getIssuingDisputesParametersQueryStartingAfter GetIssuingDisputesParameters
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") (GetIssuingDisputesParametersQueryStatus' -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (GetIssuingDisputesParametersQueryStatus' -> Value)
-> Maybe GetIssuingDisputesParametersQueryStatus' -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> GetIssuingDisputesParameters
-> Maybe GetIssuingDisputesParametersQueryStatus'
getIssuingDisputesParametersQueryStatus GetIssuingDisputesParameters
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
"transaction") (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.<$> GetIssuingDisputesParameters -> Maybe Text
getIssuingDisputesParametersQueryTransaction GetIssuingDisputesParameters
parameters) (String -> Text
Data.Text.pack String
"form") Bool
GHC.Types.True
        ]
    )

-- | Defines the object schema located at @paths.\/v1\/issuing\/disputes.GET.parameters@ in the specification.
data GetIssuingDisputesParameters = GetIssuingDisputesParameters
  { -- | queryCreated: Represents the parameter named \'created\'
    --
    -- Select Issuing disputes that were created during the given date interval.
    GetIssuingDisputesParameters
-> Maybe GetIssuingDisputesParametersQueryCreated'Variants
getIssuingDisputesParametersQueryCreated :: (GHC.Maybe.Maybe GetIssuingDisputesParametersQueryCreated'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
    GetIssuingDisputesParameters -> Maybe Text
getIssuingDisputesParametersQueryEndingBefore :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | queryExpand: Represents the parameter named \'expand\'
    --
    -- Specifies which fields in the response should be expanded.
    GetIssuingDisputesParameters -> Maybe [Text]
getIssuingDisputesParametersQueryExpand :: (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.
    GetIssuingDisputesParameters -> Maybe Int
getIssuingDisputesParametersQueryLimit :: (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
    GetIssuingDisputesParameters -> Maybe Text
getIssuingDisputesParametersQueryStartingAfter :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | queryStatus: Represents the parameter named \'status\'
    --
    -- Select Issuing disputes with the given status.
    GetIssuingDisputesParameters
-> Maybe GetIssuingDisputesParametersQueryStatus'
getIssuingDisputesParametersQueryStatus :: (GHC.Maybe.Maybe GetIssuingDisputesParametersQueryStatus'),
    -- | queryTransaction: Represents the parameter named \'transaction\'
    --
    -- Select the Issuing dispute for the given transaction.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    GetIssuingDisputesParameters -> Maybe Text
getIssuingDisputesParametersQueryTransaction :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int -> GetIssuingDisputesParameters -> ShowS
[GetIssuingDisputesParameters] -> ShowS
GetIssuingDisputesParameters -> String
(Int -> GetIssuingDisputesParameters -> ShowS)
-> (GetIssuingDisputesParameters -> String)
-> ([GetIssuingDisputesParameters] -> ShowS)
-> Show GetIssuingDisputesParameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetIssuingDisputesParameters] -> ShowS
$cshowList :: [GetIssuingDisputesParameters] -> ShowS
show :: GetIssuingDisputesParameters -> String
$cshow :: GetIssuingDisputesParameters -> String
showsPrec :: Int -> GetIssuingDisputesParameters -> ShowS
$cshowsPrec :: Int -> GetIssuingDisputesParameters -> ShowS
GHC.Show.Show,
      GetIssuingDisputesParameters
-> GetIssuingDisputesParameters -> Bool
(GetIssuingDisputesParameters
 -> GetIssuingDisputesParameters -> Bool)
-> (GetIssuingDisputesParameters
    -> GetIssuingDisputesParameters -> Bool)
-> Eq GetIssuingDisputesParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetIssuingDisputesParameters
-> GetIssuingDisputesParameters -> Bool
$c/= :: GetIssuingDisputesParameters
-> GetIssuingDisputesParameters -> Bool
== :: GetIssuingDisputesParameters
-> GetIssuingDisputesParameters -> Bool
$c== :: GetIssuingDisputesParameters
-> GetIssuingDisputesParameters -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON GetIssuingDisputesParameters where
  toJSON :: GetIssuingDisputesParameters -> Value
toJSON GetIssuingDisputesParameters
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"queryCreated" Text
-> Maybe GetIssuingDisputesParametersQueryCreated'Variants -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingDisputesParameters
-> Maybe GetIssuingDisputesParametersQueryCreated'Variants
getIssuingDisputesParametersQueryCreated GetIssuingDisputesParameters
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..= GetIssuingDisputesParameters -> Maybe Text
getIssuingDisputesParametersQueryEndingBefore GetIssuingDisputesParameters
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..= GetIssuingDisputesParameters -> Maybe [Text]
getIssuingDisputesParametersQueryExpand GetIssuingDisputesParameters
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..= GetIssuingDisputesParameters -> Maybe Int
getIssuingDisputesParametersQueryLimit GetIssuingDisputesParameters
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..= GetIssuingDisputesParameters -> Maybe Text
getIssuingDisputesParametersQueryStartingAfter GetIssuingDisputesParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryStatus" Text -> Maybe GetIssuingDisputesParametersQueryStatus' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingDisputesParameters
-> Maybe GetIssuingDisputesParametersQueryStatus'
getIssuingDisputesParametersQueryStatus GetIssuingDisputesParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryTransaction" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingDisputesParameters -> Maybe Text
getIssuingDisputesParametersQueryTransaction GetIssuingDisputesParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: GetIssuingDisputesParameters -> Encoding
toEncoding GetIssuingDisputesParameters
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"queryCreated" Text
-> Maybe GetIssuingDisputesParametersQueryCreated'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingDisputesParameters
-> Maybe GetIssuingDisputesParametersQueryCreated'Variants
getIssuingDisputesParametersQueryCreated GetIssuingDisputesParameters
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..= GetIssuingDisputesParameters -> Maybe Text
getIssuingDisputesParametersQueryEndingBefore GetIssuingDisputesParameters
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..= GetIssuingDisputesParameters -> Maybe [Text]
getIssuingDisputesParametersQueryExpand GetIssuingDisputesParameters
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..= GetIssuingDisputesParameters -> Maybe Int
getIssuingDisputesParametersQueryLimit GetIssuingDisputesParameters
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..= GetIssuingDisputesParameters -> Maybe Text
getIssuingDisputesParametersQueryStartingAfter GetIssuingDisputesParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"queryStatus" Text -> Maybe GetIssuingDisputesParametersQueryStatus' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingDisputesParameters
-> Maybe GetIssuingDisputesParametersQueryStatus'
getIssuingDisputesParametersQueryStatus GetIssuingDisputesParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"queryTransaction" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetIssuingDisputesParameters -> Maybe Text
getIssuingDisputesParametersQueryTransaction GetIssuingDisputesParameters
obj)))))))

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

-- | Create a new 'GetIssuingDisputesParameters' with all required fields.
mkGetIssuingDisputesParameters :: GetIssuingDisputesParameters
mkGetIssuingDisputesParameters :: GetIssuingDisputesParameters
mkGetIssuingDisputesParameters =
  GetIssuingDisputesParameters :: Maybe GetIssuingDisputesParametersQueryCreated'Variants
-> Maybe Text
-> Maybe [Text]
-> Maybe Int
-> Maybe Text
-> Maybe GetIssuingDisputesParametersQueryStatus'
-> Maybe Text
-> GetIssuingDisputesParameters
GetIssuingDisputesParameters
    { getIssuingDisputesParametersQueryCreated :: Maybe GetIssuingDisputesParametersQueryCreated'Variants
getIssuingDisputesParametersQueryCreated = Maybe GetIssuingDisputesParametersQueryCreated'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      getIssuingDisputesParametersQueryEndingBefore :: Maybe Text
getIssuingDisputesParametersQueryEndingBefore = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      getIssuingDisputesParametersQueryExpand :: Maybe [Text]
getIssuingDisputesParametersQueryExpand = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing,
      getIssuingDisputesParametersQueryLimit :: Maybe Int
getIssuingDisputesParametersQueryLimit = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      getIssuingDisputesParametersQueryStartingAfter :: Maybe Text
getIssuingDisputesParametersQueryStartingAfter = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      getIssuingDisputesParametersQueryStatus :: Maybe GetIssuingDisputesParametersQueryStatus'
getIssuingDisputesParametersQueryStatus = Maybe GetIssuingDisputesParametersQueryStatus'
forall a. Maybe a
GHC.Maybe.Nothing,
      getIssuingDisputesParametersQueryTransaction :: Maybe Text
getIssuingDisputesParametersQueryTransaction = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

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

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

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

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

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

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

-- | Defines the enum schema located at @paths.\/v1\/issuing\/disputes.GET.parameters.properties.queryStatus@ in the specification.
--
-- Represents the parameter named \'status\'
--
-- Select Issuing disputes with the given status.
data GetIssuingDisputesParametersQueryStatus'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    GetIssuingDisputesParametersQueryStatus'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.
    GetIssuingDisputesParametersQueryStatus'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"expired"@
    GetIssuingDisputesParametersQueryStatus'EnumExpired
  | -- | Represents the JSON value @"lost"@
    GetIssuingDisputesParametersQueryStatus'EnumLost
  | -- | Represents the JSON value @"submitted"@
    GetIssuingDisputesParametersQueryStatus'EnumSubmitted
  | -- | Represents the JSON value @"unsubmitted"@
    GetIssuingDisputesParametersQueryStatus'EnumUnsubmitted
  | -- | Represents the JSON value @"won"@
    GetIssuingDisputesParametersQueryStatus'EnumWon
  deriving (Int -> GetIssuingDisputesParametersQueryStatus' -> ShowS
[GetIssuingDisputesParametersQueryStatus'] -> ShowS
GetIssuingDisputesParametersQueryStatus' -> String
(Int -> GetIssuingDisputesParametersQueryStatus' -> ShowS)
-> (GetIssuingDisputesParametersQueryStatus' -> String)
-> ([GetIssuingDisputesParametersQueryStatus'] -> ShowS)
-> Show GetIssuingDisputesParametersQueryStatus'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetIssuingDisputesParametersQueryStatus'] -> ShowS
$cshowList :: [GetIssuingDisputesParametersQueryStatus'] -> ShowS
show :: GetIssuingDisputesParametersQueryStatus' -> String
$cshow :: GetIssuingDisputesParametersQueryStatus' -> String
showsPrec :: Int -> GetIssuingDisputesParametersQueryStatus' -> ShowS
$cshowsPrec :: Int -> GetIssuingDisputesParametersQueryStatus' -> ShowS
GHC.Show.Show, GetIssuingDisputesParametersQueryStatus'
-> GetIssuingDisputesParametersQueryStatus' -> Bool
(GetIssuingDisputesParametersQueryStatus'
 -> GetIssuingDisputesParametersQueryStatus' -> Bool)
-> (GetIssuingDisputesParametersQueryStatus'
    -> GetIssuingDisputesParametersQueryStatus' -> Bool)
-> Eq GetIssuingDisputesParametersQueryStatus'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetIssuingDisputesParametersQueryStatus'
-> GetIssuingDisputesParametersQueryStatus' -> Bool
$c/= :: GetIssuingDisputesParametersQueryStatus'
-> GetIssuingDisputesParametersQueryStatus' -> Bool
== :: GetIssuingDisputesParametersQueryStatus'
-> GetIssuingDisputesParametersQueryStatus' -> Bool
$c== :: GetIssuingDisputesParametersQueryStatus'
-> GetIssuingDisputesParametersQueryStatus' -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON GetIssuingDisputesParametersQueryStatus' where
  toJSON :: GetIssuingDisputesParametersQueryStatus' -> Value
toJSON (GetIssuingDisputesParametersQueryStatus'Other Value
val) = Value
val
  toJSON (GetIssuingDisputesParametersQueryStatus'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (GetIssuingDisputesParametersQueryStatus'
GetIssuingDisputesParametersQueryStatus'EnumExpired) = Value
"expired"
  toJSON (GetIssuingDisputesParametersQueryStatus'
GetIssuingDisputesParametersQueryStatus'EnumLost) = Value
"lost"
  toJSON (GetIssuingDisputesParametersQueryStatus'
GetIssuingDisputesParametersQueryStatus'EnumSubmitted) = Value
"submitted"
  toJSON (GetIssuingDisputesParametersQueryStatus'
GetIssuingDisputesParametersQueryStatus'EnumUnsubmitted) = Value
"unsubmitted"
  toJSON (GetIssuingDisputesParametersQueryStatus'
GetIssuingDisputesParametersQueryStatus'EnumWon) = Value
"won"

instance Data.Aeson.Types.FromJSON.FromJSON GetIssuingDisputesParametersQueryStatus' where
  parseJSON :: Value -> Parser GetIssuingDisputesParametersQueryStatus'
parseJSON Value
val =
    GetIssuingDisputesParametersQueryStatus'
-> Parser GetIssuingDisputesParametersQueryStatus'
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
"expired" -> GetIssuingDisputesParametersQueryStatus'
GetIssuingDisputesParametersQueryStatus'EnumExpired
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"lost" -> GetIssuingDisputesParametersQueryStatus'
GetIssuingDisputesParametersQueryStatus'EnumLost
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"submitted" -> GetIssuingDisputesParametersQueryStatus'
GetIssuingDisputesParametersQueryStatus'EnumSubmitted
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"unsubmitted" -> GetIssuingDisputesParametersQueryStatus'
GetIssuingDisputesParametersQueryStatus'EnumUnsubmitted
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"won" -> GetIssuingDisputesParametersQueryStatus'
GetIssuingDisputesParametersQueryStatus'EnumWon
            | Bool
GHC.Base.otherwise -> Value -> GetIssuingDisputesParametersQueryStatus'
GetIssuingDisputesParametersQueryStatus'Other Value
val
      )

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

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

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