Copyright | (c) David Johnson 2014 |
---|---|
Maintainer | djohnson.m@gmail.com |
Stability | experimental |
Portability | POSIX |
Safe Haskell | None |
Language | Haskell2010 |
Web.Stripe.Invoice
Description
https://stripe.com/docs/api#invoices
{-# LANGUAGE OverloadedStrings #-} import Web.Stripe import Web.Stripe.Customer import Web.Stripe.Invoice import Web.Stripe.InvoiceItem import Web.Stripe.Plan main :: IO () main = do let config = StripeConfig (SecretKey "secret_key") result <- stripe config createCustomer case result of (Left stripeError) -> print stripeError (Right (Customer { customerId = cid })) -> do result <- stripe config $ createPlan (PlanId "planid") (Amount 20) USD Day (PlanName "testplan") case result of (Left stripeError) -> print stripeError (Right (Plan {})) -> do result <- stripe config $ createInvoiceItem cid (Amount 100) USD case result of (Left stripeError) -> print stripeError (Right invoiceItem) -> do result <- stripe config $ createInvoice cid case result of (Left stripeError) -> print stripeError (Right invoice) -> print invoice
Synopsis
- data CreateInvoice
- createInvoice :: CustomerId -> StripeRequest CreateInvoice
- data GetInvoice
- getInvoice :: InvoiceId -> StripeRequest GetInvoice
- data GetInvoiceLineItems
- getInvoiceLineItems :: InvoiceId -> StripeRequest GetInvoiceLineItems
- data GetUpcomingInvoice
- getUpcomingInvoice :: CustomerId -> StripeRequest GetUpcomingInvoice
- data UpdateInvoice
- updateInvoice :: InvoiceId -> StripeRequest UpdateInvoice
- data PayInvoice
- payInvoice :: InvoiceId -> StripeRequest PayInvoice
- data GetInvoices
- getInvoices :: StripeRequest GetInvoices
- newtype ApplicationFeeId = ApplicationFeeId Text
- newtype Closed = Closed {}
- newtype CustomerId = CustomerId Text
- newtype Description = Description Text
- data Discount = Discount {}
- newtype EndingBefore a = EndingBefore a
- newtype ExpandParams = ExpandParams {
- getExpandParams :: [Text]
- newtype Forgiven = Forgiven {
- getForgiven :: Bool
- data Invoice = Invoice {
- invoiceDate :: UTCTime
- invoiceId :: Maybe InvoiceId
- invoicePeriodStart :: UTCTime
- invoicePeriodEnd :: UTCTime
- invoiceLineItems :: StripeList InvoiceLineItem
- invoiceSubTotal :: Int
- invoiceTotal :: Int
- invoiceCustomer :: Expandable CustomerId
- invoiceObject :: Text
- invoiceAttempted :: Bool
- invoiceClosed :: Bool
- invoiceForgiven :: Bool
- invoicePaid :: Bool
- invoiceLiveMode :: Bool
- invoiceAttemptCount :: Int
- invoiceAmountDue :: Int
- invoiceCurrency :: Currency
- invoiceStartingBalance :: Int
- invoiceEndingBalance :: Maybe Int
- invoiceNextPaymentAttempt :: Maybe UTCTime
- invoiceWebHooksDeliveredAt :: Maybe UTCTime
- invoiceCharge :: Maybe (Expandable ChargeId)
- invoiceDiscount :: Maybe Discount
- invoiceApplicateFee :: Maybe FeeId
- invoiceSubscription :: Maybe SubscriptionId
- invoiceStatementDescription :: Maybe StatementDescription
- invoiceDescription :: Maybe Description
- invoiceMetaData :: MetaData
- newtype InvoiceId = InvoiceId Text
- data InvoiceLineItem = InvoiceLineItem {
- invoiceLineItemId :: InvoiceLineItemId
- invoiceLineItemObject :: Text
- invoiceLineItemType :: InvoiceLineItemType
- invoiceLineItemLiveMode :: Bool
- invoiceLineItemAmount :: Int
- invoiceLineItemCurrency :: Currency
- invoiceLineItemProration :: Bool
- invoiceLineItemPeriod :: Period
- invoiceLineItemQuantity :: Maybe Quantity
- invoiceLineItemPlan :: Maybe Plan
- invoiceLineItemDescription :: Maybe Description
- invoiceLineItemMetaData :: MetaData
- newtype InvoiceLineItemId = InvoiceLineItemId Text
- data InvoiceLineItemType
- newtype Limit = Limit Int
- newtype MetaData = MetaData [(Text, Text)]
- data Period = Period {}
- newtype StatementDescription = StatementDescription Text
- newtype StartingAfter a = StartingAfter a
- data StripeList a = StripeList {}
- newtype SubscriptionId = SubscriptionId {}
API
data CreateInvoice Source #
Instances
StripeHasParam CreateInvoice Description Source # | |
Defined in Web.Stripe.Invoice | |
StripeHasParam CreateInvoice MetaData Source # | |
Defined in Web.Stripe.Invoice | |
StripeHasParam CreateInvoice ApplicationFeeId Source # | |
Defined in Web.Stripe.Invoice | |
StripeHasParam CreateInvoice SubscriptionId Source # | |
Defined in Web.Stripe.Invoice | |
StripeHasParam CreateInvoice StatementDescription Source # | |
Defined in Web.Stripe.Invoice | |
type StripeReturn CreateInvoice Source # | |
Defined in Web.Stripe.Invoice |
Arguments
:: CustomerId |
|
-> StripeRequest CreateInvoice |
The Invoice
to be created for a Customer
data GetInvoice Source #
Instances
StripeHasParam GetInvoice ExpandParams Source # | |
Defined in Web.Stripe.Invoice | |
type StripeReturn GetInvoice Source # | |
Defined in Web.Stripe.Invoice |
Arguments
:: InvoiceId | |
-> StripeRequest GetInvoice |
data GetInvoiceLineItems Source #
Instances
StripeHasParam GetInvoiceLineItems Limit Source # | |
Defined in Web.Stripe.Invoice | |
StripeHasParam GetInvoiceLineItems SubscriptionId Source # | |
Defined in Web.Stripe.Invoice | |
StripeHasParam GetInvoiceLineItems CustomerId Source # | |
Defined in Web.Stripe.Invoice | |
StripeHasParam GetInvoiceLineItems (EndingBefore InvoiceLineItemId) Source # | |
Defined in Web.Stripe.Invoice | |
StripeHasParam GetInvoiceLineItems (StartingAfter InvoiceLineItemId) Source # | |
Defined in Web.Stripe.Invoice | |
type StripeReturn GetInvoiceLineItems Source # | |
Defined in Web.Stripe.Invoice |
Arguments
:: InvoiceId | |
-> StripeRequest GetInvoiceLineItems |
Retrieve an InvoiceLineItem
s by InvoiceId
data GetUpcomingInvoice Source #
Instances
StripeHasParam GetUpcomingInvoice SubscriptionId Source # | |
Defined in Web.Stripe.Invoice | |
type StripeReturn GetUpcomingInvoice Source # | |
Defined in Web.Stripe.Invoice |
Arguments
:: CustomerId | |
-> StripeRequest GetUpcomingInvoice |
Retrieve an upcoming Invoice
for a Customer
by CustomerId
data UpdateInvoice Source #
Instances
StripeHasParam UpdateInvoice Description Source # | |
Defined in Web.Stripe.Invoice | |
StripeHasParam UpdateInvoice MetaData Source # | |
Defined in Web.Stripe.Invoice | |
StripeHasParam UpdateInvoice ApplicationFeeId Source # | |
Defined in Web.Stripe.Invoice | |
StripeHasParam UpdateInvoice Forgiven Source # | |
Defined in Web.Stripe.Invoice | |
StripeHasParam UpdateInvoice Closed Source # | |
Defined in Web.Stripe.Invoice | |
StripeHasParam UpdateInvoice StatementDescription Source # | |
Defined in Web.Stripe.Invoice | |
type StripeReturn UpdateInvoice Source # | |
Defined in Web.Stripe.Invoice |
Arguments
:: InvoiceId | |
-> StripeRequest UpdateInvoice |
data PayInvoice Source #
Instances
type StripeReturn PayInvoice Source # | |
Defined in Web.Stripe.Invoice |
Arguments
:: InvoiceId | |
-> StripeRequest PayInvoice |
data GetInvoices Source #
Instances
StripeHasParam GetInvoices ExpandParams Source # | |
Defined in Web.Stripe.Invoice | |
StripeHasParam GetInvoices Limit Source # | |
Defined in Web.Stripe.Invoice | |
StripeHasParam GetInvoices (EndingBefore InvoiceId) Source # | |
Defined in Web.Stripe.Invoice | |
StripeHasParam GetInvoices (StartingAfter InvoiceId) Source # | |
Defined in Web.Stripe.Invoice | |
type StripeReturn GetInvoices Source # | |
Defined in Web.Stripe.Invoice |
getInvoices :: StripeRequest GetInvoices Source #
Retrieve a StripeList
of Invoice
s
Types
newtype ApplicationFeeId Source #
Constructors
ApplicationFeeId Text |
Instances
Closed
- invoice closed or not
Instances
Eq Closed Source # | |
Data Closed Source # | |
Defined in Web.Stripe.Types Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Closed -> c Closed # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Closed # toConstr :: Closed -> Constr # dataTypeOf :: Closed -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Closed) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Closed) # gmapT :: (forall b. Data b => b -> b) -> Closed -> Closed # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Closed -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Closed -> r # gmapQ :: (forall d. Data d => d -> u) -> Closed -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Closed -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Closed -> m Closed # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Closed -> m Closed # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Closed -> m Closed # | |
Ord Closed Source # | |
Read Closed Source # | |
Show Closed Source # | |
ToStripeParam Closed Source # | |
Defined in Web.Stripe.StripeRequest Methods toStripeParam :: Closed -> [(ByteString, ByteString)] -> [(ByteString, ByteString)] Source # | |
StripeHasParam UpdateInvoice Closed Source # | |
Defined in Web.Stripe.Invoice |
newtype CustomerId Source #
CustomerId
for a Customer
Constructors
CustomerId Text |
Instances
newtype Description Source #
Generic Description for use in constructing API Calls
Constructors
Description Text |
Instances
Constructors
Discount | |
Instances
Eq Discount Source # | |
Data Discount Source # | |
Defined in Web.Stripe.Types Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Discount -> c Discount # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Discount # toConstr :: Discount -> Constr # dataTypeOf :: Discount -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Discount) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Discount) # gmapT :: (forall b. Data b => b -> b) -> Discount -> Discount # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Discount -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Discount -> r # gmapQ :: (forall d. Data d => d -> u) -> Discount -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Discount -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Discount -> m Discount # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Discount -> m Discount # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Discount -> m Discount # | |
Ord Discount Source # | |
Defined in Web.Stripe.Types | |
Read Discount Source # | |
Show Discount Source # | |
FromJSON Discount Source # | JSON Instance for |
newtype EndingBefore a Source #
Pagination Option for StripeList
Constructors
EndingBefore a |
Instances
newtype ExpandParams Source #
Type of Expansion Parameters for use on Stripe
objects
Constructors
ExpandParams | |
Fields
|
Instances
Forgiven
- invoice forgiven or not
Constructors
Forgiven | |
Fields
|
Instances
Eq Forgiven Source # | |
Data Forgiven Source # | |
Defined in Web.Stripe.Types Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Forgiven -> c Forgiven # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Forgiven # toConstr :: Forgiven -> Constr # dataTypeOf :: Forgiven -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Forgiven) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Forgiven) # gmapT :: (forall b. Data b => b -> b) -> Forgiven -> Forgiven # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Forgiven -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Forgiven -> r # gmapQ :: (forall d. Data d => d -> u) -> Forgiven -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Forgiven -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Forgiven -> m Forgiven # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Forgiven -> m Forgiven # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Forgiven -> m Forgiven # | |
Ord Forgiven Source # | |
Defined in Web.Stripe.Types | |
Read Forgiven Source # | |
Show Forgiven Source # | |
ToStripeParam Forgiven Source # | |
Defined in Web.Stripe.StripeRequest Methods toStripeParam :: Forgiven -> [(ByteString, ByteString)] -> [(ByteString, ByteString)] Source # | |
StripeHasParam UpdateInvoice Forgiven Source # | |
Defined in Web.Stripe.Invoice |
Invoice
Object
Constructors
Invoice | |
Fields
|
Instances
Eq Invoice Source # | |
Data Invoice Source # | |
Defined in Web.Stripe.Types Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Invoice -> c Invoice # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Invoice # toConstr :: Invoice -> Constr # dataTypeOf :: Invoice -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Invoice) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Invoice) # gmapT :: (forall b. Data b => b -> b) -> Invoice -> Invoice # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Invoice -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Invoice -> r # gmapQ :: (forall d. Data d => d -> u) -> Invoice -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Invoice -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Invoice -> m Invoice # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Invoice -> m Invoice # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Invoice -> m Invoice # | |
Ord Invoice Source # | |
Read Invoice Source # | |
Show Invoice Source # | |
FromJSON Invoice Source # | JSON Instance for |
Instances
data InvoiceLineItem Source #
InvoiceLineItem
Object
Constructors
Instances
newtype InvoiceLineItemId Source #
InvoiceLineItemId
for an InvoiceLineItem
Constructors
InvoiceLineItemId Text |
Instances
data InvoiceLineItemType Source #
Type of InvoiceItem
Constructors
InvoiceItemType | |
SubscriptionItemType |
Instances
Pagination Option for StripeList
Instances
Type of MetaData for use on Stripe
objects
Instances
Period for an InvoiceLineItem
Instances
Eq Period Source # | |
Data Period Source # | |
Defined in Web.Stripe.Types Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Period -> c Period # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Period # toConstr :: Period -> Constr # dataTypeOf :: Period -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Period) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Period) # gmapT :: (forall b. Data b => b -> b) -> Period -> Period # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Period -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Period -> r # gmapQ :: (forall d. Data d => d -> u) -> Period -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Period -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Period -> m Period # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Period -> m Period # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Period -> m Period # | |
Ord Period Source # | |
Read Period Source # | |
Show Period Source # | |
FromJSON Period Source # | JSON Instance for |
newtype StatementDescription Source #
StatementDescription
to be added to a Charge
Constructors
StatementDescription Text |
Instances
newtype StartingAfter a Source #
Pagination Option for StripeList
Constructors
StartingAfter a |
Instances
data StripeList a Source #
Generic handling of Stripe JSON arrays
Constructors
StripeList | |
Instances
Eq a => Eq (StripeList a) Source # | |
Defined in Web.Stripe.Types | |
Data a => Data (StripeList a) Source # | |
Defined in Web.Stripe.Types Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> StripeList a -> c (StripeList a) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (StripeList a) # toConstr :: StripeList a -> Constr # dataTypeOf :: StripeList a -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (StripeList a)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (StripeList a)) # gmapT :: (forall b. Data b => b -> b) -> StripeList a -> StripeList a # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> StripeList a -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> StripeList a -> r # gmapQ :: (forall d. Data d => d -> u) -> StripeList a -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> StripeList a -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> StripeList a -> m (StripeList a) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> StripeList a -> m (StripeList a) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> StripeList a -> m (StripeList a) # | |
Ord a => Ord (StripeList a) Source # | |
Defined in Web.Stripe.Types Methods compare :: StripeList a -> StripeList a -> Ordering # (<) :: StripeList a -> StripeList a -> Bool # (<=) :: StripeList a -> StripeList a -> Bool # (>) :: StripeList a -> StripeList a -> Bool # (>=) :: StripeList a -> StripeList a -> Bool # max :: StripeList a -> StripeList a -> StripeList a # min :: StripeList a -> StripeList a -> StripeList a # | |
Read a => Read (StripeList a) Source # | |
Defined in Web.Stripe.Types Methods readsPrec :: Int -> ReadS (StripeList a) # readList :: ReadS [StripeList a] # readPrec :: ReadPrec (StripeList a) # readListPrec :: ReadPrec [StripeList a] # | |
Show a => Show (StripeList a) Source # | |
Defined in Web.Stripe.Types Methods showsPrec :: Int -> StripeList a -> ShowS # show :: StripeList a -> String # showList :: [StripeList a] -> ShowS # | |
FromJSON a => FromJSON (StripeList a) Source # | JSON Instance for |
Defined in Web.Stripe.Types Methods parseJSON :: Value -> Parser (StripeList a) # parseJSONList :: Value -> Parser [StripeList a] # |
newtype SubscriptionId Source #
SubscriptionId
for a Subscription
Constructors
SubscriptionId | |
Fields |