Copyright | (c) David Johnson 2014 |
---|---|
Maintainer | djohnson.m@gmail.com |
Stability | experimental |
Portability | POSIX |
Safe Haskell | None |
Language | Haskell2010 |
https://stripe.com/docs/api#coupons
{-# LANGUAGE OverloadedStrings #-} import Web.Stripe import Web.Stripe.Coupon main :: IO () main = do let config = StripeConfig (StripeKey "secret_key") result <- stripe config $ createCoupon (Just $ CouponId "$1 Off!") Once -&- (AmountOff 1) -&- USD case result of Right coupon -> print coupon Left stripeError -> print stripeError
Synopsis
- data CreateCoupon
- createCoupon :: Maybe CouponId -> Duration -> StripeRequest CreateCoupon
- data GetCoupon
- getCoupon :: CouponId -> StripeRequest GetCoupon
- data UpdateCoupon
- updateCoupon :: CouponId -> StripeRequest UpdateCoupon
- data DeleteCoupon
- deleteCoupon :: CouponId -> StripeRequest DeleteCoupon
- data GetCoupons
- getCoupons :: StripeRequest GetCoupons
- newtype AmountOff = AmountOff Int
- data Coupon = Coupon {
- couponId :: CouponId
- couponCreated :: UTCTime
- couponPercentOff :: Maybe Int
- couponAmountOff :: Maybe Int
- couponCurrency :: Maybe Currency
- couponLiveMode :: Bool
- couponDuration :: Duration
- couponRedeemBy :: Maybe UTCTime
- couponMaxRedemptions :: Maybe Int
- couponTimesRedeemed :: Maybe Int
- couponDurationInMonths :: Maybe Int
- couponValid :: Bool
- couponMetaData :: MetaData
- newtype CouponId = CouponId Text
- data Currency
- = AED
- | AFN
- | ALL
- | AMD
- | ANG
- | AOA
- | ARS
- | AUD
- | AWG
- | AZN
- | BAM
- | BBD
- | BDT
- | BGN
- | BIF
- | BMD
- | BND
- | BOB
- | BRL
- | BSD
- | BWP
- | BZD
- | CAD
- | CDF
- | CHF
- | CLP
- | CNY
- | COP
- | CRC
- | CVE
- | CZK
- | DJF
- | DKK
- | DOP
- | DZD
- | EEK
- | EGP
- | ETB
- | EUR
- | FJD
- | FKP
- | GBP
- | GEL
- | GIP
- | GMD
- | GNF
- | GTQ
- | GYD
- | HKD
- | HNL
- | HRK
- | HTG
- | HUF
- | IDR
- | ILS
- | INR
- | ISK
- | JMD
- | JPY
- | KES
- | KGS
- | KHR
- | KMF
- | KRW
- | KYD
- | KZT
- | LAK
- | LBP
- | LKR
- | LRD
- | LSL
- | LTL
- | LVL
- | MAD
- | MDL
- | MGA
- | MKD
- | MNT
- | MOP
- | MRO
- | MUR
- | MVR
- | MWK
- | MXN
- | MYR
- | MZN
- | NAD
- | NGN
- | NIO
- | NOK
- | NPR
- | NZD
- | PAB
- | PEN
- | PGK
- | PHP
- | PKR
- | PLN
- | PYG
- | QAR
- | RON
- | RSD
- | RUB
- | RWF
- | SAR
- | SBD
- | SCR
- | SEK
- | SGD
- | SHP
- | SLL
- | SOS
- | SRD
- | STD
- | SVC
- | SZL
- | THB
- | TJS
- | TOP
- | TRY
- | TTD
- | TWD
- | TZS
- | UAH
- | UGX
- | USD
- | UYU
- | UZS
- | VND
- | VUV
- | WST
- | XAF
- | XCD
- | XOF
- | XPF
- | YER
- | ZAR
- | ZMW
- | UnknownCurrency
- data Duration
- newtype DurationInMonths = DurationInMonths Int
- newtype EndingBefore a = EndingBefore a
- newtype Limit = Limit Int
- newtype MaxRedemptions = MaxRedemptions Int
- newtype MetaData = MetaData [(Text, Text)]
- newtype PercentOff = PercentOff Int
- newtype RedeemBy = RedeemBy UTCTime
- newtype StartingAfter a = StartingAfter a
- data StripeDeleteResult = StripeDeleteResult {}
- data StripeList a = StripeList {}
API
data CreateCoupon Source #
Instances
StripeHasParam CreateCoupon Currency Source # | |
Defined in Web.Stripe.Coupon | |
StripeHasParam CreateCoupon MetaData Source # | |
Defined in Web.Stripe.Coupon | |
StripeHasParam CreateCoupon DurationInMonths Source # | |
Defined in Web.Stripe.Coupon | |
StripeHasParam CreateCoupon RedeemBy Source # | |
Defined in Web.Stripe.Coupon | |
StripeHasParam CreateCoupon PercentOff Source # | |
Defined in Web.Stripe.Coupon | |
StripeHasParam CreateCoupon MaxRedemptions Source # | |
Defined in Web.Stripe.Coupon | |
StripeHasParam CreateCoupon AmountOff Source # | |
Defined in Web.Stripe.Coupon | |
type StripeReturn CreateCoupon Source # | |
Defined in Web.Stripe.Coupon |
:: Maybe CouponId | Name of the |
-> Duration | |
-> StripeRequest CreateCoupon |
Create Coupon
Instances
type StripeReturn GetCoupon Source # | |
Defined in Web.Stripe.Coupon |
Retrieve Coupon
data UpdateCoupon Source #
Instances
StripeHasParam UpdateCoupon MetaData Source # | |
Defined in Web.Stripe.Coupon | |
type StripeReturn UpdateCoupon Source # | |
Defined in Web.Stripe.Coupon |
:: CouponId | The |
-> StripeRequest UpdateCoupon |
Update Coupon
data DeleteCoupon Source #
Instances
type StripeReturn DeleteCoupon Source # | |
Defined in Web.Stripe.Coupon |
:: CouponId | The |
-> StripeRequest DeleteCoupon |
Delete Coupon
data GetCoupons Source #
Instances
StripeHasParam GetCoupons Limit Source # | |
Defined in Web.Stripe.Coupon | |
StripeHasParam GetCoupons (EndingBefore CouponId) Source # | |
Defined in Web.Stripe.Coupon | |
StripeHasParam GetCoupons (StartingAfter CouponId) Source # | |
Defined in Web.Stripe.Coupon | |
type StripeReturn GetCoupons Source # | |
Defined in Web.Stripe.Coupon |
getCoupons :: StripeRequest GetCoupons Source #
Retrieve a list of Coupon
s
Types
Instances
Eq AmountOff Source # | |
Data AmountOff Source # | |
Defined in Web.Stripe.Types gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> AmountOff -> c AmountOff # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c AmountOff # toConstr :: AmountOff -> Constr # dataTypeOf :: AmountOff -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c AmountOff) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AmountOff) # gmapT :: (forall b. Data b => b -> b) -> AmountOff -> AmountOff # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> AmountOff -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> AmountOff -> r # gmapQ :: (forall d. Data d => d -> u) -> AmountOff -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> AmountOff -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> AmountOff -> m AmountOff # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> AmountOff -> m AmountOff # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> AmountOff -> m AmountOff # | |
Ord AmountOff Source # | |
Defined in Web.Stripe.Types | |
Read AmountOff Source # | |
Show AmountOff Source # | |
ToStripeParam AmountOff Source # | |
Defined in Web.Stripe.StripeRequest toStripeParam :: AmountOff -> [(ByteString, ByteString)] -> [(ByteString, ByteString)] Source # | |
StripeHasParam CreateCoupon AmountOff Source # | |
Defined in Web.Stripe.Coupon |
Coupon
Object
Instances
Eq Coupon Source # | |
Data Coupon Source # | |
Defined in Web.Stripe.Types gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Coupon -> c Coupon # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Coupon # toConstr :: Coupon -> Constr # dataTypeOf :: Coupon -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Coupon) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Coupon) # gmapT :: (forall b. Data b => b -> b) -> Coupon -> Coupon # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Coupon -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Coupon -> r # gmapQ :: (forall d. Data d => d -> u) -> Coupon -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Coupon -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Coupon -> m Coupon # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Coupon -> m Coupon # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Coupon -> m Coupon # | |
Ord Coupon Source # | |
Read Coupon Source # | |
Show Coupon Source # | |
FromJSON Coupon Source # | JSON Instance for |
Instances
Stripe supports 138 currencies
AED | United Arab Emirates Dirham |
AFN | Afghan Afghani |
ALL | Albanian Lek |
AMD | Armenian Dram |
ANG | Netherlands Antillean Gulden |
AOA | Angolan Kwanza |
ARS | Argentine Peso |
AUD | Australian Dollar |
AWG | Aruban Florin |
AZN | Azerbaijani Manat |
BAM | Bosnia & Herzegovina Convertible Mark |
BBD | Barbadian Dollar |
BDT | Bangladeshi Taka |
BGN | Bulgarian Lev |
BIF | Burundian Franc |
BMD | Bermudian Dollar |
BND | Brunei Dollar |
BOB | Bolivian Boliviano |
BRL | Brazilian Real |
BSD | Bahamian Dollar |
BWP | Botswana Pula |
BZD | Belize Dollar |
CAD | Canadian Dollar |
CDF | Congolese Franc |
CHF | Swiss Franc |
CLP | Chilean Peso |
CNY | Chinese Renminbi Yuan |
COP | Colombian Peso |
CRC | Costa Rican Colón |
CVE | Cape Verdean Escudo |
CZK | Czech Koruna |
DJF | Djiboutian Franc |
DKK | Danish Krone |
DOP | Dominican Peso |
DZD | Algerian Dinar |
EEK | Estonian Kroon |
EGP | Egyptian Pound |
ETB | Ethiopian Birr |
EUR | Euro |
FJD | Fijian Dollar |
FKP | Falkland Islands Pound |
GBP | British Pound |
GEL | Georgian Lari |
GIP | Gibraltar Pound |
GMD | Gambian Dalasi |
GNF | Guinean Franc |
GTQ | Guatemalan Quetzal |
GYD | Guyanese Dollar |
HKD | Hong Kong Dollar |
HNL | Honduran Lempira |
HRK | Croatian Kuna |
HTG | Haitian Gourde |
HUF | Hungarian Forint |
IDR | Indonesian Rupiah |
ILS | Israeli New Sheqel |
INR | Indian Rupee |
ISK | Icelandic Króna |
JMD | Jamaican Dollar |
JPY | Japanese Yen |
KES | Kenyan Shilling |
KGS | Kyrgyzstani Som |
KHR | Cambodian Riel |
KMF | Comorian Franc |
KRW | South Korean Won |
KYD | Cayman Islands Dollar |
KZT | Kazakhstani Tenge |
LAK | Lao Kip |
LBP | Lebanese Pound |
LKR | Sri Lankan Rupee |
LRD | Liberian Dollar |
LSL | Lesotho Loti |
LTL | Lithuanian Litas |
LVL | Latvian Lats |
MAD | Moroccan Dirham |
MDL | Moldovan Leu |
MGA | Malagasy Ariary |
MKD | Macedonian Denar |
MNT | Mongolian Tögrög |
MOP | Macanese Pataca |
MRO | Mauritanian Ouguiya |
MUR | Mauritian Rupee |
MVR | Maldivian Rufiyaa |
MWK | Malawian Kwacha |
MXN | Mexican Peso |
MYR | Malaysian Ringgit |
MZN | Mozambican Metical |
NAD | Namibian Dollar |
NGN | Nigerian Naira |
NIO | Nicaraguan Córdoba |
NOK | Norwegian Krone |
NPR | Nepalese Rupee |
NZD | New Zealand Dollar |
PAB | Panamanian Balboa |
PEN | Peruvian Nuevo Sol |
PGK | Papua New Guinean Kina |
PHP | Philippine Peso |
PKR | Pakistani Rupee |
PLN | Polish Złoty |
PYG | Paraguayan Guaraní |
QAR | Qatari Riyal |
RON | Romanian Leu |
RSD | Serbian Dinar |
RUB | Russian Ruble |
RWF | Rwandan Franc |
SAR | Saudi Riyal |
SBD | Solomon Islands Dollar |
SCR | Seychellois Rupee |
SEK | Swedish Krona |
SGD | Singapore Dollar |
SHP | Saint Helenian Pound |
SLL | Sierra Leonean Leone |
SOS | Somali Shilling |
SRD | Surinamese Dollar |
STD | São Tomé and Príncipe Dobra |
SVC | Salvadoran Colón |
SZL | Swazi Lilangeni |
THB | Thai Baht |
TJS | Tajikistani Somoni |
TOP | Tongan Paʻanga |
TRY | Turkish Lira |
TTD | Trinidad and Tobago Dollar |
TWD | New Taiwan Dollar |
TZS | Tanzanian Shilling |
UAH | Ukrainian Hryvnia |
UGX | Ugandan Shilling |
USD | United States Dollar |
UYU | Uruguayan Peso |
UZS | Uzbekistani Som |
VND | Vietnamese Đồng |
VUV | Vanuatu Vatu |
WST | Samoan Tala |
XAF | Central African Cfa Franc |
XCD | East Caribbean Dollar |
XOF | West African Cfa Franc |
XPF | Cfp Franc |
YER | Yemeni Rial |
ZAR | South African Rand |
ZMW | Zambian Kwacha |
UnknownCurrency | Unknown Currency |
Instances
Eq Currency Source # | |
Data Currency Source # | |
Defined in Web.Stripe.Types gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Currency -> c Currency # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Currency # toConstr :: Currency -> Constr # dataTypeOf :: Currency -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Currency) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Currency) # gmapT :: (forall b. Data b => b -> b) -> Currency -> Currency # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Currency -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Currency -> r # gmapQ :: (forall d. Data d => d -> u) -> Currency -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Currency -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Currency -> m Currency # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Currency -> m Currency # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Currency -> m Currency # | |
Ord Currency Source # | |
Defined in Web.Stripe.Types | |
Read Currency Source # | |
Show Currency Source # | |
FromJSON Currency Source # |
|
ToStripeParam Currency Source # | |
Defined in Web.Stripe.StripeRequest toStripeParam :: Currency -> [(ByteString, ByteString)] -> [(ByteString, ByteString)] Source # | |
StripeHasParam CreateCoupon Currency Source # | |
Defined in Web.Stripe.Coupon | |
StripeHasParam GetBalanceTransactionHistory Currency Source # | |
Defined in Web.Stripe.Balance |
Coupon
Duration
Instances
Eq Duration Source # | |
Data Duration Source # | |
Defined in Web.Stripe.Types gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Duration -> c Duration # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Duration # toConstr :: Duration -> Constr # dataTypeOf :: Duration -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Duration) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Duration) # gmapT :: (forall b. Data b => b -> b) -> Duration -> Duration # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Duration -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Duration -> r # gmapQ :: (forall d. Data d => d -> u) -> Duration -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Duration -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Duration -> m Duration # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Duration -> m Duration # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Duration -> m Duration # | |
Ord Duration Source # | |
Defined in Web.Stripe.Types | |
Read Duration Source # | |
Show Duration Source # | |
FromJSON Duration Source # | JSON Instance for |
ToStripeParam Duration Source # | |
Defined in Web.Stripe.StripeRequest toStripeParam :: Duration -> [(ByteString, ByteString)] -> [(ByteString, ByteString)] Source # |
newtype DurationInMonths Source #
DurationInMonths
for a Coupon
Instances
newtype EndingBefore a Source #
Pagination Option for StripeList
Instances
Pagination Option for StripeList
Instances
newtype MaxRedemptions Source #
MaxRedemptions
for a Coupon
Instances
Type of MetaData for use on Stripe
objects
Instances
newtype PercentOff Source #
PercentOff
for a Coupon
Instances
Instances
Eq RedeemBy Source # | |
Data RedeemBy Source # | |
Defined in Web.Stripe.Types gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> RedeemBy -> c RedeemBy # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c RedeemBy # toConstr :: RedeemBy -> Constr # dataTypeOf :: RedeemBy -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c RedeemBy) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RedeemBy) # gmapT :: (forall b. Data b => b -> b) -> RedeemBy -> RedeemBy # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> RedeemBy -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> RedeemBy -> r # gmapQ :: (forall d. Data d => d -> u) -> RedeemBy -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> RedeemBy -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> RedeemBy -> m RedeemBy # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> RedeemBy -> m RedeemBy # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> RedeemBy -> m RedeemBy # | |
Ord RedeemBy Source # | |
Defined in Web.Stripe.Types | |
Read RedeemBy Source # | |
Show RedeemBy Source # | |
ToStripeParam RedeemBy Source # | |
Defined in Web.Stripe.StripeRequest toStripeParam :: RedeemBy -> [(ByteString, ByteString)] -> [(ByteString, ByteString)] Source # | |
StripeHasParam CreateCoupon RedeemBy Source # | |
Defined in Web.Stripe.Coupon |
newtype StartingAfter a Source #
Pagination Option for StripeList
Instances
data StripeDeleteResult Source #
JSON returned from a Stripe
deletion request
Instances
data StripeList a Source #
Generic handling of Stripe JSON arrays