{-# 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 InvoiceCollect
module RecurlyClient.Types.InvoiceCollect 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 qualified Prelude as GHC.Integer.Type
import qualified Prelude as GHC.Maybe

-- | Defines the object schema located at @components.schemas.InvoiceCollect@ in the specification.
data InvoiceCollect = InvoiceCollect
    { InvoiceCollect -> Maybe Text
invoiceCollectBilling_info_id :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
    -- ^ billing_info_id: The \`billing_info_id\` is the value that represents a specific billing info for an end customer. When \`billing_info_id\` is used to assign billing info to the subscription, all future billing events for the subscription will bill to the specified billing info. \`billing_info_id\` can ONLY be used for sites utilizing the Wallet feature.
    , InvoiceCollect -> Maybe Text
invoiceCollectThree_d_secure_action_result_token_id :: (GHC.Maybe.Maybe Data.Text.Internal.Text)
    -- ^ three_d_secure_action_result_token_id: A token generated by Recurly.js after completing a 3-D Secure device fingerprinting or authentication challenge.
    --
    -- Constraints:
    --
    -- * Maximum length of 22
    , InvoiceCollect -> Maybe InvoiceCollectTransaction_type
invoiceCollectTransaction_type :: (GHC.Maybe.Maybe InvoiceCollectTransaction_type)
    -- ^ transaction_type: An optional type designation for the payment gateway transaction created by this request. Supports \'moto\' value, which is the acronym for mail order and telephone transactions.
    }
    deriving
        ( Int -> InvoiceCollect -> ShowS
[InvoiceCollect] -> ShowS
InvoiceCollect -> String
(Int -> InvoiceCollect -> ShowS)
-> (InvoiceCollect -> String)
-> ([InvoiceCollect] -> ShowS)
-> Show InvoiceCollect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvoiceCollect -> ShowS
showsPrec :: Int -> InvoiceCollect -> ShowS
$cshow :: InvoiceCollect -> String
show :: InvoiceCollect -> String
$cshowList :: [InvoiceCollect] -> ShowS
showList :: [InvoiceCollect] -> ShowS
GHC.Show.Show
        , InvoiceCollect -> InvoiceCollect -> Bool
(InvoiceCollect -> InvoiceCollect -> Bool)
-> (InvoiceCollect -> InvoiceCollect -> Bool) -> Eq InvoiceCollect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InvoiceCollect -> InvoiceCollect -> Bool
== :: InvoiceCollect -> InvoiceCollect -> Bool
$c/= :: InvoiceCollect -> InvoiceCollect -> Bool
/= :: InvoiceCollect -> InvoiceCollect -> Bool
GHC.Classes.Eq
        )

instance Data.Aeson.Types.ToJSON.ToJSON InvoiceCollect where
    toJSON :: InvoiceCollect -> Value
toJSON InvoiceCollect
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
"billing_info_id" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Data.Aeson.Types.ToJSON..=)) (InvoiceCollect -> Maybe Text
invoiceCollectBilling_info_id InvoiceCollect
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
"three_d_secure_action_result_token_id" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Data.Aeson.Types.ToJSON..=)) (InvoiceCollect -> Maybe Text
invoiceCollectThree_d_secure_action_result_token_id InvoiceCollect
obj) [Pair] -> [[Pair]] -> [[Pair]]
forall a. a -> [a] -> [a]
: [Pair]
-> (InvoiceCollectTransaction_type -> [Pair])
-> Maybe InvoiceCollectTransaction_type
-> [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])
-> (InvoiceCollectTransaction_type -> Pair)
-> InvoiceCollectTransaction_type
-> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. (Key
"transaction_type" Key -> InvoiceCollectTransaction_type -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Data.Aeson.Types.ToJSON..=)) (InvoiceCollect -> Maybe InvoiceCollectTransaction_type
invoiceCollectTransaction_type InvoiceCollect
obj) [Pair] -> [[Pair]] -> [[Pair]]
forall a. a -> [a] -> [a]
: [[Pair]]
forall a. Monoid a => a
GHC.Base.mempty))
    toEncoding :: InvoiceCollect -> Encoding
toEncoding InvoiceCollect
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
"billing_info_id" Key -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Series
Data.Aeson.Types.ToJSON..=)) (InvoiceCollect -> Maybe Text
invoiceCollectBilling_info_id InvoiceCollect
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
"three_d_secure_action_result_token_id" Key -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Series
Data.Aeson.Types.ToJSON..=)) (InvoiceCollect -> Maybe Text
invoiceCollectThree_d_secure_action_result_token_id InvoiceCollect
obj) [Series] -> [[Series]] -> [[Series]]
forall a. a -> [a] -> [a]
: [Series]
-> (InvoiceCollectTransaction_type -> [Series])
-> Maybe InvoiceCollectTransaction_type
-> [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])
-> (InvoiceCollectTransaction_type -> Series)
-> InvoiceCollectTransaction_type
-> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
GHC.Base.. (Key
"transaction_type" Key -> InvoiceCollectTransaction_type -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Series
Data.Aeson.Types.ToJSON..=)) (InvoiceCollect -> Maybe InvoiceCollectTransaction_type
invoiceCollectTransaction_type InvoiceCollect
obj) [Series] -> [[Series]] -> [[Series]]
forall a. a -> [a] -> [a]
: [[Series]]
forall a. Monoid a => a
GHC.Base.mempty)))
instance Data.Aeson.Types.FromJSON.FromJSON InvoiceCollect where
    parseJSON :: Value -> Parser InvoiceCollect
parseJSON = String
-> (Object -> Parser InvoiceCollect)
-> Value
-> Parser InvoiceCollect
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.Aeson.Types.FromJSON.withObject String
"InvoiceCollect" (\Object
obj -> (((Maybe Text
 -> Maybe Text
 -> Maybe InvoiceCollectTransaction_type
 -> InvoiceCollect)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe InvoiceCollectTransaction_type
      -> InvoiceCollect)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
GHC.Base.pure Maybe Text
-> Maybe Text
-> Maybe InvoiceCollectTransaction_type
-> InvoiceCollect
InvoiceCollect Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe InvoiceCollectTransaction_type
   -> InvoiceCollect)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe InvoiceCollectTransaction_type -> InvoiceCollect)
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
"billing_info_id")) Parser
  (Maybe Text
   -> Maybe InvoiceCollectTransaction_type -> InvoiceCollect)
-> Parser (Maybe Text)
-> Parser (Maybe InvoiceCollectTransaction_type -> InvoiceCollect)
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
"three_d_secure_action_result_token_id")) Parser (Maybe InvoiceCollectTransaction_type -> InvoiceCollect)
-> Parser (Maybe InvoiceCollectTransaction_type)
-> Parser InvoiceCollect
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 InvoiceCollectTransaction_type)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data.Aeson.Types.FromJSON..:? Key
"transaction_type"))

-- | Create a new 'InvoiceCollect' with all required fields.
mkInvoiceCollect :: InvoiceCollect
mkInvoiceCollect :: InvoiceCollect
mkInvoiceCollect =
    InvoiceCollect
        { invoiceCollectBilling_info_id :: Maybe Text
invoiceCollectBilling_info_id = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
        , invoiceCollectThree_d_secure_action_result_token_id :: Maybe Text
invoiceCollectThree_d_secure_action_result_token_id = Maybe Text
forall a. Maybe a
GHC.Maybe.Nothing
        , invoiceCollectTransaction_type :: Maybe InvoiceCollectTransaction_type
invoiceCollectTransaction_type = Maybe InvoiceCollectTransaction_type
forall a. Maybe a
GHC.Maybe.Nothing
        }

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

An optional type designation for the payment gateway transaction created by this request. Supports \'moto\' value, which is the acronym for mail order and telephone transactions.
-}
data InvoiceCollectTransaction_type
    = -- | This case is used if the value encountered during decoding does not match any of the provided cases in the specification.
      InvoiceCollectTransaction_typeOther Data.Aeson.Types.Internal.Value
    | -- | This constructor can be used to send values to the server which are not present in the specification yet.
      InvoiceCollectTransaction_typeTyped Data.Text.Internal.Text
    | -- | Represents the JSON value @"moto"@
      InvoiceCollectTransaction_typeEnumMoto
    deriving (Int -> InvoiceCollectTransaction_type -> ShowS
[InvoiceCollectTransaction_type] -> ShowS
InvoiceCollectTransaction_type -> String
(Int -> InvoiceCollectTransaction_type -> ShowS)
-> (InvoiceCollectTransaction_type -> String)
-> ([InvoiceCollectTransaction_type] -> ShowS)
-> Show InvoiceCollectTransaction_type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvoiceCollectTransaction_type -> ShowS
showsPrec :: Int -> InvoiceCollectTransaction_type -> ShowS
$cshow :: InvoiceCollectTransaction_type -> String
show :: InvoiceCollectTransaction_type -> String
$cshowList :: [InvoiceCollectTransaction_type] -> ShowS
showList :: [InvoiceCollectTransaction_type] -> ShowS
GHC.Show.Show, InvoiceCollectTransaction_type
-> InvoiceCollectTransaction_type -> Bool
(InvoiceCollectTransaction_type
 -> InvoiceCollectTransaction_type -> Bool)
-> (InvoiceCollectTransaction_type
    -> InvoiceCollectTransaction_type -> Bool)
-> Eq InvoiceCollectTransaction_type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InvoiceCollectTransaction_type
-> InvoiceCollectTransaction_type -> Bool
== :: InvoiceCollectTransaction_type
-> InvoiceCollectTransaction_type -> Bool
$c/= :: InvoiceCollectTransaction_type
-> InvoiceCollectTransaction_type -> Bool
/= :: InvoiceCollectTransaction_type
-> InvoiceCollectTransaction_type -> Bool
GHC.Classes.Eq)

instance Data.Aeson.Types.ToJSON.ToJSON InvoiceCollectTransaction_type where
    toJSON :: InvoiceCollectTransaction_type -> Value
toJSON (InvoiceCollectTransaction_typeOther Value
val) = Value
val
    toJSON (InvoiceCollectTransaction_typeTyped Text
val) = Text -> Value
forall a. ToJSON a => a -> Value
Data.Aeson.Types.ToJSON.toJSON Text
val
    toJSON (InvoiceCollectTransaction_type
InvoiceCollectTransaction_typeEnumMoto) = Value
"moto"
instance Data.Aeson.Types.FromJSON.FromJSON InvoiceCollectTransaction_type where
    parseJSON :: Value -> Parser InvoiceCollectTransaction_type
parseJSON Value
val =
        InvoiceCollectTransaction_type
-> Parser InvoiceCollectTransaction_type
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
"moto" -> InvoiceCollectTransaction_type
InvoiceCollectTransaction_typeEnumMoto
                | Bool
GHC.Base.otherwise -> Value -> InvoiceCollectTransaction_type
InvoiceCollectTransaction_typeOther Value
val
            )