Copyright | (c) David Johnson 2014 |
---|---|
Maintainer | djohnson.m@gmail.com |
Stability | experimental |
Portability | POSIX |
Safe Haskell | None |
Language | Haskell2010 |
https://stripe.com/docs/api#cards
{-# LANGUAGE OverloadedStrings #-} import Web.Stripe import Web.Stripe.Customer import Web.Stripe.Card main :: IO () main = do let config = StripeConfig (StripeKey "secret_key") credit = CardNumber "4242424242424242" em = ExpMonth 12 ey = ExpYear 2015 cvc = CVC "123" cardinfo = (mkNewCard credit em ey) { newCardCVC = Just cvc } result <- stripe config $ createCustomer case result of (Left stripeError) -> print stripeError (Right (Customer { customerId = cid })) -> do result <- stripe config $ createCustomerCard cid cardinfo case result of Right card -> print card Left stripeError -> print stripeError
Synopsis
- data CreateCustomerCardByToken
- createCustomerCardByToken :: CustomerId -> TokenId -> StripeRequest CreateCustomerCardByToken
- data CreateRecipientCardByToken
- createRecipientCardByToken :: RecipientId -> TokenId -> StripeRequest CreateRecipientCardByToken
- data CreateCustomerCard
- createCustomerCard :: CustomerId -> NewCard -> StripeRequest CreateCustomerCard
- data CreateRecipientCard
- createRecipientCard :: RecipientId -> NewCard -> StripeRequest CreateRecipientCard
- data GetCustomerCard
- getCustomerCard :: CustomerId -> CardId -> StripeRequest GetCustomerCard
- data GetRecipientCard
- getRecipientCard :: RecipientId -> RecipientCardId -> StripeRequest GetRecipientCard
- data GetCustomerCards
- getCustomerCards :: CustomerId -> StripeRequest GetCustomerCards
- data GetRecipientCards
- getRecipientCards :: RecipientId -> StripeRequest GetRecipientCards
- data UpdateCustomerCard
- updateCustomerCard :: CustomerId -> CardId -> StripeRequest UpdateCustomerCard
- data UpdateRecipientCard
- updateRecipientCard :: RecipientId -> RecipientCardId -> StripeRequest UpdateRecipientCard
- data DeleteCustomerCard
- deleteCustomerCard :: CustomerId -> CardId -> StripeRequest DeleteCustomerCard
- data DeleteRecipientCard
- deleteRecipientCard :: RecipientId -> RecipientCardId -> StripeRequest DeleteRecipientCard
- newtype AddressLine1 = AddressLine1 Text
- newtype AddressLine2 = AddressLine2 Text
- newtype AddressCity = AddressCity Text
- newtype AddressCountry = AddressCountry Text
- newtype AddressState = AddressState Text
- newtype AddressZip = AddressZip Text
- data Brand
- = Visa
- | AMEX
- | MasterCard
- | Discover
- | JCB
- | DinersClub
- | Unknown
- data Card = Card {
- cardId :: CardId
- cardObject :: Text
- cardLastFour :: Text
- cardBrand :: Brand
- cardFunding :: Text
- cardExpMonth :: ExpMonth
- cardExpYear :: ExpYear
- cardFingerprint :: Maybe Text
- cardCountry :: Maybe Text
- cardName :: Maybe Name
- cardAddressLine1 :: Maybe AddressLine1
- cardAddressLine2 :: Maybe AddressLine2
- cardAddressCity :: Maybe AddressCity
- cardAddressState :: Maybe AddressState
- cardAddressZip :: Maybe AddressZip
- cardAddressCountry :: Maybe AddressCountry
- cardCVCCheck :: Maybe Text
- cardAddressLine1Check :: Maybe Text
- cardAddressZipCheck :: Maybe Text
- cardCustomerId :: Maybe (Expandable CustomerId)
- cardMetaData :: MetaData
- newtype CardId = CardId Text
- newtype CardNumber = CardNumber Text
- newtype CVC = CVC Text
- newtype EndingBefore a = EndingBefore a
- newtype ExpandParams = ExpandParams {
- getExpandParams :: [Text]
- newtype ExpMonth = ExpMonth Int
- newtype ExpYear = ExpYear Int
- newtype Limit = Limit Int
- newtype Name = Name {}
- data RecipientCard = RecipientCard {
- recipientCardId :: RecipientCardId
- recipientCardLastFour :: Text
- recipientCardBrand :: Brand
- recipientCardFunding :: Text
- recipientCardExpMonth :: ExpMonth
- recipientCardExpYear :: ExpYear
- recipientCardFingerprint :: Text
- recipientCardCountry :: Country
- recipientCardName :: Maybe Name
- recipientCardAddressLine1 :: Maybe AddressLine1
- recipientCardAddressLine2 :: Maybe AddressLine2
- recipientCardAddressCity :: Maybe AddressCity
- recipientCardAddressState :: Maybe AddressState
- recipientCardAddressZip :: Maybe AddressZip
- recipientCardAddressCountry :: Maybe AddressCountry
- recipientCardCVCCheck :: Maybe Text
- recipientCardAddressLine1Check :: Maybe Text
- recipientCardAddressZipCheck :: Maybe Text
- recipientCardRecipientId :: Maybe (Expandable RecipientId)
- newtype RecipientCardId = RecipientCardId Text
- newtype RecipientId = RecipientId Text
- newtype StartingAfter a = StartingAfter a
API
Customers
Create Card
data CreateCustomerCardByToken Source #
Instances
type StripeReturn CreateCustomerCardByToken Source # | |
Defined in Web.Stripe.Card |
createCustomerCardByToken Source #
:: CustomerId |
|
-> TokenId |
|
-> StripeRequest CreateCustomerCardByToken |
data CreateRecipientCardByToken Source #
Instances
type StripeReturn CreateRecipientCardByToken Source # | |
Defined in Web.Stripe.Card |
createRecipientCardByToken Source #
:: RecipientId |
|
-> TokenId |
|
-> StripeRequest CreateRecipientCardByToken |
data CreateCustomerCard Source #
Instances
type StripeReturn CreateCustomerCard Source # | |
Defined in Web.Stripe.Card |
:: CustomerId |
|
-> NewCard |
|
-> StripeRequest CreateCustomerCard |
Customer
Card
creation from card info
data CreateRecipientCard Source #
Instances
type StripeReturn CreateRecipientCard Source # | |
Defined in Web.Stripe.Card |
:: RecipientId |
|
-> NewCard |
|
-> StripeRequest CreateRecipientCard |
Recipient
Card
creation from card info
Get Card(s)
data GetCustomerCard Source #
Instances
StripeHasParam GetCustomerCard ExpandParams Source # | |
Defined in Web.Stripe.Card | |
type StripeReturn GetCustomerCard Source # | |
Defined in Web.Stripe.Card |
:: CustomerId |
|
-> CardId |
|
-> StripeRequest GetCustomerCard |
Get card by CustomerId
and CardId
data GetRecipientCard Source #
Instances
StripeHasParam GetRecipientCard ExpandParams Source # | |
Defined in Web.Stripe.Card | |
type StripeReturn GetRecipientCard Source # | |
Defined in Web.Stripe.Card |
:: RecipientId |
|
-> RecipientCardId |
|
-> StripeRequest GetRecipientCard |
Get card by RecipientId
and RecipientCardId
data GetCustomerCards Source #
Instances
StripeHasParam GetCustomerCards ExpandParams Source # | |
Defined in Web.Stripe.Card | |
StripeHasParam GetCustomerCards Limit Source # | |
Defined in Web.Stripe.Card | |
StripeHasParam GetCustomerCards (EndingBefore CardId) Source # | |
Defined in Web.Stripe.Card | |
StripeHasParam GetCustomerCards (StartingAfter CardId) Source # | |
Defined in Web.Stripe.Card | |
type StripeReturn GetCustomerCards Source # | |
Defined in Web.Stripe.Card |
:: CustomerId | The |
-> StripeRequest GetCustomerCards |
Retrieve all cards associated with a Customer
data GetRecipientCards Source #
Instances
StripeHasParam GetRecipientCards ExpandParams Source # | |
Defined in Web.Stripe.Card | |
StripeHasParam GetRecipientCards Limit Source # | |
Defined in Web.Stripe.Card | |
StripeHasParam GetRecipientCards (EndingBefore CardId) Source # | |
Defined in Web.Stripe.Card | |
StripeHasParam GetRecipientCards (StartingAfter CardId) Source # | |
Defined in Web.Stripe.Card | |
type StripeReturn GetRecipientCards Source # | |
Defined in Web.Stripe.Card |
:: RecipientId | The |
-> StripeRequest GetRecipientCards |
Retrieve all cards associated with a Recipient
Update Card
data UpdateCustomerCard Source #
Instances
StripeHasParam UpdateCustomerCard Name Source # | |
Defined in Web.Stripe.Card | |
StripeHasParam UpdateCustomerCard AddressZip Source # | |
Defined in Web.Stripe.Card | |
StripeHasParam UpdateCustomerCard AddressState Source # | |
Defined in Web.Stripe.Card | |
StripeHasParam UpdateCustomerCard AddressLine2 Source # | |
Defined in Web.Stripe.Card | |
StripeHasParam UpdateCustomerCard AddressLine1 Source # | |
Defined in Web.Stripe.Card | |
StripeHasParam UpdateCustomerCard AddressCountry Source # | |
Defined in Web.Stripe.Card | |
StripeHasParam UpdateCustomerCard AddressCity Source # | |
Defined in Web.Stripe.Card | |
StripeHasParam UpdateCustomerCard ExpYear Source # | |
Defined in Web.Stripe.Card | |
StripeHasParam UpdateCustomerCard ExpMonth Source # | |
Defined in Web.Stripe.Card | |
type StripeReturn UpdateCustomerCard Source # | |
Defined in Web.Stripe.Card |
:: CustomerId |
|
-> CardId |
|
-> StripeRequest UpdateCustomerCard |
Update a Customer
Card
data UpdateRecipientCard Source #
Instances
StripeHasParam UpdateRecipientCard Name Source # | |
Defined in Web.Stripe.Card | |
StripeHasParam UpdateRecipientCard AddressZip Source # | |
Defined in Web.Stripe.Card | |
StripeHasParam UpdateRecipientCard AddressState Source # | |
Defined in Web.Stripe.Card | |
StripeHasParam UpdateRecipientCard AddressLine2 Source # | |
Defined in Web.Stripe.Card | |
StripeHasParam UpdateRecipientCard AddressLine1 Source # | |
Defined in Web.Stripe.Card | |
StripeHasParam UpdateRecipientCard AddressCountry Source # | |
Defined in Web.Stripe.Card | |
StripeHasParam UpdateRecipientCard AddressCity Source # | |
Defined in Web.Stripe.Card | |
StripeHasParam UpdateRecipientCard ExpYear Source # | |
Defined in Web.Stripe.Card | |
StripeHasParam UpdateRecipientCard ExpMonth Source # | |
Defined in Web.Stripe.Card | |
type StripeReturn UpdateRecipientCard Source # | |
Defined in Web.Stripe.Card |
:: RecipientId |
|
-> RecipientCardId |
|
-> StripeRequest UpdateRecipientCard |
Update a Recipient
Card
Delete Card
data DeleteCustomerCard Source #
Instances
type StripeReturn DeleteCustomerCard Source # | |
Defined in Web.Stripe.Card |
:: CustomerId |
|
-> CardId | |
-> StripeRequest DeleteCustomerCard |
Removes a Card
with from a Customer
data DeleteRecipientCard Source #
Instances
type StripeReturn DeleteRecipientCard Source # | |
Defined in Web.Stripe.Card |
:: RecipientId |
|
-> RecipientCardId | |
-> StripeRequest DeleteRecipientCard |
Removes a RecipientCard
with from a Recipient
Types
newtype AddressLine1 Source #
Address Line One for a Card
Instances
newtype AddressLine2 Source #
Address Line Two for a Card
Instances
newtype AddressCity Source #
City address for a Card
Instances
newtype AddressCountry Source #
Country address for a Card
Instances
newtype AddressState Source #
Address State for a Card
Instances
newtype AddressZip Source #
Address Zip Code for a Card
Instances
Credit / Debit Card Brand
Instances
Eq Brand Source # | |
Data Brand Source # | |
Defined in Web.Stripe.Types gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Brand -> c Brand # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Brand # dataTypeOf :: Brand -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Brand) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Brand) # gmapT :: (forall b. Data b => b -> b) -> Brand -> Brand # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Brand -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Brand -> r # gmapQ :: (forall d. Data d => d -> u) -> Brand -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Brand -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Brand -> m Brand # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Brand -> m Brand # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Brand -> m Brand # | |
Ord Brand Source # | |
Read Brand Source # | |
Show Brand Source # | |
FromJSON Brand Source # | JSON Instance for |
Card
Object
Instances
Eq Card Source # | |
Data Card Source # | |
Defined in Web.Stripe.Types gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Card -> c Card # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Card # dataTypeOf :: Card -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Card) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Card) # gmapT :: (forall b. Data b => b -> b) -> Card -> Card # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Card -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Card -> r # gmapQ :: (forall d. Data d => d -> u) -> Card -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Card -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Card -> m Card # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Card -> m Card # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Card -> m Card # | |
Ord Card Source # | |
Read Card Source # | |
Show Card Source # | |
FromJSON Card Source # | JSON Instance for |
CardId for a Customer
Instances
newtype CardNumber Source #
Number associated with a Card
Instances
CVC for a Card
Instances
Eq CVC Source # | |
Data CVC Source # | |
Defined in Web.Stripe.Types gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> CVC -> c CVC # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c CVC # dataTypeOf :: CVC -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c CVC) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CVC) # gmapT :: (forall b. Data b => b -> b) -> CVC -> CVC # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CVC -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CVC -> r # gmapQ :: (forall d. Data d => d -> u) -> CVC -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> CVC -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> CVC -> m CVC # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> CVC -> m CVC # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> CVC -> m CVC # | |
Ord CVC Source # | |
Read CVC Source # | |
Show CVC Source # | |
ToStripeParam CVC Source # | |
Defined in Web.Stripe.StripeRequest toStripeParam :: CVC -> [(ByteString, ByteString)] -> [(ByteString, ByteString)] Source # |
newtype EndingBefore a Source #
Pagination Option for StripeList
Instances
newtype ExpandParams Source #
Type of Expansion Parameters for use on Stripe
objects
Instances
Expiration Month for a Card
Instances
Eq ExpMonth Source # | |
Data ExpMonth Source # | |
Defined in Web.Stripe.Types gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ExpMonth -> c ExpMonth # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c ExpMonth # toConstr :: ExpMonth -> Constr # dataTypeOf :: ExpMonth -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c ExpMonth) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ExpMonth) # gmapT :: (forall b. Data b => b -> b) -> ExpMonth -> ExpMonth # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ExpMonth -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ExpMonth -> r # gmapQ :: (forall d. Data d => d -> u) -> ExpMonth -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> ExpMonth -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> ExpMonth -> m ExpMonth # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> ExpMonth -> m ExpMonth # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> ExpMonth -> m ExpMonth # | |
Ord ExpMonth Source # | |
Defined in Web.Stripe.Types | |
Read ExpMonth Source # | |
Show ExpMonth Source # | |
ToStripeParam ExpMonth Source # | |
Defined in Web.Stripe.StripeRequest toStripeParam :: ExpMonth -> [(ByteString, ByteString)] -> [(ByteString, ByteString)] Source # | |
StripeHasParam UpdateRecipientCard ExpMonth Source # | |
Defined in Web.Stripe.Card | |
StripeHasParam UpdateCustomerCard ExpMonth Source # | |
Defined in Web.Stripe.Card |
Expiration Year for a Card
Instances
Eq ExpYear Source # | |
Data ExpYear Source # | |
Defined in Web.Stripe.Types gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ExpYear -> c ExpYear # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c ExpYear # toConstr :: ExpYear -> Constr # dataTypeOf :: ExpYear -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c ExpYear) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ExpYear) # gmapT :: (forall b. Data b => b -> b) -> ExpYear -> ExpYear # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ExpYear -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ExpYear -> r # gmapQ :: (forall d. Data d => d -> u) -> ExpYear -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> ExpYear -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> ExpYear -> m ExpYear # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> ExpYear -> m ExpYear # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> ExpYear -> m ExpYear # | |
Ord ExpYear Source # | |
Read ExpYear Source # | |
Show ExpYear Source # | |
ToStripeParam ExpYear Source # | |
Defined in Web.Stripe.StripeRequest toStripeParam :: ExpYear -> [(ByteString, ByteString)] -> [(ByteString, ByteString)] Source # | |
StripeHasParam UpdateRecipientCard ExpYear Source # | |
Defined in Web.Stripe.Card | |
StripeHasParam UpdateCustomerCard ExpYear Source # | |
Defined in Web.Stripe.Card |
Pagination Option for StripeList
Instances
a cardholder's full name
Instances
Eq Name Source # | |
Data Name Source # | |
Defined in Web.Stripe.Types gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Name -> c Name # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Name # dataTypeOf :: Name -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Name) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Name) # gmapT :: (forall b. Data b => b -> b) -> Name -> Name # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Name -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Name -> r # gmapQ :: (forall d. Data d => d -> u) -> Name -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Name -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Name -> m Name # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Name -> m Name # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Name -> m Name # | |
Ord Name Source # | |
Read Name Source # | |
Show Name Source # | |
FromJSON Name Source # | |
ToStripeParam Name Source # | |
Defined in Web.Stripe.StripeRequest toStripeParam :: Name -> [(ByteString, ByteString)] -> [(ByteString, ByteString)] Source # | |
StripeHasParam UpdateRecipient Name Source # | |
Defined in Web.Stripe.Recipient | |
StripeHasParam UpdateRecipientCard Name Source # | |
Defined in Web.Stripe.Card | |
StripeHasParam UpdateCustomerCard Name Source # | |
Defined in Web.Stripe.Card |
data RecipientCard Source #
RecipientCard
object
Instances
newtype RecipientCardId Source #
CardId for a Recipient
Instances
newtype RecipientId Source #
RecipientId
for a Recipient
Instances
newtype StartingAfter a Source #
Pagination Option for StripeList