{-# 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 types generated from the schema InvoiceRefund
module RecurlyClient.Types.InvoiceRefund where

import qualified Control.Monad.Fail
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
import qualified Data.ByteString as Data.ByteString.Internal
import qualified Data.Foldable
import qualified Data.Functor
import qualified Data.Maybe
import qualified Data.Scientific
import qualified Data.Text
import qualified Data.Text as 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 GHC.Base
import qualified GHC.Classes
import qualified GHC.Int
import qualified GHC.Show
import qualified GHC.Types
import qualified RecurlyClient.Common
import RecurlyClient.TypeAlias
import {-# SOURCE #-} RecurlyClient.Types.LineItemRefund
import qualified Prelude as GHC.Integer.Type
import qualified Prelude as GHC.Maybe

-- | Defines the object schema located at @components.schemas.InvoiceRefund@ in the specification.
data InvoiceRefund = InvoiceRefund
    { InvoiceRefund -> Maybe Float
invoiceRefundAmount :: (GHC.Maybe.Maybe GHC.Types.Float)
    -- ^ amount: The amount to be refunded. The amount will be split between the line items.
    -- If \`type\` is \"amount\" and no amount is specified, it will default to refunding the total refundable amount on the invoice. Can only be present if \`type\` is \"amount\".
    , InvoiceRefund -> Maybe Text
invoiceRefundCredit_customer_notes :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
    -- ^ credit_customer_notes: Used as the Customer Notes on the credit invoice.
    --
    -- This field can only be include when the Credit Invoices feature is enabled.
    , InvoiceRefund -> Maybe InvoiceRefundExternal_refund
invoiceRefundExternal_refund :: (GHC.Maybe.Maybe InvoiceRefundExternal_refund)
    -- ^ external_refund: Indicates that the refund was settled outside of Recurly, and a manual transaction should be created to track it in Recurly.
    --
    -- Required when:
    -- - refunding a manually collected charge invoice, and \`refund_method\` is not \`all_credit\`
    -- - refunding a credit invoice that refunded manually collecting invoices
    -- - refunding a credit invoice for a partial amount
    --
    -- This field can only be included when the Credit Invoices feature is enabled.
    , InvoiceRefund -> Maybe [LineItemRefund]
invoiceRefundLine_items :: (GHC.Maybe.Maybe [LineItemRefund])
    -- ^ line_items: The line items to be refunded. This is required when \`type=line_items\`.
    , InvoiceRefund -> Maybe Int
invoiceRefundPercentage :: (GHC.Maybe.Maybe GHC.Types.Int)
    -- ^ percentage: The percentage of the remaining balance to be refunded. The percentage will be split between the line items. If \`type\` is \"percentage\" and no percentage is specified, it will default to refunding 100% of the refundable amount on the invoice. Can only be present if \`type\` is \"percentage\".
    --
    -- Constraints:
    --
    -- * Maxium  of 100.0
    -- * Minimum  of 1.0
    , InvoiceRefund -> Maybe InvoiceRefundRefund_method
invoiceRefundRefund_method :: (GHC.Maybe.Maybe InvoiceRefundRefund_method)
    -- ^ refund_method: Indicates how the invoice should be refunded when both a credit and transaction are present on the invoice:
    -- - \`transaction_first\` – Refunds the transaction first, then any amount is issued as credit back to the account. Default value when Credit Invoices feature is enabled.
    -- - \`credit_first\` – Issues credit back to the account first, then refunds any remaining amount back to the transaction. Default value when Credit Invoices feature is not enabled.
    -- - \`all_credit\` – Issues credit to the account for the entire amount of the refund. Only available when the Credit Invoices feature is enabled.
    -- - \`all_transaction\` – Refunds the entire amount back to transactions, using transactions from previous invoices if necessary. Only available when the Credit Invoices feature is enabled.
    , InvoiceRefund -> InvoiceRefundType
invoiceRefundType :: InvoiceRefundType
    -- ^ type: The type of refund. Amount and line items cannot both be specified in the request.
    }
    deriving
        ( Int -> InvoiceRefund -> ShowS
[InvoiceRefund] -> ShowS
InvoiceRefund -> String
(Int -> InvoiceRefund -> ShowS)
-> (InvoiceRefund -> String)
-> ([InvoiceRefund] -> ShowS)
-> Show InvoiceRefund
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvoiceRefund -> ShowS
showsPrec :: Int -> InvoiceRefund -> ShowS
$cshow :: InvoiceRefund -> String
show :: InvoiceRefund -> String
$cshowList :: [InvoiceRefund] -> ShowS
showList :: [InvoiceRefund] -> ShowS
GHC.Show.Show
        , InvoiceRefund -> InvoiceRefund -> Bool
(InvoiceRefund -> InvoiceRefund -> Bool)
-> (InvoiceRefund -> InvoiceRefund -> Bool) -> Eq InvoiceRefund
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InvoiceRefund -> InvoiceRefund -> Bool
== :: InvoiceRefund -> InvoiceRefund -> Bool
$c/= :: InvoiceRefund -> InvoiceRefund -> Bool
/= :: InvoiceRefund -> InvoiceRefund -> Bool
GHC.Classes.Eq
        )

instance Data.Aeson.Types.ToJSON.ToJSON InvoiceRefund where
    toJSON :: InvoiceRefund -> Value
toJSON InvoiceRefund
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object ([[Pair]] -> [Pair]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
Data.Foldable.concat ([Pair] -> (Float -> [Pair]) -> Maybe Float -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [Pair]
forall a. Monoid a => a
GHC.Base.mempty (Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure (Pair -> [Pair]) -> (Float -> Pair) -> Float -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. (Key
"amount" Key -> Float -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Data.Aeson.Types.ToJSON..=)) (InvoiceRefund -> Maybe Float
invoiceRefundAmount InvoiceRefund
obj) [Pair] -> [[Pair]] -> [[Pair]]
forall a. a -> [a] -> [a]
: [Pair] -> (Text -> [Pair]) -> Maybe Text -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [Pair]
forall a. Monoid a => a
GHC.Base.mempty (Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure (Pair -> [Pair]) -> (Text -> Pair) -> Text -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. (Key
"credit_customer_notes" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Data.Aeson.Types.ToJSON..=)) (InvoiceRefund -> Maybe Text
invoiceRefundCredit_customer_notes InvoiceRefund
obj) [Pair] -> [[Pair]] -> [[Pair]]
forall a. a -> [a] -> [a]
: [Pair]
-> (InvoiceRefundExternal_refund -> [Pair])
-> Maybe InvoiceRefundExternal_refund
-> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [Pair]
forall a. Monoid a => a
GHC.Base.mempty (Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure (Pair -> [Pair])
-> (InvoiceRefundExternal_refund -> Pair)
-> InvoiceRefundExternal_refund
-> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. (Key
"external_refund" Key -> InvoiceRefundExternal_refund -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Data.Aeson.Types.ToJSON..=)) (InvoiceRefund -> Maybe InvoiceRefundExternal_refund
invoiceRefundExternal_refund InvoiceRefund
obj) [Pair] -> [[Pair]] -> [[Pair]]
forall a. a -> [a] -> [a]
: [Pair]
-> ([LineItemRefund] -> [Pair]) -> Maybe [LineItemRefund] -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [Pair]
forall a. Monoid a => a
GHC.Base.mempty (Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure (Pair -> [Pair])
-> ([LineItemRefund] -> Pair) -> [LineItemRefund] -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. (Key
"line_items" Key -> [LineItemRefund] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Data.Aeson.Types.ToJSON..=)) (InvoiceRefund -> Maybe [LineItemRefund]
invoiceRefundLine_items InvoiceRefund
obj) [Pair] -> [[Pair]] -> [[Pair]]
forall a. a -> [a] -> [a]
: [Pair] -> (Int -> [Pair]) -> Maybe Int -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [Pair]
forall a. Monoid a => a
GHC.Base.mempty (Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure (Pair -> [Pair]) -> (Int -> Pair) -> Int -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. (Key
"percentage" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Data.Aeson.Types.ToJSON..=)) (InvoiceRefund -> Maybe Int
invoiceRefundPercentage InvoiceRefund
obj) [Pair] -> [[Pair]] -> [[Pair]]
forall a. a -> [a] -> [a]
: [Pair]
-> (InvoiceRefundRefund_method -> [Pair])
-> Maybe InvoiceRefundRefund_method
-> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [Pair]
forall a. Monoid a => a
GHC.Base.mempty (Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure (Pair -> [Pair])
-> (InvoiceRefundRefund_method -> Pair)
-> InvoiceRefundRefund_method
-> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. (Key
"refund_method" Key -> InvoiceRefundRefund_method -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Data.Aeson.Types.ToJSON..=)) (InvoiceRefund -> Maybe InvoiceRefundRefund_method
invoiceRefundRefund_method InvoiceRefund
obj) [Pair] -> [[Pair]] -> [[Pair]]
forall a. a -> [a] -> [a]
: [Key
"type" Key -> InvoiceRefundType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Data.Aeson.Types.ToJSON..= InvoiceRefund -> InvoiceRefundType
invoiceRefundType InvoiceRefund
obj] [Pair] -> [[Pair]] -> [[Pair]]
forall a. a -> [a] -> [a]
: [[Pair]]
forall a. Monoid a => a
GHC.Base.mempty))
    toEncoding :: InvoiceRefund -> Encoding
toEncoding InvoiceRefund
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ([Series] -> Series
forall a. Monoid a => [a] -> a
GHC.Base.mconcat ([[Series]] -> [Series]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
Data.Foldable.concat ([Series] -> (Float -> [Series]) -> Maybe Float -> [Series]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [Series]
forall a. Monoid a => a
GHC.Base.mempty (Series -> [Series]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure (Series -> [Series]) -> (Float -> Series) -> Float -> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. (Key
"amount" Key -> Float -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Series
Data.Aeson.Types.ToJSON..=)) (InvoiceRefund -> Maybe Float
invoiceRefundAmount InvoiceRefund
obj) [Series] -> [[Series]] -> [[Series]]
forall a. a -> [a] -> [a]
: [Series] -> (Text -> [Series]) -> Maybe Text -> [Series]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [Series]
forall a. Monoid a => a
GHC.Base.mempty (Series -> [Series]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure (Series -> [Series]) -> (Text -> Series) -> Text -> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. (Key
"credit_customer_notes" Key -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Series
Data.Aeson.Types.ToJSON..=)) (InvoiceRefund -> Maybe Text
invoiceRefundCredit_customer_notes InvoiceRefund
obj) [Series] -> [[Series]] -> [[Series]]
forall a. a -> [a] -> [a]
: [Series]
-> (InvoiceRefundExternal_refund -> [Series])
-> Maybe InvoiceRefundExternal_refund
-> [Series]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [Series]
forall a. Monoid a => a
GHC.Base.mempty (Series -> [Series]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure (Series -> [Series])
-> (InvoiceRefundExternal_refund -> Series)
-> InvoiceRefundExternal_refund
-> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. (Key
"external_refund" Key -> InvoiceRefundExternal_refund -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Series
Data.Aeson.Types.ToJSON..=)) (InvoiceRefund -> Maybe InvoiceRefundExternal_refund
invoiceRefundExternal_refund InvoiceRefund
obj) [Series] -> [[Series]] -> [[Series]]
forall a. a -> [a] -> [a]
: [Series]
-> ([LineItemRefund] -> [Series])
-> Maybe [LineItemRefund]
-> [Series]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [Series]
forall a. Monoid a => a
GHC.Base.mempty (Series -> [Series]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure (Series -> [Series])
-> ([LineItemRefund] -> Series) -> [LineItemRefund] -> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. (Key
"line_items" Key -> [LineItemRefund] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Series
Data.Aeson.Types.ToJSON..=)) (InvoiceRefund -> Maybe [LineItemRefund]
invoiceRefundLine_items InvoiceRefund
obj) [Series] -> [[Series]] -> [[Series]]
forall a. a -> [a] -> [a]
: [Series] -> (Int -> [Series]) -> Maybe Int -> [Series]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [Series]
forall a. Monoid a => a
GHC.Base.mempty (Series -> [Series]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure (Series -> [Series]) -> (Int -> Series) -> Int -> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. (Key
"percentage" Key -> Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Series
Data.Aeson.Types.ToJSON..=)) (InvoiceRefund -> Maybe Int
invoiceRefundPercentage InvoiceRefund
obj) [Series] -> [[Series]] -> [[Series]]
forall a. a -> [a] -> [a]
: [Series]
-> (InvoiceRefundRefund_method -> [Series])
-> Maybe InvoiceRefundRefund_method
-> [Series]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [Series]
forall a. Monoid a => a
GHC.Base.mempty (Series -> [Series]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure (Series -> [Series])
-> (InvoiceRefundRefund_method -> Series)
-> InvoiceRefundRefund_method
-> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. (Key
"refund_method" Key -> InvoiceRefundRefund_method -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Series
Data.Aeson.Types.ToJSON..=)) (InvoiceRefund -> Maybe InvoiceRefundRefund_method
invoiceRefundRefund_method InvoiceRefund
obj) [Series] -> [[Series]] -> [[Series]]
forall a. a -> [a] -> [a]
: [Key
"type" Key -> InvoiceRefundType -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Series
Data.Aeson.Types.ToJSON..= InvoiceRefund -> InvoiceRefundType
invoiceRefundType InvoiceRefund
obj] [Series] -> [[Series]] -> [[Series]]
forall a. a -> [a] -> [a]
: [[Series]]
forall a. Monoid a => a
GHC.Base.mempty)))
instance Data.Aeson.Types.FromJSON.FromJSON InvoiceRefund where
    parseJSON :: Value -> Parser InvoiceRefund
parseJSON = String
-> (Object -> Parser InvoiceRefund)
-> Value
-> Parser InvoiceRefund
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"InvoiceRefund" (\Object
obj -> (((((((Maybe Float
 -> Maybe Text
 -> Maybe InvoiceRefundExternal_refund
 -> Maybe [LineItemRefund]
 -> Maybe Int
 -> Maybe InvoiceRefundRefund_method
 -> InvoiceRefundType
 -> InvoiceRefund)
-> Parser
     (Maybe Float
      -> Maybe Text
      -> Maybe InvoiceRefundExternal_refund
      -> Maybe [LineItemRefund]
      -> Maybe Int
      -> Maybe InvoiceRefundRefund_method
      -> InvoiceRefundType
      -> InvoiceRefund)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Float
-> Maybe Text
-> Maybe InvoiceRefundExternal_refund
-> Maybe [LineItemRefund]
-> Maybe Int
-> Maybe InvoiceRefundRefund_method
-> InvoiceRefundType
-> InvoiceRefund
InvoiceRefund Parser
  (Maybe Float
   -> Maybe Text
   -> Maybe InvoiceRefundExternal_refund
   -> Maybe [LineItemRefund]
   -> Maybe Int
   -> Maybe InvoiceRefundRefund_method
   -> InvoiceRefundType
   -> InvoiceRefund)
-> Parser (Maybe Float)
-> Parser
     (Maybe Text
      -> Maybe InvoiceRefundExternal_refund
      -> Maybe [LineItemRefund]
      -> Maybe Int
      -> Maybe InvoiceRefundRefund_method
      -> InvoiceRefundType
      -> InvoiceRefund)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Key -> Parser (Maybe Float)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Key
"amount")) Parser
  (Maybe Text
   -> Maybe InvoiceRefundExternal_refund
   -> Maybe [LineItemRefund]
   -> Maybe Int
   -> Maybe InvoiceRefundRefund_method
   -> InvoiceRefundType
   -> InvoiceRefund)
-> Parser (Maybe Text)
-> Parser
     (Maybe InvoiceRefundExternal_refund
      -> Maybe [LineItemRefund]
      -> Maybe Int
      -> Maybe InvoiceRefundRefund_method
      -> InvoiceRefundType
      -> InvoiceRefund)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Key
"credit_customer_notes")) Parser
  (Maybe InvoiceRefundExternal_refund
   -> Maybe [LineItemRefund]
   -> Maybe Int
   -> Maybe InvoiceRefundRefund_method
   -> InvoiceRefundType
   -> InvoiceRefund)
-> Parser (Maybe InvoiceRefundExternal_refund)
-> Parser
     (Maybe [LineItemRefund]
      -> Maybe Int
      -> Maybe InvoiceRefundRefund_method
      -> InvoiceRefundType
      -> InvoiceRefund)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Key -> Parser (Maybe InvoiceRefundExternal_refund)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Key
"external_refund")) Parser
  (Maybe [LineItemRefund]
   -> Maybe Int
   -> Maybe InvoiceRefundRefund_method
   -> InvoiceRefundType
   -> InvoiceRefund)
-> Parser (Maybe [LineItemRefund])
-> Parser
     (Maybe Int
      -> Maybe InvoiceRefundRefund_method
      -> InvoiceRefundType
      -> InvoiceRefund)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Key -> Parser (Maybe [LineItemRefund])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Key
"line_items")) Parser
  (Maybe Int
   -> Maybe InvoiceRefundRefund_method
   -> InvoiceRefundType
   -> InvoiceRefund)
-> Parser (Maybe Int)
-> Parser
     (Maybe InvoiceRefundRefund_method
      -> InvoiceRefundType -> InvoiceRefund)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Key
"percentage")) Parser
  (Maybe InvoiceRefundRefund_method
   -> InvoiceRefundType -> InvoiceRefund)
-> Parser (Maybe InvoiceRefundRefund_method)
-> Parser (InvoiceRefundType -> InvoiceRefund)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Key -> Parser (Maybe InvoiceRefundRefund_method)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Key
"refund_method")) Parser (InvoiceRefundType -> InvoiceRefund)
-> Parser InvoiceRefundType -> Parser InvoiceRefund
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Key -> Parser InvoiceRefundType
forall a. FromJSON a => Object -> Key -> Parser a
Data.Aeson.Types.FromJSON..: Key
"type"))

-- | Create a new 'InvoiceRefund' with all required fields.
mkInvoiceRefund ::
    -- | 'invoiceRefundType'
    InvoiceRefundType ->
    InvoiceRefund
mkInvoiceRefund :: InvoiceRefundType -> InvoiceRefund
mkInvoiceRefund InvoiceRefundType
invoiceRefundType =
    InvoiceRefund
        { invoiceRefundAmount :: Maybe Float
invoiceRefundAmount = Maybe Float
forall a. Maybe a
GHC.Maybe.Nothing
        , invoiceRefundCredit_customer_notes :: Maybe Text
invoiceRefundCredit_customer_notes = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
        , invoiceRefundExternal_refund :: Maybe InvoiceRefundExternal_refund
invoiceRefundExternal_refund = Maybe InvoiceRefundExternal_refund
forall a. Maybe a
GHC.Maybe.Nothing
        , invoiceRefundLine_items :: Maybe [LineItemRefund]
invoiceRefundLine_items = Maybe [LineItemRefund]
forall a. Maybe a
GHC.Maybe.Nothing
        , invoiceRefundPercentage :: Maybe Int
invoiceRefundPercentage = Maybe Int
forall a. Maybe a
GHC.Maybe.Nothing
        , invoiceRefundRefund_method :: Maybe InvoiceRefundRefund_method
invoiceRefundRefund_method = Maybe InvoiceRefundRefund_method
forall a. Maybe a
GHC.Maybe.Nothing
        , invoiceRefundType :: InvoiceRefundType
invoiceRefundType = InvoiceRefundType
invoiceRefundType
        }

{- | Defines the object schema located at @components.schemas.InvoiceRefund.properties.external_refund@ in the specification.

Indicates that the refund was settled outside of Recurly, and a manual transaction should be created to track it in Recurly.

Required when:
- refunding a manually collected charge invoice, and \`refund_method\` is not \`all_credit\`
- refunding a credit invoice that refunded manually collecting invoices
- refunding a credit invoice for a partial amount

This field can only be included when the Credit Invoices feature is enabled.
-}
data InvoiceRefundExternal_refund = InvoiceRefundExternal_refund
    { InvoiceRefundExternal_refund -> Maybe Text
invoiceRefundExternal_refundDescription :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
    -- ^ description: Used as the refund transactions\' description.
    --
    -- Constraints:
    --
    -- * Maximum length of 50
    , InvoiceRefundExternal_refund
-> InvoiceRefundExternal_refundPayment_method
invoiceRefundExternal_refundPayment_method :: InvoiceRefundExternal_refundPayment_method
    -- ^ payment_method: Payment method used for external refund transaction.
    , InvoiceRefundExternal_refund -> Maybe JsonDateTime
invoiceRefundExternal_refundRefunded_at :: (GHC.Maybe.Maybe RecurlyClient.Common.JsonDateTime)
    -- ^ refunded_at: Date the external refund payment was made. Defaults to the current date-time.
    }
    deriving
        ( Int -> InvoiceRefundExternal_refund -> ShowS
[InvoiceRefundExternal_refund] -> ShowS
InvoiceRefundExternal_refund -> String
(Int -> InvoiceRefundExternal_refund -> ShowS)
-> (InvoiceRefundExternal_refund -> String)
-> ([InvoiceRefundExternal_refund] -> ShowS)
-> Show InvoiceRefundExternal_refund
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvoiceRefundExternal_refund -> ShowS
showsPrec :: Int -> InvoiceRefundExternal_refund -> ShowS
$cshow :: InvoiceRefundExternal_refund -> String
show :: InvoiceRefundExternal_refund -> String
$cshowList :: [InvoiceRefundExternal_refund] -> ShowS
showList :: [InvoiceRefundExternal_refund] -> ShowS
GHC.Show.Show
        , InvoiceRefundExternal_refund
-> InvoiceRefundExternal_refund -> Bool
(InvoiceRefundExternal_refund
 -> InvoiceRefundExternal_refund -> Bool)
-> (InvoiceRefundExternal_refund
    -> InvoiceRefundExternal_refund -> Bool)
-> Eq InvoiceRefundExternal_refund
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InvoiceRefundExternal_refund
-> InvoiceRefundExternal_refund -> Bool
== :: InvoiceRefundExternal_refund
-> InvoiceRefundExternal_refund -> Bool
$c/= :: InvoiceRefundExternal_refund
-> InvoiceRefundExternal_refund -> Bool
/= :: InvoiceRefundExternal_refund
-> InvoiceRefundExternal_refund -> Bool
GHC.Classes.Eq
        )

instance Data.Aeson.Types.ToJSON.ToJSON InvoiceRefundExternal_refund where
    toJSON :: InvoiceRefundExternal_refund -> Value
toJSON InvoiceRefundExternal_refund
obj = [Pair] -> Value
Data.Aeson.Types.Internal.object ([[Pair]] -> [Pair]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
Data.Foldable.concat ([Pair] -> (Text -> [Pair]) -> Maybe Text -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [Pair]
forall a. Monoid a => a
GHC.Base.mempty (Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure (Pair -> [Pair]) -> (Text -> Pair) -> Text -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. (Key
"description" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Data.Aeson.Types.ToJSON..=)) (InvoiceRefundExternal_refund -> Maybe Text
invoiceRefundExternal_refundDescription InvoiceRefundExternal_refund
obj) [Pair] -> [[Pair]] -> [[Pair]]
forall a. a -> [a] -> [a]
: [Key
"payment_method" Key -> InvoiceRefundExternal_refundPayment_method -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Data.Aeson.Types.ToJSON..= InvoiceRefundExternal_refund
-> InvoiceRefundExternal_refundPayment_method
invoiceRefundExternal_refundPayment_method InvoiceRefundExternal_refund
obj] [Pair] -> [[Pair]] -> [[Pair]]
forall a. a -> [a] -> [a]
: [Pair] -> (JsonDateTime -> [Pair]) -> Maybe JsonDateTime -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [Pair]
forall a. Monoid a => a
GHC.Base.mempty (Pair -> [Pair]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure (Pair -> [Pair])
-> (JsonDateTime -> Pair) -> JsonDateTime -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. (Key
"refunded_at" Key -> JsonDateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Data.Aeson.Types.ToJSON..=)) (InvoiceRefundExternal_refund -> Maybe JsonDateTime
invoiceRefundExternal_refundRefunded_at InvoiceRefundExternal_refund
obj) [Pair] -> [[Pair]] -> [[Pair]]
forall a. a -> [a] -> [a]
: [[Pair]]
forall a. Monoid a => a
GHC.Base.mempty))
    toEncoding :: InvoiceRefundExternal_refund -> Encoding
toEncoding InvoiceRefundExternal_refund
obj = Series -> Encoding
Data.Aeson.Encoding.Internal.pairs ([Series] -> Series
forall a. Monoid a => [a] -> a
GHC.Base.mconcat ([[Series]] -> [Series]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
Data.Foldable.concat ([Series] -> (Text -> [Series]) -> Maybe Text -> [Series]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [Series]
forall a. Monoid a => a
GHC.Base.mempty (Series -> [Series]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure (Series -> [Series]) -> (Text -> Series) -> Text -> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. (Key
"description" Key -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Series
Data.Aeson.Types.ToJSON..=)) (InvoiceRefundExternal_refund -> Maybe Text
invoiceRefundExternal_refundDescription InvoiceRefundExternal_refund
obj) [Series] -> [[Series]] -> [[Series]]
forall a. a -> [a] -> [a]
: [Key
"payment_method" Key -> InvoiceRefundExternal_refundPayment_method -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Series
Data.Aeson.Types.ToJSON..= InvoiceRefundExternal_refund
-> InvoiceRefundExternal_refundPayment_method
invoiceRefundExternal_refundPayment_method InvoiceRefundExternal_refund
obj] [Series] -> [[Series]] -> [[Series]]
forall a. a -> [a] -> [a]
: [Series]
-> (JsonDateTime -> [Series]) -> Maybe JsonDateTime -> [Series]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [Series]
forall a. Monoid a => a
GHC.Base.mempty (Series -> [Series]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure (Series -> [Series])
-> (JsonDateTime -> Series) -> JsonDateTime -> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. (Key
"refunded_at" Key -> JsonDateTime -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Series
Data.Aeson.Types.ToJSON..=)) (InvoiceRefundExternal_refund -> Maybe JsonDateTime
invoiceRefundExternal_refundRefunded_at InvoiceRefundExternal_refund
obj) [Series] -> [[Series]] -> [[Series]]
forall a. a -> [a] -> [a]
: [[Series]]
forall a. Monoid a => a
GHC.Base.mempty)))
instance Data.Aeson.Types.FromJSON.FromJSON InvoiceRefundExternal_refund where
    parseJSON :: Value -> Parser InvoiceRefundExternal_refund
parseJSON = String
-> (Object -> Parser InvoiceRefundExternal_refund)
-> Value
-> Parser InvoiceRefundExternal_refund
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"InvoiceRefundExternal_refund" (\Object
obj -> (((Maybe Text
 -> InvoiceRefundExternal_refundPayment_method
 -> Maybe JsonDateTime
 -> InvoiceRefundExternal_refund)
-> Parser
     (Maybe Text
      -> InvoiceRefundExternal_refundPayment_method
      -> Maybe JsonDateTime
      -> InvoiceRefundExternal_refund)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> InvoiceRefundExternal_refundPayment_method
-> Maybe JsonDateTime
-> InvoiceRefundExternal_refund
InvoiceRefundExternal_refund Parser
  (Maybe Text
   -> InvoiceRefundExternal_refundPayment_method
   -> Maybe JsonDateTime
   -> InvoiceRefundExternal_refund)
-> Parser (Maybe Text)
-> Parser
     (InvoiceRefundExternal_refundPayment_method
      -> Maybe JsonDateTime -> InvoiceRefundExternal_refund)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Key
"description")) Parser
  (InvoiceRefundExternal_refundPayment_method
   -> Maybe JsonDateTime -> InvoiceRefundExternal_refund)
-> Parser InvoiceRefundExternal_refundPayment_method
-> Parser (Maybe JsonDateTime -> InvoiceRefundExternal_refund)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Key -> Parser InvoiceRefundExternal_refundPayment_method
forall a. FromJSON a => Object -> Key -> Parser a
Data.Aeson.Types.FromJSON..: Key
"payment_method")) Parser (Maybe JsonDateTime -> InvoiceRefundExternal_refund)
-> Parser (Maybe JsonDateTime)
-> Parser InvoiceRefundExternal_refund
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
GHC.Base.<*> (Object
obj Object -> Key -> Parser (Maybe JsonDateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Key
"refunded_at"))

-- | Create a new 'InvoiceRefundExternal_refund' with all required fields.
mkInvoiceRefundExternal_refund ::
    -- | 'invoiceRefundExternal_refundPayment_method'
    InvoiceRefundExternal_refundPayment_method ->
    InvoiceRefundExternal_refund
mkInvoiceRefundExternal_refund :: InvoiceRefundExternal_refundPayment_method
-> InvoiceRefundExternal_refund
mkInvoiceRefundExternal_refund InvoiceRefundExternal_refundPayment_method
invoiceRefundExternal_refundPayment_method =
    InvoiceRefundExternal_refund
        { invoiceRefundExternal_refundDescription :: Maybe Text
invoiceRefundExternal_refundDescription = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
        , invoiceRefundExternal_refundPayment_method :: InvoiceRefundExternal_refundPayment_method
invoiceRefundExternal_refundPayment_method = InvoiceRefundExternal_refundPayment_method
invoiceRefundExternal_refundPayment_method
        , invoiceRefundExternal_refundRefunded_at :: Maybe JsonDateTime
invoiceRefundExternal_refundRefunded_at = Maybe JsonDateTime
forall a. Maybe a
GHC.Maybe.Nothing
        }

{- | Defines the enum schema located at @components.schemas.InvoiceRefund.properties.external_refund.properties.payment_method@ in the specification.

Payment method used for external refund transaction.
-}
data InvoiceRefundExternal_refundPayment_method
    = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
      InvoiceRefundExternal_refundPayment_methodOther Data.Aeson.Types.Internal.Value
    | -- | This constructor can be used to send values to the server which are not present in the specification yet.
      InvoiceRefundExternal_refundPayment_methodTyped Data.Text.Internal.Text
    | -- | Represents the JSON value @"bacs"@
      InvoiceRefundExternal_refundPayment_methodEnumBacs
    | -- | Represents the JSON value @"ach"@
      InvoiceRefundExternal_refundPayment_methodEnumAch
    | -- | Represents the JSON value @"amazon"@
      InvoiceRefundExternal_refundPayment_methodEnumAmazon
    | -- | Represents the JSON value @"apple_pay"@
      InvoiceRefundExternal_refundPayment_methodEnumApple_pay
    | -- | Represents the JSON value @"braintree_apple_pay"@
      InvoiceRefundExternal_refundPayment_methodEnumBraintree_apple_pay
    | -- | Represents the JSON value @"check"@
      InvoiceRefundExternal_refundPayment_methodEnumCheck
    | -- | Represents the JSON value @"credit_card"@
      InvoiceRefundExternal_refundPayment_methodEnumCredit_card
    | -- | Represents the JSON value @"eft"@
      InvoiceRefundExternal_refundPayment_methodEnumEft
    | -- | Represents the JSON value @"google_pay"@
      InvoiceRefundExternal_refundPayment_methodEnumGoogle_pay
    | -- | Represents the JSON value @"money_order"@
      InvoiceRefundExternal_refundPayment_methodEnumMoney_order
    | -- | Represents the JSON value @"other"@
      InvoiceRefundExternal_refundPayment_methodEnumOther
    | -- | Represents the JSON value @"paypal"@
      InvoiceRefundExternal_refundPayment_methodEnumPaypal
    | -- | Represents the JSON value @"roku"@
      InvoiceRefundExternal_refundPayment_methodEnumRoku
    | -- | Represents the JSON value @"sepadirectdebit"@
      InvoiceRefundExternal_refundPayment_methodEnumSepadirectdebit
    | -- | Represents the JSON value @"wire_transfer"@
      InvoiceRefundExternal_refundPayment_methodEnumWire_transfer
    deriving (Int -> InvoiceRefundExternal_refundPayment_method -> ShowS
[InvoiceRefundExternal_refundPayment_method] -> ShowS
InvoiceRefundExternal_refundPayment_method -> String
(Int -> InvoiceRefundExternal_refundPayment_method -> ShowS)
-> (InvoiceRefundExternal_refundPayment_method -> String)
-> ([InvoiceRefundExternal_refundPayment_method] -> ShowS)
-> Show InvoiceRefundExternal_refundPayment_method
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvoiceRefundExternal_refundPayment_method -> ShowS
showsPrec :: Int -> InvoiceRefundExternal_refundPayment_method -> ShowS
$cshow :: InvoiceRefundExternal_refundPayment_method -> String
show :: InvoiceRefundExternal_refundPayment_method -> String
$cshowList :: [InvoiceRefundExternal_refundPayment_method] -> ShowS
showList :: [InvoiceRefundExternal_refundPayment_method] -> ShowS
GHC.Show.Show, InvoiceRefundExternal_refundPayment_method
-> InvoiceRefundExternal_refundPayment_method -> Bool
(InvoiceRefundExternal_refundPayment_method
 -> InvoiceRefundExternal_refundPayment_method -> Bool)
-> (InvoiceRefundExternal_refundPayment_method
    -> InvoiceRefundExternal_refundPayment_method -> Bool)
-> Eq InvoiceRefundExternal_refundPayment_method
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InvoiceRefundExternal_refundPayment_method
-> InvoiceRefundExternal_refundPayment_method -> Bool
== :: InvoiceRefundExternal_refundPayment_method
-> InvoiceRefundExternal_refundPayment_method -> Bool
$c/= :: InvoiceRefundExternal_refundPayment_method
-> InvoiceRefundExternal_refundPayment_method -> Bool
/= :: InvoiceRefundExternal_refundPayment_method
-> InvoiceRefundExternal_refundPayment_method -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON InvoiceRefundExternal_refundPayment_method where
    toJSON :: InvoiceRefundExternal_refundPayment_method -> Value
toJSON (InvoiceRefundExternal_refundPayment_methodOther Value
val) = Value
val
    toJSON (InvoiceRefundExternal_refundPayment_methodTyped Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
    toJSON (InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumBacs) = Value
"bacs"
    toJSON (InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumAch) = Value
"ach"
    toJSON (InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumAmazon) = Value
"amazon"
    toJSON (InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumApple_pay) = Value
"apple_pay"
    toJSON (InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumBraintree_apple_pay) = Value
"braintree_apple_pay"
    toJSON (InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumCheck) = Value
"check"
    toJSON (InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumCredit_card) = Value
"credit_card"
    toJSON (InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumEft) = Value
"eft"
    toJSON (InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumGoogle_pay) = Value
"google_pay"
    toJSON (InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumMoney_order) = Value
"money_order"
    toJSON (InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumOther) = Value
"other"
    toJSON (InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumPaypal) = Value
"paypal"
    toJSON (InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumRoku) = Value
"roku"
    toJSON (InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumSepadirectdebit) = Value
"sepadirectdebit"
    toJSON (InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumWire_transfer) = Value
"wire_transfer"
instance Data.Aeson.Types.FromJSON.FromJSON InvoiceRefundExternal_refundPayment_method where
    parseJSON :: Value -> Parser InvoiceRefundExternal_refundPayment_method
parseJSON Value
val =
        InvoiceRefundExternal_refundPayment_method
-> Parser InvoiceRefundExternal_refundPayment_method
forall a. a -> Parser a
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
"bacs" -> InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumBacs
                | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"ach" -> InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumAch
                | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"amazon" -> InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumAmazon
                | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"apple_pay" -> InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumApple_pay
                | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"braintree_apple_pay" -> InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumBraintree_apple_pay
                | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"check" -> InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumCheck
                | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"credit_card" -> InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumCredit_card
                | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"eft" -> InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumEft
                | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"google_pay" -> InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumGoogle_pay
                | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"money_order" -> InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumMoney_order
                | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"other" -> InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumOther
                | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"paypal" -> InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumPaypal
                | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"roku" -> InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumRoku
                | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"sepadirectdebit" -> InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumSepadirectdebit
                | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"wire_transfer" -> InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodEnumWire_transfer
                | Bool
GHC.Base.otherwise -> Value -> InvoiceRefundExternal_refundPayment_method
InvoiceRefundExternal_refundPayment_methodOther Value
val
            )

{- | Defines the enum schema located at @components.schemas.InvoiceRefund.properties.refund_method@ in the specification.

Indicates how the invoice should be refunded when both a credit and transaction are present on the invoice:
- \`transaction_first\` – Refunds the transaction first, then any amount is issued as credit back to the account. Default value when Credit Invoices feature is enabled.
- \`credit_first\` – Issues credit back to the account first, then refunds any remaining amount back to the transaction. Default value when Credit Invoices feature is not enabled.
- \`all_credit\` – Issues credit to the account for the entire amount of the refund. Only available when the Credit Invoices feature is enabled.
- \`all_transaction\` – Refunds the entire amount back to transactions, using transactions from previous invoices if necessary. Only available when the Credit Invoices feature is enabled.
-}
data InvoiceRefundRefund_method
    = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
      InvoiceRefundRefund_methodOther Data.Aeson.Types.Internal.Value
    | -- | This constructor can be used to send values to the server which are not present in the specification yet.
      InvoiceRefundRefund_methodTyped Data.Text.Internal.Text
    | -- | Represents the JSON value @"all_credit"@
      InvoiceRefundRefund_methodEnumAll_credit
    | -- | Represents the JSON value @"all_transaction"@
      InvoiceRefundRefund_methodEnumAll_transaction
    | -- | Represents the JSON value @"credit_first"@
      InvoiceRefundRefund_methodEnumCredit_first
    | -- | Represents the JSON value @"transaction_first"@
      InvoiceRefundRefund_methodEnumTransaction_first
    deriving (Int -> InvoiceRefundRefund_method -> ShowS
[InvoiceRefundRefund_method] -> ShowS
InvoiceRefundRefund_method -> String
(Int -> InvoiceRefundRefund_method -> ShowS)
-> (InvoiceRefundRefund_method -> String)
-> ([InvoiceRefundRefund_method] -> ShowS)
-> Show InvoiceRefundRefund_method
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvoiceRefundRefund_method -> ShowS
showsPrec :: Int -> InvoiceRefundRefund_method -> ShowS
$cshow :: InvoiceRefundRefund_method -> String
show :: InvoiceRefundRefund_method -> String
$cshowList :: [InvoiceRefundRefund_method] -> ShowS
showList :: [InvoiceRefundRefund_method] -> ShowS
GHC.Show.Show, InvoiceRefundRefund_method -> InvoiceRefundRefund_method -> Bool
(InvoiceRefundRefund_method -> InvoiceRefundRefund_method -> Bool)
-> (InvoiceRefundRefund_method
    -> InvoiceRefundRefund_method -> Bool)
-> Eq InvoiceRefundRefund_method
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InvoiceRefundRefund_method -> InvoiceRefundRefund_method -> Bool
== :: InvoiceRefundRefund_method -> InvoiceRefundRefund_method -> Bool
$c/= :: InvoiceRefundRefund_method -> InvoiceRefundRefund_method -> Bool
/= :: InvoiceRefundRefund_method -> InvoiceRefundRefund_method -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON InvoiceRefundRefund_method where
    toJSON :: InvoiceRefundRefund_method -> Value
toJSON (InvoiceRefundRefund_methodOther Value
val) = Value
val
    toJSON (InvoiceRefundRefund_methodTyped Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
    toJSON (InvoiceRefundRefund_method
InvoiceRefundRefund_methodEnumAll_credit) = Value
"all_credit"
    toJSON (InvoiceRefundRefund_method
InvoiceRefundRefund_methodEnumAll_transaction) = Value
"all_transaction"
    toJSON (InvoiceRefundRefund_method
InvoiceRefundRefund_methodEnumCredit_first) = Value
"credit_first"
    toJSON (InvoiceRefundRefund_method
InvoiceRefundRefund_methodEnumTransaction_first) = Value
"transaction_first"
instance Data.Aeson.Types.FromJSON.FromJSON InvoiceRefundRefund_method where
    parseJSON :: Value -> Parser InvoiceRefundRefund_method
parseJSON Value
val =
        InvoiceRefundRefund_method -> Parser InvoiceRefundRefund_method
forall a. a -> Parser a
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
"all_credit" -> InvoiceRefundRefund_method
InvoiceRefundRefund_methodEnumAll_credit
                | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"all_transaction" -> InvoiceRefundRefund_method
InvoiceRefundRefund_methodEnumAll_transaction
                | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"credit_first" -> InvoiceRefundRefund_method
InvoiceRefundRefund_methodEnumCredit_first
                | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"transaction_first" -> InvoiceRefundRefund_method
InvoiceRefundRefund_methodEnumTransaction_first
                | Bool
GHC.Base.otherwise -> Value -> InvoiceRefundRefund_method
InvoiceRefundRefund_methodOther Value
val
            )

{- | Defines the enum schema located at @components.schemas.InvoiceRefund.properties.type@ in the specification.

The type of refund. Amount and line items cannot both be specified in the request.
-}
data InvoiceRefundType
    = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
      InvoiceRefundTypeOther Data.Aeson.Types.Internal.Value
    | -- | This constructor can be used to send values to the server which are not present in the specification yet.
      InvoiceRefundTypeTyped Data.Text.Internal.Text
    | -- | Represents the JSON value @"amount"@
      InvoiceRefundTypeEnumAmount
    | -- | Represents the JSON value @"percentage"@
      InvoiceRefundTypeEnumPercentage
    | -- | Represents the JSON value @"line_items"@
      InvoiceRefundTypeEnumLine_items
    deriving (Int -> InvoiceRefundType -> ShowS
[InvoiceRefundType] -> ShowS
InvoiceRefundType -> String
(Int -> InvoiceRefundType -> ShowS)
-> (InvoiceRefundType -> String)
-> ([InvoiceRefundType] -> ShowS)
-> Show InvoiceRefundType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvoiceRefundType -> ShowS
showsPrec :: Int -> InvoiceRefundType -> ShowS
$cshow :: InvoiceRefundType -> String
show :: InvoiceRefundType -> String
$cshowList :: [InvoiceRefundType] -> ShowS
showList :: [InvoiceRefundType] -> ShowS
GHC.Show.Show, InvoiceRefundType -> InvoiceRefundType -> Bool
(InvoiceRefundType -> InvoiceRefundType -> Bool)
-> (InvoiceRefundType -> InvoiceRefundType -> Bool)
-> Eq InvoiceRefundType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InvoiceRefundType -> InvoiceRefundType -> Bool
== :: InvoiceRefundType -> InvoiceRefundType -> Bool
$c/= :: InvoiceRefundType -> InvoiceRefundType -> Bool
/= :: InvoiceRefundType -> InvoiceRefundType -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON InvoiceRefundType where
    toJSON :: InvoiceRefundType -> Value
toJSON (InvoiceRefundTypeOther Value
val) = Value
val
    toJSON (InvoiceRefundTypeTyped Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
    toJSON (InvoiceRefundType
InvoiceRefundTypeEnumAmount) = Value
"amount"
    toJSON (InvoiceRefundType
InvoiceRefundTypeEnumPercentage) = Value
"percentage"
    toJSON (InvoiceRefundType
InvoiceRefundTypeEnumLine_items) = Value
"line_items"
instance Data.Aeson.Types.FromJSON.FromJSON InvoiceRefundType where
    parseJSON :: Value -> Parser InvoiceRefundType
parseJSON Value
val =
        InvoiceRefundType -> Parser InvoiceRefundType
forall a. a -> Parser a
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
"amount" -> InvoiceRefundType
InvoiceRefundTypeEnumAmount
                | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"percentage" -> InvoiceRefundType
InvoiceRefundTypeEnumPercentage
                | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
GHC.Classes.== Value
"line_items" -> InvoiceRefundType
InvoiceRefundTypeEnumLine_items
                | Bool
GHC.Base.otherwise -> Value -> InvoiceRefundType
InvoiceRefundTypeOther Value
val
            )