{-# 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 getCreditNotesPreviewLines
module StripeAPI.Operations.GetCreditNotesPreviewLines 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/credit_notes/preview/lines
--
-- \<p>When retrieving a credit note preview, you’ll get a \<strong>lines\<\/strong> property containing the first handful of those items. This URL you can retrieve the full (paginated) list of line items.\<\/p>
getCreditNotesPreviewLines ::
  forall m.
  StripeAPI.Common.MonadHTTP m =>
  -- | Contains all available parameters of this operation (query and path parameters)
  GetCreditNotesPreviewLinesParameters ->
  -- | Monadic computation which returns the result of the operation
  StripeAPI.Common.StripeT m (Network.HTTP.Client.Types.Response GetCreditNotesPreviewLinesResponse)
getCreditNotesPreviewLines :: GetCreditNotesPreviewLinesParameters
-> StripeT m (Response GetCreditNotesPreviewLinesResponse)
getCreditNotesPreviewLines GetCreditNotesPreviewLinesParameters
parameters =
  (Response ByteString
 -> Response GetCreditNotesPreviewLinesResponse)
-> StripeT m (Response ByteString)
-> StripeT m (Response GetCreditNotesPreviewLinesResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
    ( \Response ByteString
response_0 ->
        (ByteString -> GetCreditNotesPreviewLinesResponse)
-> Response ByteString
-> Response GetCreditNotesPreviewLinesResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
GHC.Base.fmap
          ( (String -> GetCreditNotesPreviewLinesResponse)
-> (GetCreditNotesPreviewLinesResponse
    -> GetCreditNotesPreviewLinesResponse)
-> Either String GetCreditNotesPreviewLinesResponse
-> GetCreditNotesPreviewLinesResponse
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Data.Either.either String -> GetCreditNotesPreviewLinesResponse
GetCreditNotesPreviewLinesResponseError GetCreditNotesPreviewLinesResponse
-> GetCreditNotesPreviewLinesResponse
forall a. a -> a
GHC.Base.id
              (Either String GetCreditNotesPreviewLinesResponse
 -> GetCreditNotesPreviewLinesResponse)
-> (ByteString -> Either String GetCreditNotesPreviewLinesResponse)
-> ByteString
-> GetCreditNotesPreviewLinesResponse
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) ->
                                   GetCreditNotesPreviewLinesResponseBody200
-> GetCreditNotesPreviewLinesResponse
GetCreditNotesPreviewLinesResponse200
                                     (GetCreditNotesPreviewLinesResponseBody200
 -> GetCreditNotesPreviewLinesResponse)
-> Either String GetCreditNotesPreviewLinesResponseBody200
-> Either String GetCreditNotesPreviewLinesResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> ( ByteString
-> Either String GetCreditNotesPreviewLinesResponseBody200
forall a. FromJSON a => ByteString -> Either String a
Data.Aeson.eitherDecodeStrict ByteString
body ::
                                                          Data.Either.Either
                                                            GHC.Base.String
                                                            GetCreditNotesPreviewLinesResponseBody200
                                                      )
                                 | 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 -> GetCreditNotesPreviewLinesResponse
GetCreditNotesPreviewLinesResponseDefault
                                     (Error -> GetCreditNotesPreviewLinesResponse)
-> Either String Error
-> Either String GetCreditNotesPreviewLinesResponse
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 GetCreditNotesPreviewLinesResponse
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/credit_notes/preview/lines")
        [ Text -> Maybe Value -> Text -> Bool -> QueryParameter
StripeAPI.Common.QueryParameter (String -> Text
Data.Text.pack String
"amount") (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.<$> GetCreditNotesPreviewLinesParameters -> Maybe Int
getCreditNotesPreviewLinesParametersQueryAmount GetCreditNotesPreviewLinesParameters
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
"credit_amount") (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.<$> GetCreditNotesPreviewLinesParameters -> Maybe Int
getCreditNotesPreviewLinesParametersQueryCreditAmount GetCreditNotesPreviewLinesParameters
parameters) (String -> Text
Data.Text.pack String
"form") Bool
GHC.Types.True,
          Text -> Maybe Value -> Text -> Bool -> QueryParameter
StripeAPI.Common.QueryParameter (String -> Text
Data.Text.pack String
"ending_before") (Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> GetCreditNotesPreviewLinesParameters -> Maybe Text
getCreditNotesPreviewLinesParametersQueryEndingBefore GetCreditNotesPreviewLinesParameters
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.<$> GetCreditNotesPreviewLinesParameters -> Maybe [Text]
getCreditNotesPreviewLinesParametersQueryExpand GetCreditNotesPreviewLinesParameters
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
"invoice") (Value -> Maybe Value
forall a. a -> Maybe a
GHC.Maybe.Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
GHC.Base.$ Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (GetCreditNotesPreviewLinesParameters -> Text
getCreditNotesPreviewLinesParametersQueryInvoice GetCreditNotesPreviewLinesParameters
parameters)) (String -> Text
Data.Text.pack String
"form") Bool
GHC.Types.True,
          Text -> Maybe Value -> Text -> Bool -> QueryParameter
StripeAPI.Common.QueryParameter (String -> Text
Data.Text.pack String
"limit") (Int -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (Int -> Value) -> Maybe Int -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> GetCreditNotesPreviewLinesParameters -> Maybe Int
getCreditNotesPreviewLinesParametersQueryLimit GetCreditNotesPreviewLinesParameters
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
"lines") ([GetCreditNotesPreviewLinesParametersQueryLines'] -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON ([GetCreditNotesPreviewLinesParametersQueryLines'] -> Value)
-> Maybe [GetCreditNotesPreviewLinesParametersQueryLines']
-> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> GetCreditNotesPreviewLinesParameters
-> Maybe [GetCreditNotesPreviewLinesParametersQueryLines']
getCreditNotesPreviewLinesParametersQueryLines GetCreditNotesPreviewLinesParameters
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
"memo") (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.<$> GetCreditNotesPreviewLinesParameters -> Maybe Text
getCreditNotesPreviewLinesParametersQueryMemo GetCreditNotesPreviewLinesParameters
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
"metadata") (Object -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (Object -> Value) -> Maybe Object -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> GetCreditNotesPreviewLinesParameters -> Maybe Object
getCreditNotesPreviewLinesParametersQueryMetadata GetCreditNotesPreviewLinesParameters
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
"out_of_band_amount") (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.<$> GetCreditNotesPreviewLinesParameters -> Maybe Int
getCreditNotesPreviewLinesParametersQueryOutOfBandAmount GetCreditNotesPreviewLinesParameters
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
"reason") (GetCreditNotesPreviewLinesParametersQueryReason' -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON (GetCreditNotesPreviewLinesParametersQueryReason' -> Value)
-> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
-> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Data.Functor.<$> GetCreditNotesPreviewLinesParameters
-> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
getCreditNotesPreviewLinesParametersQueryReason GetCreditNotesPreviewLinesParameters
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
"refund") (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.<$> GetCreditNotesPreviewLinesParameters -> Maybe Text
getCreditNotesPreviewLinesParametersQueryRefund GetCreditNotesPreviewLinesParameters
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
"refund_amount") (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.<$> GetCreditNotesPreviewLinesParameters -> Maybe Int
getCreditNotesPreviewLinesParametersQueryRefundAmount GetCreditNotesPreviewLinesParameters
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.<$> GetCreditNotesPreviewLinesParameters -> Maybe Text
getCreditNotesPreviewLinesParametersQueryStartingAfter GetCreditNotesPreviewLinesParameters
parameters) (String -> Text
Data.Text.pack String
"form") Bool
GHC.Types.True
        ]
    )

-- | Defines the object schema located at @paths.\/v1\/credit_notes\/preview\/lines.GET.parameters@ in the specification.
data GetCreditNotesPreviewLinesParameters = GetCreditNotesPreviewLinesParameters
  { -- | queryAmount: Represents the parameter named \'amount\'
    --
    -- The integer amount in %s representing the total amount of the credit note.
    GetCreditNotesPreviewLinesParameters -> Maybe Int
getCreditNotesPreviewLinesParametersQueryAmount :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | queryCredit_amount: Represents the parameter named \'credit_amount\'
    --
    -- The integer amount in %s representing the amount to credit the customer\'s balance, which will be automatically applied to their next invoice.
    GetCreditNotesPreviewLinesParameters -> Maybe Int
getCreditNotesPreviewLinesParametersQueryCreditAmount :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | 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
    GetCreditNotesPreviewLinesParameters -> Maybe Text
getCreditNotesPreviewLinesParametersQueryEndingBefore :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | queryExpand: Represents the parameter named \'expand\'
    --
    -- Specifies which fields in the response should be expanded.
    GetCreditNotesPreviewLinesParameters -> Maybe [Text]
getCreditNotesPreviewLinesParametersQueryExpand :: (GHC.Maybe.Maybe ([Data.Text.Internal.Text])),
    -- | queryInvoice: Represents the parameter named \'invoice\'
    --
    -- ID of the invoice.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    GetCreditNotesPreviewLinesParameters -> Text
getCreditNotesPreviewLinesParametersQueryInvoice :: 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.
    GetCreditNotesPreviewLinesParameters -> Maybe Int
getCreditNotesPreviewLinesParametersQueryLimit :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | queryLines: Represents the parameter named \'lines\'
    --
    -- Line items that make up the credit note.
    GetCreditNotesPreviewLinesParameters
-> Maybe [GetCreditNotesPreviewLinesParametersQueryLines']
getCreditNotesPreviewLinesParametersQueryLines :: (GHC.Maybe.Maybe ([GetCreditNotesPreviewLinesParametersQueryLines'])),
    -- | queryMemo: Represents the parameter named \'memo\'
    --
    -- The credit note\'s memo appears on the credit note PDF.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    GetCreditNotesPreviewLinesParameters -> Maybe Text
getCreditNotesPreviewLinesParametersQueryMemo :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | queryMetadata: Represents the parameter named \'metadata\'
    --
    -- Set of [key-value pairs](https:\/\/stripe.com\/docs\/api\/metadata) that you can attach to an object. This can be useful for storing additional information about the object in a structured format. Individual keys can be unset by posting an empty value to them. All keys can be unset by posting an empty value to \`metadata\`.
    GetCreditNotesPreviewLinesParameters -> Maybe Object
getCreditNotesPreviewLinesParametersQueryMetadata :: (GHC.Maybe.Maybe Data.Aeson.Types.Internal.Object),
    -- | queryOut_of_band_amount: Represents the parameter named \'out_of_band_amount\'
    --
    -- The integer amount in %s representing the amount that is credited outside of Stripe.
    GetCreditNotesPreviewLinesParameters -> Maybe Int
getCreditNotesPreviewLinesParametersQueryOutOfBandAmount :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | queryReason: Represents the parameter named \'reason\'
    --
    -- Reason for issuing this credit note, one of \`duplicate\`, \`fraudulent\`, \`order_change\`, or \`product_unsatisfactory\`
    GetCreditNotesPreviewLinesParameters
-> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
getCreditNotesPreviewLinesParametersQueryReason :: (GHC.Maybe.Maybe GetCreditNotesPreviewLinesParametersQueryReason'),
    -- | queryRefund: Represents the parameter named \'refund\'
    --
    -- ID of an existing refund to link this credit note to.
    GetCreditNotesPreviewLinesParameters -> Maybe Text
getCreditNotesPreviewLinesParametersQueryRefund :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | queryRefund_amount: Represents the parameter named \'refund_amount\'
    --
    -- The integer amount in %s representing the amount to refund. If set, a refund will be created for the charge associated with the invoice.
    GetCreditNotesPreviewLinesParameters -> Maybe Int
getCreditNotesPreviewLinesParametersQueryRefundAmount :: (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
    GetCreditNotesPreviewLinesParameters -> Maybe Text
getCreditNotesPreviewLinesParametersQueryStartingAfter :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int -> GetCreditNotesPreviewLinesParameters -> ShowS
[GetCreditNotesPreviewLinesParameters] -> ShowS
GetCreditNotesPreviewLinesParameters -> String
(Int -> GetCreditNotesPreviewLinesParameters -> ShowS)
-> (GetCreditNotesPreviewLinesParameters -> String)
-> ([GetCreditNotesPreviewLinesParameters] -> ShowS)
-> Show GetCreditNotesPreviewLinesParameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCreditNotesPreviewLinesParameters] -> ShowS
$cshowList :: [GetCreditNotesPreviewLinesParameters] -> ShowS
show :: GetCreditNotesPreviewLinesParameters -> String
$cshow :: GetCreditNotesPreviewLinesParameters -> String
showsPrec :: Int -> GetCreditNotesPreviewLinesParameters -> ShowS
$cshowsPrec :: Int -> GetCreditNotesPreviewLinesParameters -> ShowS
GHC.Show.Show,
      GetCreditNotesPreviewLinesParameters
-> GetCreditNotesPreviewLinesParameters -> Bool
(GetCreditNotesPreviewLinesParameters
 -> GetCreditNotesPreviewLinesParameters -> Bool)
-> (GetCreditNotesPreviewLinesParameters
    -> GetCreditNotesPreviewLinesParameters -> Bool)
-> Eq GetCreditNotesPreviewLinesParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCreditNotesPreviewLinesParameters
-> GetCreditNotesPreviewLinesParameters -> Bool
$c/= :: GetCreditNotesPreviewLinesParameters
-> GetCreditNotesPreviewLinesParameters -> Bool
== :: GetCreditNotesPreviewLinesParameters
-> GetCreditNotesPreviewLinesParameters -> Bool
$c== :: GetCreditNotesPreviewLinesParameters
-> GetCreditNotesPreviewLinesParameters -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON GetCreditNotesPreviewLinesParameters where
  toJSON :: GetCreditNotesPreviewLinesParameters -> Value
toJSON GetCreditNotesPreviewLinesParameters
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"queryAmount" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParameters -> Maybe Int
getCreditNotesPreviewLinesParametersQueryAmount GetCreditNotesPreviewLinesParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryCredit_amount" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParameters -> Maybe Int
getCreditNotesPreviewLinesParametersQueryCreditAmount GetCreditNotesPreviewLinesParameters
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..= GetCreditNotesPreviewLinesParameters -> Maybe Text
getCreditNotesPreviewLinesParametersQueryEndingBefore GetCreditNotesPreviewLinesParameters
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..= GetCreditNotesPreviewLinesParameters -> Maybe [Text]
getCreditNotesPreviewLinesParametersQueryExpand GetCreditNotesPreviewLinesParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryInvoice" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParameters -> Text
getCreditNotesPreviewLinesParametersQueryInvoice GetCreditNotesPreviewLinesParameters
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..= GetCreditNotesPreviewLinesParameters -> Maybe Int
getCreditNotesPreviewLinesParametersQueryLimit GetCreditNotesPreviewLinesParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryLines" Text
-> Maybe [GetCreditNotesPreviewLinesParametersQueryLines'] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParameters
-> Maybe [GetCreditNotesPreviewLinesParametersQueryLines']
getCreditNotesPreviewLinesParametersQueryLines GetCreditNotesPreviewLinesParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryMemo" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParameters -> Maybe Text
getCreditNotesPreviewLinesParametersQueryMemo GetCreditNotesPreviewLinesParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryMetadata" Text -> Maybe Object -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParameters -> Maybe Object
getCreditNotesPreviewLinesParametersQueryMetadata GetCreditNotesPreviewLinesParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryOut_of_band_amount" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParameters -> Maybe Int
getCreditNotesPreviewLinesParametersQueryOutOfBandAmount GetCreditNotesPreviewLinesParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryReason" Text
-> Maybe GetCreditNotesPreviewLinesParametersQueryReason' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParameters
-> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
getCreditNotesPreviewLinesParametersQueryReason GetCreditNotesPreviewLinesParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryRefund" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParameters -> Maybe Text
getCreditNotesPreviewLinesParametersQueryRefund GetCreditNotesPreviewLinesParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"queryRefund_amount" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParameters -> Maybe Int
getCreditNotesPreviewLinesParametersQueryRefundAmount GetCreditNotesPreviewLinesParameters
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..= GetCreditNotesPreviewLinesParameters -> Maybe Text
getCreditNotesPreviewLinesParametersQueryStartingAfter GetCreditNotesPreviewLinesParameters
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: GetCreditNotesPreviewLinesParameters -> Encoding
toEncoding GetCreditNotesPreviewLinesParameters
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"queryAmount" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParameters -> Maybe Int
getCreditNotesPreviewLinesParametersQueryAmount GetCreditNotesPreviewLinesParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"queryCredit_amount" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParameters -> Maybe Int
getCreditNotesPreviewLinesParametersQueryCreditAmount GetCreditNotesPreviewLinesParameters
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..= GetCreditNotesPreviewLinesParameters -> Maybe Text
getCreditNotesPreviewLinesParametersQueryEndingBefore GetCreditNotesPreviewLinesParameters
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..= GetCreditNotesPreviewLinesParameters -> Maybe [Text]
getCreditNotesPreviewLinesParametersQueryExpand GetCreditNotesPreviewLinesParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"queryInvoice" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParameters -> Text
getCreditNotesPreviewLinesParametersQueryInvoice GetCreditNotesPreviewLinesParameters
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..= GetCreditNotesPreviewLinesParameters -> Maybe Int
getCreditNotesPreviewLinesParametersQueryLimit GetCreditNotesPreviewLinesParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"queryLines" Text
-> Maybe [GetCreditNotesPreviewLinesParametersQueryLines']
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParameters
-> Maybe [GetCreditNotesPreviewLinesParametersQueryLines']
getCreditNotesPreviewLinesParametersQueryLines GetCreditNotesPreviewLinesParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"queryMemo" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParameters -> Maybe Text
getCreditNotesPreviewLinesParametersQueryMemo GetCreditNotesPreviewLinesParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"queryMetadata" Text -> Maybe Object -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParameters -> Maybe Object
getCreditNotesPreviewLinesParametersQueryMetadata GetCreditNotesPreviewLinesParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"queryOut_of_band_amount" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParameters -> Maybe Int
getCreditNotesPreviewLinesParametersQueryOutOfBandAmount GetCreditNotesPreviewLinesParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"queryReason" Text
-> Maybe GetCreditNotesPreviewLinesParametersQueryReason' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParameters
-> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
getCreditNotesPreviewLinesParametersQueryReason GetCreditNotesPreviewLinesParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"queryRefund" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParameters -> Maybe Text
getCreditNotesPreviewLinesParametersQueryRefund GetCreditNotesPreviewLinesParameters
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"queryRefund_amount" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParameters -> Maybe Int
getCreditNotesPreviewLinesParametersQueryRefundAmount GetCreditNotesPreviewLinesParameters
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..= GetCreditNotesPreviewLinesParameters -> Maybe Text
getCreditNotesPreviewLinesParametersQueryStartingAfter GetCreditNotesPreviewLinesParameters
obj))))))))))))))

instance Data.Aeson.Types.FromJSON.FromJSON GetCreditNotesPreviewLinesParameters where
  parseJSON :: Value -> Parser GetCreditNotesPreviewLinesParameters
parseJSON = String
-> (Object -> Parser GetCreditNotesPreviewLinesParameters)
-> Value
-> Parser GetCreditNotesPreviewLinesParameters
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"GetCreditNotesPreviewLinesParameters" (\Object
obj -> ((((((((((((((Maybe Int
 -> Maybe Int
 -> Maybe Text
 -> Maybe [Text]
 -> Text
 -> Maybe Int
 -> Maybe [GetCreditNotesPreviewLinesParametersQueryLines']
 -> Maybe Text
 -> Maybe Object
 -> Maybe Int
 -> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
 -> Maybe Text
 -> Maybe Int
 -> Maybe Text
 -> GetCreditNotesPreviewLinesParameters)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe [Text]
      -> Text
      -> Maybe Int
      -> Maybe [GetCreditNotesPreviewLinesParametersQueryLines']
      -> Maybe Text
      -> Maybe Object
      -> Maybe Int
      -> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> GetCreditNotesPreviewLinesParameters)
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Int
-> Maybe Int
-> Maybe Text
-> Maybe [Text]
-> Text
-> Maybe Int
-> Maybe [GetCreditNotesPreviewLinesParametersQueryLines']
-> Maybe Text
-> Maybe Object
-> Maybe Int
-> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> GetCreditNotesPreviewLinesParameters
GetCreditNotesPreviewLinesParameters Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe [Text]
   -> Text
   -> Maybe Int
   -> Maybe [GetCreditNotesPreviewLinesParametersQueryLines']
   -> Maybe Text
   -> Maybe Object
   -> Maybe Int
   -> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> GetCreditNotesPreviewLinesParameters)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Maybe [Text]
      -> Text
      -> Maybe Int
      -> Maybe [GetCreditNotesPreviewLinesParametersQueryLines']
      -> Maybe Text
      -> Maybe Object
      -> Maybe Int
      -> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> GetCreditNotesPreviewLinesParameters)
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
"queryAmount")) Parser
  (Maybe Int
   -> Maybe Text
   -> Maybe [Text]
   -> Text
   -> Maybe Int
   -> Maybe [GetCreditNotesPreviewLinesParametersQueryLines']
   -> Maybe Text
   -> Maybe Object
   -> Maybe Int
   -> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> GetCreditNotesPreviewLinesParameters)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Text
      -> Maybe Int
      -> Maybe [GetCreditNotesPreviewLinesParametersQueryLines']
      -> Maybe Text
      -> Maybe Object
      -> Maybe Int
      -> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> GetCreditNotesPreviewLinesParameters)
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
"queryCredit_amount")) Parser
  (Maybe Text
   -> Maybe [Text]
   -> Text
   -> Maybe Int
   -> Maybe [GetCreditNotesPreviewLinesParametersQueryLines']
   -> Maybe Text
   -> Maybe Object
   -> Maybe Int
   -> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> GetCreditNotesPreviewLinesParameters)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text]
      -> Text
      -> Maybe Int
      -> Maybe [GetCreditNotesPreviewLinesParametersQueryLines']
      -> Maybe Text
      -> Maybe Object
      -> Maybe Int
      -> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> GetCreditNotesPreviewLinesParameters)
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]
   -> Text
   -> Maybe Int
   -> Maybe [GetCreditNotesPreviewLinesParametersQueryLines']
   -> Maybe Text
   -> Maybe Object
   -> Maybe Int
   -> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> GetCreditNotesPreviewLinesParameters)
-> Parser (Maybe [Text])
-> Parser
     (Text
      -> Maybe Int
      -> Maybe [GetCreditNotesPreviewLinesParametersQueryLines']
      -> Maybe Text
      -> Maybe Object
      -> Maybe Int
      -> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> GetCreditNotesPreviewLinesParameters)
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
  (Text
   -> Maybe Int
   -> Maybe [GetCreditNotesPreviewLinesParametersQueryLines']
   -> Maybe Text
   -> Maybe Object
   -> Maybe Int
   -> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> GetCreditNotesPreviewLinesParameters)
-> Parser Text
-> Parser
     (Maybe Int
      -> Maybe [GetCreditNotesPreviewLinesParametersQueryLines']
      -> Maybe Text
      -> Maybe Object
      -> Maybe Int
      -> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> GetCreditNotesPreviewLinesParameters)
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
"queryInvoice")) Parser
  (Maybe Int
   -> Maybe [GetCreditNotesPreviewLinesParametersQueryLines']
   -> Maybe Text
   -> Maybe Object
   -> Maybe Int
   -> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> GetCreditNotesPreviewLinesParameters)
-> Parser (Maybe Int)
-> Parser
     (Maybe [GetCreditNotesPreviewLinesParametersQueryLines']
      -> Maybe Text
      -> Maybe Object
      -> Maybe Int
      -> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> GetCreditNotesPreviewLinesParameters)
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 [GetCreditNotesPreviewLinesParametersQueryLines']
   -> Maybe Text
   -> Maybe Object
   -> Maybe Int
   -> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> GetCreditNotesPreviewLinesParameters)
-> Parser (Maybe [GetCreditNotesPreviewLinesParametersQueryLines'])
-> Parser
     (Maybe Text
      -> Maybe Object
      -> Maybe Int
      -> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> GetCreditNotesPreviewLinesParameters)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe [GetCreditNotesPreviewLinesParametersQueryLines'])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"queryLines")) Parser
  (Maybe Text
   -> Maybe Object
   -> Maybe Int
   -> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> GetCreditNotesPreviewLinesParameters)
-> Parser (Maybe Text)
-> Parser
     (Maybe Object
      -> Maybe Int
      -> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> GetCreditNotesPreviewLinesParameters)
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
"queryMemo")) Parser
  (Maybe Object
   -> Maybe Int
   -> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> GetCreditNotesPreviewLinesParameters)
-> Parser (Maybe Object)
-> Parser
     (Maybe Int
      -> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> GetCreditNotesPreviewLinesParameters)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"queryMetadata")) Parser
  (Maybe Int
   -> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> GetCreditNotesPreviewLinesParameters)
-> Parser (Maybe Int)
-> Parser
     (Maybe GetCreditNotesPreviewLinesParametersQueryReason'
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> GetCreditNotesPreviewLinesParameters)
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
"queryOut_of_band_amount")) Parser
  (Maybe GetCreditNotesPreviewLinesParametersQueryReason'
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> GetCreditNotesPreviewLinesParameters)
-> Parser (Maybe GetCreditNotesPreviewLinesParametersQueryReason')
-> Parser
     (Maybe Text
      -> Maybe Int -> Maybe Text -> GetCreditNotesPreviewLinesParameters)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser (Maybe GetCreditNotesPreviewLinesParametersQueryReason')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"queryReason")) Parser
  (Maybe Text
   -> Maybe Int -> Maybe Text -> GetCreditNotesPreviewLinesParameters)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int -> Maybe Text -> GetCreditNotesPreviewLinesParameters)
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
"queryRefund")) Parser
  (Maybe Int -> Maybe Text -> GetCreditNotesPreviewLinesParameters)
-> Parser (Maybe Int)
-> Parser (Maybe Text -> GetCreditNotesPreviewLinesParameters)
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
"queryRefund_amount")) Parser (Maybe Text -> GetCreditNotesPreviewLinesParameters)
-> Parser (Maybe Text)
-> Parser GetCreditNotesPreviewLinesParameters
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"))

-- | Create a new 'GetCreditNotesPreviewLinesParameters' with all required fields.
mkGetCreditNotesPreviewLinesParameters ::
  -- | 'getCreditNotesPreviewLinesParametersQueryInvoice'
  Data.Text.Internal.Text ->
  GetCreditNotesPreviewLinesParameters
mkGetCreditNotesPreviewLinesParameters :: Text -> GetCreditNotesPreviewLinesParameters
mkGetCreditNotesPreviewLinesParameters Text
getCreditNotesPreviewLinesParametersQueryInvoice =
  GetCreditNotesPreviewLinesParameters :: Maybe Int
-> Maybe Int
-> Maybe Text
-> Maybe [Text]
-> Text
-> Maybe Int
-> Maybe [GetCreditNotesPreviewLinesParametersQueryLines']
-> Maybe Text
-> Maybe Object
-> Maybe Int
-> Maybe GetCreditNotesPreviewLinesParametersQueryReason'
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> GetCreditNotesPreviewLinesParameters
GetCreditNotesPreviewLinesParameters
    { getCreditNotesPreviewLinesParametersQueryAmount :: Maybe Int
getCreditNotesPreviewLinesParametersQueryAmount = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      getCreditNotesPreviewLinesParametersQueryCreditAmount :: Maybe Int
getCreditNotesPreviewLinesParametersQueryCreditAmount = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      getCreditNotesPreviewLinesParametersQueryEndingBefore :: Maybe Text
getCreditNotesPreviewLinesParametersQueryEndingBefore = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      getCreditNotesPreviewLinesParametersQueryExpand :: Maybe [Text]
getCreditNotesPreviewLinesParametersQueryExpand = Maybe [Text]
forall a. Maybe a
GHC.Maybe.Nothing,
      getCreditNotesPreviewLinesParametersQueryInvoice :: Text
getCreditNotesPreviewLinesParametersQueryInvoice = Text
getCreditNotesPreviewLinesParametersQueryInvoice,
      getCreditNotesPreviewLinesParametersQueryLimit :: Maybe Int
getCreditNotesPreviewLinesParametersQueryLimit = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      getCreditNotesPreviewLinesParametersQueryLines :: Maybe [GetCreditNotesPreviewLinesParametersQueryLines']
getCreditNotesPreviewLinesParametersQueryLines = Maybe [GetCreditNotesPreviewLinesParametersQueryLines']
forall a. Maybe a
GHC.Maybe.Nothing,
      getCreditNotesPreviewLinesParametersQueryMemo :: Maybe Text
getCreditNotesPreviewLinesParametersQueryMemo = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      getCreditNotesPreviewLinesParametersQueryMetadata :: Maybe Object
getCreditNotesPreviewLinesParametersQueryMetadata = Maybe Object
forall a. Maybe a
GHC.Maybe.Nothing,
      getCreditNotesPreviewLinesParametersQueryOutOfBandAmount :: Maybe Int
getCreditNotesPreviewLinesParametersQueryOutOfBandAmount = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      getCreditNotesPreviewLinesParametersQueryReason :: Maybe GetCreditNotesPreviewLinesParametersQueryReason'
getCreditNotesPreviewLinesParametersQueryReason = Maybe GetCreditNotesPreviewLinesParametersQueryReason'
forall a. Maybe a
GHC.Maybe.Nothing,
      getCreditNotesPreviewLinesParametersQueryRefund :: Maybe Text
getCreditNotesPreviewLinesParametersQueryRefund = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      getCreditNotesPreviewLinesParametersQueryRefundAmount :: Maybe Int
getCreditNotesPreviewLinesParametersQueryRefundAmount = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      getCreditNotesPreviewLinesParametersQueryStartingAfter :: Maybe Text
getCreditNotesPreviewLinesParametersQueryStartingAfter = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the object schema located at @paths.\/v1\/credit_notes\/preview\/lines.GET.parameters.properties.queryLines.items@ in the specification.
data GetCreditNotesPreviewLinesParametersQueryLines' = GetCreditNotesPreviewLinesParametersQueryLines'
  { -- | amount
    GetCreditNotesPreviewLinesParametersQueryLines' -> Maybe Int
getCreditNotesPreviewLinesParametersQueryLines'Amount :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | description
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    GetCreditNotesPreviewLinesParametersQueryLines' -> Maybe Text
getCreditNotesPreviewLinesParametersQueryLines'Description :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | invoice_line_item
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    GetCreditNotesPreviewLinesParametersQueryLines' -> Maybe Text
getCreditNotesPreviewLinesParametersQueryLines'InvoiceLineItem :: (GHC.Maybe.Maybe Data.Text.Internal.Text),
    -- | quantity
    GetCreditNotesPreviewLinesParametersQueryLines' -> Maybe Int
getCreditNotesPreviewLinesParametersQueryLines'Quantity :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | tax_rates
    GetCreditNotesPreviewLinesParametersQueryLines'
-> Maybe
     GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
getCreditNotesPreviewLinesParametersQueryLines'TaxRates :: (GHC.Maybe.Maybe GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants),
    -- | type
    GetCreditNotesPreviewLinesParametersQueryLines'
-> GetCreditNotesPreviewLinesParametersQueryLines'Type'
getCreditNotesPreviewLinesParametersQueryLines'Type :: GetCreditNotesPreviewLinesParametersQueryLines'Type',
    -- | unit_amount
    GetCreditNotesPreviewLinesParametersQueryLines' -> Maybe Int
getCreditNotesPreviewLinesParametersQueryLines'UnitAmount :: (GHC.Maybe.Maybe GHC.Types.Int),
    -- | unit_amount_decimal
    GetCreditNotesPreviewLinesParametersQueryLines' -> Maybe Text
getCreditNotesPreviewLinesParametersQueryLines'UnitAmountDecimal :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
  }
  deriving
    ( Int -> GetCreditNotesPreviewLinesParametersQueryLines' -> ShowS
[GetCreditNotesPreviewLinesParametersQueryLines'] -> ShowS
GetCreditNotesPreviewLinesParametersQueryLines' -> String
(Int -> GetCreditNotesPreviewLinesParametersQueryLines' -> ShowS)
-> (GetCreditNotesPreviewLinesParametersQueryLines' -> String)
-> ([GetCreditNotesPreviewLinesParametersQueryLines'] -> ShowS)
-> Show GetCreditNotesPreviewLinesParametersQueryLines'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCreditNotesPreviewLinesParametersQueryLines'] -> ShowS
$cshowList :: [GetCreditNotesPreviewLinesParametersQueryLines'] -> ShowS
show :: GetCreditNotesPreviewLinesParametersQueryLines' -> String
$cshow :: GetCreditNotesPreviewLinesParametersQueryLines' -> String
showsPrec :: Int -> GetCreditNotesPreviewLinesParametersQueryLines' -> ShowS
$cshowsPrec :: Int -> GetCreditNotesPreviewLinesParametersQueryLines' -> ShowS
GHC.Show.Show,
      GetCreditNotesPreviewLinesParametersQueryLines'
-> GetCreditNotesPreviewLinesParametersQueryLines' -> Bool
(GetCreditNotesPreviewLinesParametersQueryLines'
 -> GetCreditNotesPreviewLinesParametersQueryLines' -> Bool)
-> (GetCreditNotesPreviewLinesParametersQueryLines'
    -> GetCreditNotesPreviewLinesParametersQueryLines' -> Bool)
-> Eq GetCreditNotesPreviewLinesParametersQueryLines'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCreditNotesPreviewLinesParametersQueryLines'
-> GetCreditNotesPreviewLinesParametersQueryLines' -> Bool
$c/= :: GetCreditNotesPreviewLinesParametersQueryLines'
-> GetCreditNotesPreviewLinesParametersQueryLines' -> Bool
== :: GetCreditNotesPreviewLinesParametersQueryLines'
-> GetCreditNotesPreviewLinesParametersQueryLines' -> Bool
$c== :: GetCreditNotesPreviewLinesParametersQueryLines'
-> GetCreditNotesPreviewLinesParametersQueryLines' -> Bool
GHC.Classes.Eq
    )

instance Data.Aeson.Types.ToJSON.ToJSON GetCreditNotesPreviewLinesParametersQueryLines' where
  toJSON :: GetCreditNotesPreviewLinesParametersQueryLines' -> Value
toJSON GetCreditNotesPreviewLinesParametersQueryLines'
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object (Text
"amount" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParametersQueryLines' -> Maybe Int
getCreditNotesPreviewLinesParametersQueryLines'Amount GetCreditNotesPreviewLinesParametersQueryLines'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"description" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParametersQueryLines' -> Maybe Text
getCreditNotesPreviewLinesParametersQueryLines'Description GetCreditNotesPreviewLinesParametersQueryLines'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"invoice_line_item" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParametersQueryLines' -> Maybe Text
getCreditNotesPreviewLinesParametersQueryLines'InvoiceLineItem GetCreditNotesPreviewLinesParametersQueryLines'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"quantity" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParametersQueryLines' -> Maybe Int
getCreditNotesPreviewLinesParametersQueryLines'Quantity GetCreditNotesPreviewLinesParametersQueryLines'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"tax_rates" Text
-> Maybe
     GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParametersQueryLines'
-> Maybe
     GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
getCreditNotesPreviewLinesParametersQueryLines'TaxRates GetCreditNotesPreviewLinesParametersQueryLines'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"type" Text
-> GetCreditNotesPreviewLinesParametersQueryLines'Type' -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParametersQueryLines'
-> GetCreditNotesPreviewLinesParametersQueryLines'Type'
getCreditNotesPreviewLinesParametersQueryLines'Type GetCreditNotesPreviewLinesParametersQueryLines'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"unit_amount" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParametersQueryLines' -> Maybe Int
getCreditNotesPreviewLinesParametersQueryLines'UnitAmount GetCreditNotesPreviewLinesParametersQueryLines'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text
"unit_amount_decimal" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParametersQueryLines' -> Maybe Text
getCreditNotesPreviewLinesParametersQueryLines'UnitAmountDecimal GetCreditNotesPreviewLinesParametersQueryLines'
obj Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
forall a. Monoid a => a
GHC.Base.mempty)
  toEncoding :: GetCreditNotesPreviewLinesParametersQueryLines' -> Encoding
toEncoding GetCreditNotesPreviewLinesParametersQueryLines'
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ((Text
"amount" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParametersQueryLines' -> Maybe Int
getCreditNotesPreviewLinesParametersQueryLines'Amount GetCreditNotesPreviewLinesParametersQueryLines'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"description" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParametersQueryLines' -> Maybe Text
getCreditNotesPreviewLinesParametersQueryLines'Description GetCreditNotesPreviewLinesParametersQueryLines'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"invoice_line_item" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParametersQueryLines' -> Maybe Text
getCreditNotesPreviewLinesParametersQueryLines'InvoiceLineItem GetCreditNotesPreviewLinesParametersQueryLines'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"quantity" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParametersQueryLines' -> Maybe Int
getCreditNotesPreviewLinesParametersQueryLines'Quantity GetCreditNotesPreviewLinesParametersQueryLines'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"tax_rates" Text
-> Maybe
     GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
-> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParametersQueryLines'
-> Maybe
     GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
getCreditNotesPreviewLinesParametersQueryLines'TaxRates GetCreditNotesPreviewLinesParametersQueryLines'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"type" Text
-> GetCreditNotesPreviewLinesParametersQueryLines'Type' -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParametersQueryLines'
-> GetCreditNotesPreviewLinesParametersQueryLines'Type'
getCreditNotesPreviewLinesParametersQueryLines'Type GetCreditNotesPreviewLinesParametersQueryLines'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> ((Text
"unit_amount" Text -> Maybe Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParametersQueryLines' -> Maybe Int
getCreditNotesPreviewLinesParametersQueryLines'UnitAmount GetCreditNotesPreviewLinesParametersQueryLines'
obj) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
GHC.Base.<> (Text
"unit_amount_decimal" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
Data.Aeson.Types.ToJSON..= GetCreditNotesPreviewLinesParametersQueryLines' -> Maybe Text
getCreditNotesPreviewLinesParametersQueryLines'UnitAmountDecimal GetCreditNotesPreviewLinesParametersQueryLines'
obj))))))))

instance Data.Aeson.Types.FromJSON.FromJSON GetCreditNotesPreviewLinesParametersQueryLines' where
  parseJSON :: Value -> Parser GetCreditNotesPreviewLinesParametersQueryLines'
parseJSON = String
-> (Object
    -> Parser GetCreditNotesPreviewLinesParametersQueryLines')
-> Value
-> Parser GetCreditNotesPreviewLinesParametersQueryLines'
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"GetCreditNotesPreviewLinesParametersQueryLines'" (\Object
obj -> ((((((((Maybe Int
 -> Maybe Text
 -> Maybe Text
 -> Maybe Int
 -> Maybe
      GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
 -> GetCreditNotesPreviewLinesParametersQueryLines'Type'
 -> Maybe Int
 -> Maybe Text
 -> GetCreditNotesPreviewLinesParametersQueryLines')
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe
           GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
      -> GetCreditNotesPreviewLinesParametersQueryLines'Type'
      -> Maybe Int
      -> Maybe Text
      -> GetCreditNotesPreviewLinesParametersQueryLines')
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe
     GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
-> GetCreditNotesPreviewLinesParametersQueryLines'Type'
-> Maybe Int
-> Maybe Text
-> GetCreditNotesPreviewLinesParametersQueryLines'
GetCreditNotesPreviewLinesParametersQueryLines' Parser
  (Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe
        GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
   -> GetCreditNotesPreviewLinesParametersQueryLines'Type'
   -> Maybe Int
   -> Maybe Text
   -> GetCreditNotesPreviewLinesParametersQueryLines')
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Int
      -> Maybe
           GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
      -> GetCreditNotesPreviewLinesParametersQueryLines'Type'
      -> Maybe Int
      -> Maybe Text
      -> GetCreditNotesPreviewLinesParametersQueryLines')
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
"amount")) Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Int
   -> Maybe
        GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
   -> GetCreditNotesPreviewLinesParametersQueryLines'Type'
   -> Maybe Int
   -> Maybe Text
   -> GetCreditNotesPreviewLinesParametersQueryLines')
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe
           GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
      -> GetCreditNotesPreviewLinesParametersQueryLines'Type'
      -> Maybe Int
      -> Maybe Text
      -> GetCreditNotesPreviewLinesParametersQueryLines')
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
"description")) Parser
  (Maybe Text
   -> Maybe Int
   -> Maybe
        GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
   -> GetCreditNotesPreviewLinesParametersQueryLines'Type'
   -> Maybe Int
   -> Maybe Text
   -> GetCreditNotesPreviewLinesParametersQueryLines')
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe
           GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
      -> GetCreditNotesPreviewLinesParametersQueryLines'Type'
      -> Maybe Int
      -> Maybe Text
      -> GetCreditNotesPreviewLinesParametersQueryLines')
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
"invoice_line_item")) Parser
  (Maybe Int
   -> Maybe
        GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
   -> GetCreditNotesPreviewLinesParametersQueryLines'Type'
   -> Maybe Int
   -> Maybe Text
   -> GetCreditNotesPreviewLinesParametersQueryLines')
-> Parser (Maybe Int)
-> Parser
     (Maybe
        GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
      -> GetCreditNotesPreviewLinesParametersQueryLines'Type'
      -> Maybe Int
      -> Maybe Text
      -> GetCreditNotesPreviewLinesParametersQueryLines')
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
"quantity")) Parser
  (Maybe
     GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
   -> GetCreditNotesPreviewLinesParametersQueryLines'Type'
   -> Maybe Int
   -> Maybe Text
   -> GetCreditNotesPreviewLinesParametersQueryLines')
-> Parser
     (Maybe
        GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants)
-> Parser
     (GetCreditNotesPreviewLinesParametersQueryLines'Type'
      -> Maybe Int
      -> Maybe Text
      -> GetCreditNotesPreviewLinesParametersQueryLines')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser
     (Maybe
        GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"tax_rates")) Parser
  (GetCreditNotesPreviewLinesParametersQueryLines'Type'
   -> Maybe Int
   -> Maybe Text
   -> GetCreditNotesPreviewLinesParametersQueryLines')
-> Parser GetCreditNotesPreviewLinesParametersQueryLines'Type'
-> Parser
     (Maybe Int
      -> Maybe Text -> GetCreditNotesPreviewLinesParametersQueryLines')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object
-> Text
-> Parser GetCreditNotesPreviewLinesParametersQueryLines'Type'
forall a. FromJSON a => Object -> Text -> Parser a
Data.Aeson.Types.FromJSON..: Text
"type")) Parser
  (Maybe Int
   -> Maybe Text -> GetCreditNotesPreviewLinesParametersQueryLines')
-> Parser (Maybe Int)
-> Parser
     (Maybe Text -> GetCreditNotesPreviewLinesParametersQueryLines')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"unit_amount")) Parser
  (Maybe Text -> GetCreditNotesPreviewLinesParametersQueryLines')
-> Parser (Maybe Text)
-> Parser GetCreditNotesPreviewLinesParametersQueryLines'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Text
"unit_amount_decimal"))

-- | Create a new 'GetCreditNotesPreviewLinesParametersQueryLines'' with all required fields.
mkGetCreditNotesPreviewLinesParametersQueryLines' ::
  -- | 'getCreditNotesPreviewLinesParametersQueryLines'Type'
  GetCreditNotesPreviewLinesParametersQueryLines'Type' ->
  GetCreditNotesPreviewLinesParametersQueryLines'
mkGetCreditNotesPreviewLinesParametersQueryLines' :: GetCreditNotesPreviewLinesParametersQueryLines'Type'
-> GetCreditNotesPreviewLinesParametersQueryLines'
mkGetCreditNotesPreviewLinesParametersQueryLines' GetCreditNotesPreviewLinesParametersQueryLines'Type'
getCreditNotesPreviewLinesParametersQueryLines'Type =
  GetCreditNotesPreviewLinesParametersQueryLines' :: Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe
     GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
-> GetCreditNotesPreviewLinesParametersQueryLines'Type'
-> Maybe Int
-> Maybe Text
-> GetCreditNotesPreviewLinesParametersQueryLines'
GetCreditNotesPreviewLinesParametersQueryLines'
    { getCreditNotesPreviewLinesParametersQueryLines'Amount :: Maybe Int
getCreditNotesPreviewLinesParametersQueryLines'Amount = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      getCreditNotesPreviewLinesParametersQueryLines'Description :: Maybe Text
getCreditNotesPreviewLinesParametersQueryLines'Description = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      getCreditNotesPreviewLinesParametersQueryLines'InvoiceLineItem :: Maybe Text
getCreditNotesPreviewLinesParametersQueryLines'InvoiceLineItem = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing,
      getCreditNotesPreviewLinesParametersQueryLines'Quantity :: Maybe Int
getCreditNotesPreviewLinesParametersQueryLines'Quantity = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      getCreditNotesPreviewLinesParametersQueryLines'TaxRates :: Maybe
  GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
getCreditNotesPreviewLinesParametersQueryLines'TaxRates = Maybe
  GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
forall a. Maybe a
GHC.Maybe.Nothing,
      getCreditNotesPreviewLinesParametersQueryLines'Type :: GetCreditNotesPreviewLinesParametersQueryLines'Type'
getCreditNotesPreviewLinesParametersQueryLines'Type = GetCreditNotesPreviewLinesParametersQueryLines'Type'
getCreditNotesPreviewLinesParametersQueryLines'Type,
      getCreditNotesPreviewLinesParametersQueryLines'UnitAmount :: Maybe Int
getCreditNotesPreviewLinesParametersQueryLines'UnitAmount = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing,
      getCreditNotesPreviewLinesParametersQueryLines'UnitAmountDecimal :: Maybe Text
getCreditNotesPreviewLinesParametersQueryLines'UnitAmountDecimal = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
    }

-- | Defines the oneOf schema located at @paths.\/v1\/credit_notes\/preview\/lines.GET.parameters.properties.queryLines.items.properties.tax_rates.anyOf@ in the specification.
data GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
  = -- | Represents the JSON value @""@
    GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'EmptyString
  | GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'ListTText ([Data.Text.Internal.Text])
  deriving (Int
-> GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
-> ShowS
[GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants]
-> ShowS
GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
-> String
(Int
 -> GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
 -> ShowS)
-> (GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
    -> String)
-> ([GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants]
    -> ShowS)
-> Show
     GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants]
-> ShowS
$cshowList :: [GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants]
-> ShowS
show :: GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
-> String
$cshow :: GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
-> String
showsPrec :: Int
-> GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
-> ShowS
$cshowsPrec :: Int
-> GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
-> ShowS
GHC.Show.Show, GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
-> GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
-> Bool
(GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
 -> GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
 -> Bool)
-> (GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
    -> GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
    -> Bool)
-> Eq
     GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
-> GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
-> Bool
$c/= :: GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
-> GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
-> Bool
== :: GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
-> GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
-> Bool
$c== :: GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
-> GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
-> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants where
  toJSON :: GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
-> Value
toJSON (GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'ListTText [Text]
a) = [Text] -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON [Text]
a
  toJSON (GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'Variants
GetCreditNotesPreviewLinesParametersQueryLines'TaxRates'EmptyString) = Value
""

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

-- | Defines the enum schema located at @paths.\/v1\/credit_notes\/preview\/lines.GET.parameters.properties.queryLines.items.properties.type@ in the specification.
data GetCreditNotesPreviewLinesParametersQueryLines'Type'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    GetCreditNotesPreviewLinesParametersQueryLines'Type'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.
    GetCreditNotesPreviewLinesParametersQueryLines'Type'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"custom_line_item"@
    GetCreditNotesPreviewLinesParametersQueryLines'Type'EnumCustomLineItem
  | -- | Represents the JSON value @"invoice_line_item"@
    GetCreditNotesPreviewLinesParametersQueryLines'Type'EnumInvoiceLineItem
  deriving (Int
-> GetCreditNotesPreviewLinesParametersQueryLines'Type' -> ShowS
[GetCreditNotesPreviewLinesParametersQueryLines'Type'] -> ShowS
GetCreditNotesPreviewLinesParametersQueryLines'Type' -> String
(Int
 -> GetCreditNotesPreviewLinesParametersQueryLines'Type' -> ShowS)
-> (GetCreditNotesPreviewLinesParametersQueryLines'Type' -> String)
-> ([GetCreditNotesPreviewLinesParametersQueryLines'Type']
    -> ShowS)
-> Show GetCreditNotesPreviewLinesParametersQueryLines'Type'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCreditNotesPreviewLinesParametersQueryLines'Type'] -> ShowS
$cshowList :: [GetCreditNotesPreviewLinesParametersQueryLines'Type'] -> ShowS
show :: GetCreditNotesPreviewLinesParametersQueryLines'Type' -> String
$cshow :: GetCreditNotesPreviewLinesParametersQueryLines'Type' -> String
showsPrec :: Int
-> GetCreditNotesPreviewLinesParametersQueryLines'Type' -> ShowS
$cshowsPrec :: Int
-> GetCreditNotesPreviewLinesParametersQueryLines'Type' -> ShowS
GHC.Show.Show, GetCreditNotesPreviewLinesParametersQueryLines'Type'
-> GetCreditNotesPreviewLinesParametersQueryLines'Type' -> Bool
(GetCreditNotesPreviewLinesParametersQueryLines'Type'
 -> GetCreditNotesPreviewLinesParametersQueryLines'Type' -> Bool)
-> (GetCreditNotesPreviewLinesParametersQueryLines'Type'
    -> GetCreditNotesPreviewLinesParametersQueryLines'Type' -> Bool)
-> Eq GetCreditNotesPreviewLinesParametersQueryLines'Type'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCreditNotesPreviewLinesParametersQueryLines'Type'
-> GetCreditNotesPreviewLinesParametersQueryLines'Type' -> Bool
$c/= :: GetCreditNotesPreviewLinesParametersQueryLines'Type'
-> GetCreditNotesPreviewLinesParametersQueryLines'Type' -> Bool
== :: GetCreditNotesPreviewLinesParametersQueryLines'Type'
-> GetCreditNotesPreviewLinesParametersQueryLines'Type' -> Bool
$c== :: GetCreditNotesPreviewLinesParametersQueryLines'Type'
-> GetCreditNotesPreviewLinesParametersQueryLines'Type' -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON GetCreditNotesPreviewLinesParametersQueryLines'Type' where
  toJSON :: GetCreditNotesPreviewLinesParametersQueryLines'Type' -> Value
toJSON (GetCreditNotesPreviewLinesParametersQueryLines'Type'Other Value
val) = Value
val
  toJSON (GetCreditNotesPreviewLinesParametersQueryLines'Type'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (GetCreditNotesPreviewLinesParametersQueryLines'Type'
GetCreditNotesPreviewLinesParametersQueryLines'Type'EnumCustomLineItem) = Value
"custom_line_item"
  toJSON (GetCreditNotesPreviewLinesParametersQueryLines'Type'
GetCreditNotesPreviewLinesParametersQueryLines'Type'EnumInvoiceLineItem) = Value
"invoice_line_item"

instance Data.Aeson.Types.FromJSON.FromJSON GetCreditNotesPreviewLinesParametersQueryLines'Type' where
  parseJSON :: Value
-> Parser GetCreditNotesPreviewLinesParametersQueryLines'Type'
parseJSON Value
val =
    GetCreditNotesPreviewLinesParametersQueryLines'Type'
-> Parser GetCreditNotesPreviewLinesParametersQueryLines'Type'
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
"custom_line_item" -> GetCreditNotesPreviewLinesParametersQueryLines'Type'
GetCreditNotesPreviewLinesParametersQueryLines'Type'EnumCustomLineItem
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"invoice_line_item" -> GetCreditNotesPreviewLinesParametersQueryLines'Type'
GetCreditNotesPreviewLinesParametersQueryLines'Type'EnumInvoiceLineItem
            | Bool
GHC.Base.otherwise -> Value -> GetCreditNotesPreviewLinesParametersQueryLines'Type'
GetCreditNotesPreviewLinesParametersQueryLines'Type'Other Value
val
      )

-- | Defines the enum schema located at @paths.\/v1\/credit_notes\/preview\/lines.GET.parameters.properties.queryReason@ in the specification.
--
-- Represents the parameter named \'reason\'
--
-- Reason for issuing this credit note, one of \`duplicate\`, \`fraudulent\`, \`order_change\`, or \`product_unsatisfactory\`
data GetCreditNotesPreviewLinesParametersQueryReason'
  = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
    GetCreditNotesPreviewLinesParametersQueryReason'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.
    GetCreditNotesPreviewLinesParametersQueryReason'Typed Data.Text.Internal.Text
  | -- | Represents the JSON value @"duplicate"@
    GetCreditNotesPreviewLinesParametersQueryReason'EnumDuplicate
  | -- | Represents the JSON value @"fraudulent"@
    GetCreditNotesPreviewLinesParametersQueryReason'EnumFraudulent
  | -- | Represents the JSON value @"order_change"@
    GetCreditNotesPreviewLinesParametersQueryReason'EnumOrderChange
  | -- | Represents the JSON value @"product_unsatisfactory"@
    GetCreditNotesPreviewLinesParametersQueryReason'EnumProductUnsatisfactory
  deriving (Int -> GetCreditNotesPreviewLinesParametersQueryReason' -> ShowS
[GetCreditNotesPreviewLinesParametersQueryReason'] -> ShowS
GetCreditNotesPreviewLinesParametersQueryReason' -> String
(Int -> GetCreditNotesPreviewLinesParametersQueryReason' -> ShowS)
-> (GetCreditNotesPreviewLinesParametersQueryReason' -> String)
-> ([GetCreditNotesPreviewLinesParametersQueryReason'] -> ShowS)
-> Show GetCreditNotesPreviewLinesParametersQueryReason'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCreditNotesPreviewLinesParametersQueryReason'] -> ShowS
$cshowList :: [GetCreditNotesPreviewLinesParametersQueryReason'] -> ShowS
show :: GetCreditNotesPreviewLinesParametersQueryReason' -> String
$cshow :: GetCreditNotesPreviewLinesParametersQueryReason' -> String
showsPrec :: Int -> GetCreditNotesPreviewLinesParametersQueryReason' -> ShowS
$cshowsPrec :: Int -> GetCreditNotesPreviewLinesParametersQueryReason' -> ShowS
GHC.Show.Show, GetCreditNotesPreviewLinesParametersQueryReason'
-> GetCreditNotesPreviewLinesParametersQueryReason' -> Bool
(GetCreditNotesPreviewLinesParametersQueryReason'
 -> GetCreditNotesPreviewLinesParametersQueryReason' -> Bool)
-> (GetCreditNotesPreviewLinesParametersQueryReason'
    -> GetCreditNotesPreviewLinesParametersQueryReason' -> Bool)
-> Eq GetCreditNotesPreviewLinesParametersQueryReason'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCreditNotesPreviewLinesParametersQueryReason'
-> GetCreditNotesPreviewLinesParametersQueryReason' -> Bool
$c/= :: GetCreditNotesPreviewLinesParametersQueryReason'
-> GetCreditNotesPreviewLinesParametersQueryReason' -> Bool
== :: GetCreditNotesPreviewLinesParametersQueryReason'
-> GetCreditNotesPreviewLinesParametersQueryReason' -> Bool
$c== :: GetCreditNotesPreviewLinesParametersQueryReason'
-> GetCreditNotesPreviewLinesParametersQueryReason' -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON GetCreditNotesPreviewLinesParametersQueryReason' where
  toJSON :: GetCreditNotesPreviewLinesParametersQueryReason' -> Value
toJSON (GetCreditNotesPreviewLinesParametersQueryReason'Other Value
val) = Value
val
  toJSON (GetCreditNotesPreviewLinesParametersQueryReason'Typed Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
  toJSON (GetCreditNotesPreviewLinesParametersQueryReason'
GetCreditNotesPreviewLinesParametersQueryReason'EnumDuplicate) = Value
"duplicate"
  toJSON (GetCreditNotesPreviewLinesParametersQueryReason'
GetCreditNotesPreviewLinesParametersQueryReason'EnumFraudulent) = Value
"fraudulent"
  toJSON (GetCreditNotesPreviewLinesParametersQueryReason'
GetCreditNotesPreviewLinesParametersQueryReason'EnumOrderChange) = Value
"order_change"
  toJSON (GetCreditNotesPreviewLinesParametersQueryReason'
GetCreditNotesPreviewLinesParametersQueryReason'EnumProductUnsatisfactory) = Value
"product_unsatisfactory"

instance Data.Aeson.Types.FromJSON.FromJSON GetCreditNotesPreviewLinesParametersQueryReason' where
  parseJSON :: Value -> Parser GetCreditNotesPreviewLinesParametersQueryReason'
parseJSON Value
val =
    GetCreditNotesPreviewLinesParametersQueryReason'
-> Parser GetCreditNotesPreviewLinesParametersQueryReason'
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
"duplicate" -> GetCreditNotesPreviewLinesParametersQueryReason'
GetCreditNotesPreviewLinesParametersQueryReason'EnumDuplicate
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"fraudulent" -> GetCreditNotesPreviewLinesParametersQueryReason'
GetCreditNotesPreviewLinesParametersQueryReason'EnumFraudulent
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"order_change" -> GetCreditNotesPreviewLinesParametersQueryReason'
GetCreditNotesPreviewLinesParametersQueryReason'EnumOrderChange
            | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"product_unsatisfactory" -> GetCreditNotesPreviewLinesParametersQueryReason'
GetCreditNotesPreviewLinesParametersQueryReason'EnumProductUnsatisfactory
            | Bool
GHC.Base.otherwise -> Value -> GetCreditNotesPreviewLinesParametersQueryReason'
GetCreditNotesPreviewLinesParametersQueryReason'Other Value
val
      )

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

-- | Defines the object schema located at @paths.\/v1\/credit_notes\/preview\/lines.GET.responses.200.content.application\/json.schema@ in the specification.
data GetCreditNotesPreviewLinesResponseBody200 = GetCreditNotesPreviewLinesResponseBody200
  { -- | data: Details about each object.
    GetCreditNotesPreviewLinesResponseBody200 -> [CreditNoteLineItem]
getCreditNotesPreviewLinesResponseBody200Data :: ([CreditNoteLineItem]),
    -- | has_more: True if this list has another page of items after this one that can be fetched.
    GetCreditNotesPreviewLinesResponseBody200 -> Bool
getCreditNotesPreviewLinesResponseBody200HasMore :: GHC.Types.Bool,
    -- | url: The URL where this list can be accessed.
    --
    -- Constraints:
    --
    -- * Maximum length of 5000
    GetCreditNotesPreviewLinesResponseBody200 -> Text
getCreditNotesPreviewLinesResponseBody200Url :: Data.Text.Internal.Text
  }
  deriving
    ( Int -> GetCreditNotesPreviewLinesResponseBody200 -> ShowS
[GetCreditNotesPreviewLinesResponseBody200] -> ShowS
GetCreditNotesPreviewLinesResponseBody200 -> String
(Int -> GetCreditNotesPreviewLinesResponseBody200 -> ShowS)
-> (GetCreditNotesPreviewLinesResponseBody200 -> String)
-> ([GetCreditNotesPreviewLinesResponseBody200] -> ShowS)
-> Show GetCreditNotesPreviewLinesResponseBody200
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCreditNotesPreviewLinesResponseBody200] -> ShowS
$cshowList :: [GetCreditNotesPreviewLinesResponseBody200] -> ShowS
show :: GetCreditNotesPreviewLinesResponseBody200 -> String
$cshow :: GetCreditNotesPreviewLinesResponseBody200 -> String
showsPrec :: Int -> GetCreditNotesPreviewLinesResponseBody200 -> ShowS
$cshowsPrec :: Int -> GetCreditNotesPreviewLinesResponseBody200 -> ShowS
GHC.Show.Show,
      GetCreditNotesPreviewLinesResponseBody200
-> GetCreditNotesPreviewLinesResponseBody200 -> Bool
(GetCreditNotesPreviewLinesResponseBody200
 -> GetCreditNotesPreviewLinesResponseBody200 -> Bool)
-> (GetCreditNotesPreviewLinesResponseBody200
    -> GetCreditNotesPreviewLinesResponseBody200 -> Bool)
-> Eq GetCreditNotesPreviewLinesResponseBody200
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCreditNotesPreviewLinesResponseBody200
-> GetCreditNotesPreviewLinesResponseBody200 -> Bool
$c/= :: GetCreditNotesPreviewLinesResponseBody200
-> GetCreditNotesPreviewLinesResponseBody200 -> Bool
== :: GetCreditNotesPreviewLinesResponseBody200
-> GetCreditNotesPreviewLinesResponseBody200 -> Bool
$c== :: GetCreditNotesPreviewLinesResponseBody200
-> GetCreditNotesPreviewLinesResponseBody200 -> Bool
GHC.Classes.Eq
    )

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