diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2014 David Johnson + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,4 @@ +#! /usr/bin/env runhaskell + +> import Distribution.Simple +> main = defaultMain diff --git a/src/Web/Stripe.hs b/src/Web/Stripe.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe.hs @@ -0,0 +1,27 @@ +------------------------------------------- +-- | +-- Module : Web.Stripe +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api > +-- +-- @ +-- import Web.Stripe +-- import Web.Stripe.Account +-- +-- main :: IO () +-- main = do +-- let config = SecretKey "secret_key" +-- result <- stripe config getAccountDetails +-- case result of +-- Right details -> print details +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe ( + module Web.Stripe.Client + ) where + +import Web.Stripe.Client diff --git a/src/Web/Stripe/Account.hs b/src/Web/Stripe/Account.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/Account.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE OverloadedStrings #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Account +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#account > +-- +-- @ +-- import Web.Stripe +-- import Web.Stripe.Account +-- +-- main :: IO () +-- main = do +-- let config = SecretKey "secret_key" +-- result <- stripe config getAccountDetails +-- case result of +-- Right accountId -> print accountId +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.Account + ( -- * API + getAccountDetails + -- * Types + , Account (..) + , AccountId (..) + ) where + +import Web.Stripe.Client.Internal ( Method (GET) + , Stripe + , StripeRequest (..) + , callAPI ) +import Web.Stripe.Types ( Account (..) + , AccountId (..) ) + +------------------------------------------------------------------------------ +-- | Retrieve the object that represents your Stripe account +getAccountDetails :: Stripe Account +getAccountDetails = callAPI request + where request = StripeRequest GET url params + url = "account" + params = [] diff --git a/src/Web/Stripe/ApplicationFee.hs b/src/Web/Stripe/ApplicationFee.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/ApplicationFee.hs @@ -0,0 +1,107 @@ +{-# LANGUAGE OverloadedStrings #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.AppplicationFee +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#application_fees > +-- +-- @ +-- import Web.Stripe +-- import Web.Stripe.ApplicationFee +-- +-- main :: IO () +-- main = do +-- let config = SecretKey "secret_key" +-- result <- stripe config $ getApplicationFee (FeeId "fee_4xtEGZhPNDEt3w") +-- case result of +-- Right ApplicationFee {..} -> print accountId +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.ApplicationFee + ( -- * API + getApplicationFee + , getApplicationFeeExpanded + , getApplicationFees + , getApplicationFeesExpanded + -- * Types + , ApplicationId (..) + , ApplicationFee (..) + , FeeId (..) + , StripeList (..) + , EndingBefore + , StartingAfter + , Limit + , ExpandParams + , ConnectApp (..) + ) where + +import Web.Stripe.Client.Internal (Method (GET), Stripe, + StripeRequest (..), callAPI, + getParams, toText, (), toExpandable) +import Web.Stripe.Types (ApplicationFee (..), + ApplicationId (..), ConnectApp (..), + EndingBefore, FeeId (..), + Limit, StartingAfter, ExpandParams, + StripeList (..)) + +------------------------------------------------------------------------------ +-- | 'ApplicationFee' retrieval +getApplicationFee + :: FeeId -- ^ The `FeeId` associated with the Application + -> Stripe ApplicationFee +getApplicationFee + feeid = getApplicationFeeExpanded feeid [] + +------------------------------------------------------------------------------ +-- | 'ApplicationFee' retrieval with `ExpandParams` +getApplicationFeeExpanded + :: FeeId -- ^ The `FeeId` associated with the application + -> ExpandParams -- ^ The `ExpandParams` for an `ApplicationFee` + -> Stripe ApplicationFee +getApplicationFeeExpanded + (FeeId feeid) + expandParams = callAPI request + where request = StripeRequest GET url params + url = "application_fees" feeid + params = toExpandable expandParams + +------------------------------------------------------------------------------ +-- | 'ApplicationFee's retrieval +getApplicationFees + :: Maybe Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter FeeId -- ^ Paginate starting after the following `FeeId` + -> EndingBefore FeeId -- ^ Paginate ending before the following `FeeId` + -> Stripe (StripeList ApplicationFee) +getApplicationFees + limit + startingAfter + endingBefore = + getApplicationFeesExpanded + limit startingAfter endingBefore [] + +------------------------------------------------------------------------------ +-- | 'ApplicationFee's retrieval with `ExpandParams` +getApplicationFeesExpanded + :: Maybe Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter FeeId -- ^ Paginate starting after the following `FeeId` + -> EndingBefore FeeId -- ^ Paginate ending before the following `FeeId` + -> ExpandParams -- ^ The `ExpandParams` for `ApplicationFee`s + -> Stripe (StripeList ApplicationFee) +getApplicationFeesExpanded + limit + startingAfter + endingBefore + expandParams = callAPI request + where request = StripeRequest GET url params + url = "application_fees" + params = getParams [ + ("limit", toText `fmap` limit ) + , ("starting_after", (\(FeeId x) -> x) `fmap` startingAfter) + , ("ending_before", (\(FeeId x) -> x) `fmap` endingBefore) + ] ++ toExpandable expandParams + + diff --git a/src/Web/Stripe/ApplicationFeeRefund.hs b/src/Web/Stripe/ApplicationFeeRefund.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/ApplicationFeeRefund.hs @@ -0,0 +1,151 @@ +{-# LANGUAGE OverloadedStrings #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.AppplicationFeeRefund +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#fee_refunds > +-- +-- @ +-- import Web.Stripe +-- import Web.Stripe.ApplicationFee +-- +-- main :: IO () +-- main = do +-- let config = SecretKey "secret_key" +-- result <- stripe config $ getApplicationFeeRefund (FeeId "fee_id") (RefundId "refund_id") +-- case result of +-- Right ApplicationFeeRefund {..} -> print applicationFeeRefundId +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.ApplicationFeeRefund + ( -- * API + createApplicationFeeRefund + , getApplicationFeeRefund + , getApplicationFeeRefundExpandable + , getApplicationFeeRefunds + , getApplicationFeeRefundsExpandable + , updateApplicationFeeRefund + -- * Types + , FeeId (..) + , RefundId (..) + , ApplicationFee (..) + , ApplicationFeeRefund (..) + , StripeList (..) + , EndingBefore + , StartingAfter + , Limit + , ExpandParams + , MetaData + , Amount + ) where + +import Web.Stripe.Client.Internal (Method (POST, GET), Stripe, + StripeRequest (..), callAPI, + getParams, toExpandable, + toMetaData, toText, ()) +import Web.Stripe.Types (Amount, ApplicationFee (..), + ApplicationFeeRefund (..), + EndingBefore, ExpandParams, + FeeId (..), Limit, MetaData, + RefundId (..), StartingAfter, + StripeList (..)) + +------------------------------------------------------------------------------ +-- | Create a new `ApplicationFeeRefund` +createApplicationFeeRefund + :: FeeId -- ^ The `FeeID` associated with the `ApplicationFee` + -> Maybe Amount -- ^ The `Amount` associated with the `ApplicationFee` (optional) + -> MetaData -- ^ The `MetaData` associated with the `ApplicationFee` (optional) + -> Stripe ApplicationFeeRefund +createApplicationFeeRefund + (FeeId feeid) + amount + metadata = callAPI request + where request = StripeRequest POST url params + url = "application_fees" feeid "refunds" + params = toMetaData metadata ++ getParams [ + ("amount", fmap toText amount) + ] + +------------------------------------------------------------------------------ +-- | Retrieve an existing 'ApplicationFeeRefund' +getApplicationFeeRefund + :: FeeId -- ^ The `FeeID` associated with the `ApplicationFee` + -> RefundId -- ^ The `ReufndId` associated with the `ApplicationFeeRefund` + -> Stripe ApplicationFeeRefund +getApplicationFeeRefund feeid refundid = + getApplicationFeeRefundExpandable feeid refundid [] + +------------------------------------------------------------------------------ +-- | Retrieve an existing 'ApplicationFeeRefund' +getApplicationFeeRefundExpandable + :: FeeId -- ^ The `FeeID` associated with the `ApplicationFee` + -> RefundId -- ^ The `ReufndId` associated with the `ApplicationFeeRefund` + -> ExpandParams -- ^ The `ExpandParams` to be used for object expansion + -> Stripe ApplicationFeeRefund +getApplicationFeeRefundExpandable (FeeId feeid) (RefundId refundid) expansion + = callAPI request + where request = StripeRequest GET url params + url = "application_fees" feeid "refunds" refundid + params = toExpandable expansion + +------------------------------------------------------------------------------ +-- | Retrieve a list of all 'ApplicationFeeRefund's for a given Application 'FeeId' +getApplicationFeeRefunds + :: FeeId -- ^ The `FeeID` associated with the application + -> Limit -- ^ `Limit` on how many `Refund`s to return (max 100, default 10) + -> StartingAfter FeeId -- ^ Lower bound on how many `Refund`s to return + -> EndingBefore FeeId -- ^ Upper bound on how many `Refund`s to return + -> Stripe (StripeList ApplicationFeeRefund) +getApplicationFeeRefunds + feeid + limit + startingAfter + endingBefore = + getApplicationFeeRefundsExpandable + feeid limit startingAfter endingBefore [] + +------------------------------------------------------------------------------ +-- | Retrieve a list of all 'ApplicationFeeRefund's for a given Application 'FeeId' +getApplicationFeeRefundsExpandable + :: FeeId -- ^ The `FeeID` associated with the `ApplicationFee` + -> Limit -- ^ Limit on how many Refunds to return (max 100, default 10) + -> StartingAfter FeeId -- ^ Lower bound on how many Refunds to return + -> EndingBefore FeeId -- ^ Upper bound on how many Refunds to return + -> ExpandParams -- ^ The `ExpandParams` to be used for object expansion + -> Stripe (StripeList ApplicationFeeRefund) +getApplicationFeeRefundsExpandable + (FeeId feeid) + limit + startingAfter + endingBefore + expandParams = callAPI request + where + request = StripeRequest GET url params + url = "application_fees" feeid "refunds" + params = getParams [ + ("limit", toText `fmap` limit ) + , ("starting_after", (\(FeeId x) -> x) `fmap` startingAfter) + , ("ending_before", (\(FeeId x) -> x) `fmap` endingBefore) + ] ++ toExpandable expandParams + +------------------------------------------------------------------------------ +-- | Update an `ApplicationFeeRefund` for a given Application `FeeId` and `RefundId` +updateApplicationFeeRefund + :: FeeId -- ^ The `FeeID` associated with the application + -> RefundId -- ^ The `RefundId` associated with the application + -> MetaData -- ^ The `MetaData` associated with the Fee (optional) + -> Stripe (StripeList ApplicationFeeRefund) +updateApplicationFeeRefund + (FeeId feeid) + (RefundId refundid) + metadata = callAPI request + where + request = StripeRequest GET url params + url = "application_fees" feeid "refunds" refundid + params = toMetaData metadata + diff --git a/src/Web/Stripe/Balance.hs b/src/Web/Stripe/Balance.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/Balance.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE OverloadedStrings #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Balance +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#balance > +-- +-- @ +-- import Web.Stripe +-- import Web.Stripe.Balance (getBalance) +-- +-- main :: IO () +-- main = do +-- let config = SecretKey "secret_key" +-- result <- stripe config getBalance +-- case result of +-- Right balance -> print balance +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.Balance + ( -- * API + getBalance + , getBalanceTransaction + , getBalanceTransactionExpandable + , getBalanceTransactionHistory + -- * Types + , Balance (..) + , TransactionId (..) + , StripeList (..) + , EndingBefore + , StartingAfter + , Limit + , BalanceTransaction + , BalanceAmount + ) where + +import Web.Stripe.Client.Internal (Method (GET), Stripe, + StripeRequest (..), callAPI, + getParams, toExpandable, toText, + ()) +import Web.Stripe.Types (Balance (..), BalanceAmount, + BalanceTransaction, EndingBefore, + ExpandParams, Limit, StartingAfter, + StripeList (..), + TransactionId (..)) +import Web.Stripe.Types.Util (getTransactionId) + +------------------------------------------------------------------------------ +-- | Retrieve the current `Balance` for your Stripe account +getBalance :: Stripe Balance +getBalance = callAPI request + where request = StripeRequest GET url params + url = "balance" + params = [] + +------------------------------------------------------------------------------ +-- | Retrieve a 'BalanceTransaction' by 'TransactionId' +getBalanceTransaction + :: TransactionId -- ^ The `TransactionId` of the `Transaction` to retrieve + -> Stripe BalanceTransaction +getBalanceTransaction + transactionid = getBalanceTransactionExpandable transactionid [] + +------------------------------------------------------------------------------ +-- | Retrieve a `BalanceTransaction` by `TransactionId` with `ExpandParams` +getBalanceTransactionExpandable + :: TransactionId -- ^ The `TransactionId` of the `Transaction` to retrieve + -> ExpandParams -- ^ The `ExpandParams` of the object to be expanded + -> Stripe BalanceTransaction +getBalanceTransactionExpandable + transactionid expandParams = callAPI request + where request = StripeRequest GET url params + url = "balance" "history" getTransactionId transactionid + params = toExpandable expandParams + +------------------------------------------------------------------------------ +-- | Retrieve the history of `BalanceTransaction`s +getBalanceTransactionHistory + :: Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter TransactionId -- ^ Paginate starting after the following `TransactionId` + -> EndingBefore TransactionId -- ^ Paginate ending before the following `TransactionId` + -> Stripe (StripeList BalanceTransaction) +getBalanceTransactionHistory + limit + startingAfter + endingBefore = callAPI request + where request = StripeRequest GET url params + url = "balance" "history" + params = getParams [ + ("limit", toText `fmap` limit ) + , ("starting_after", (\(TransactionId x) -> x) `fmap` startingAfter) + , ("ending_before", (\(TransactionId x) -> x) `fmap` endingBefore) + ] + diff --git a/src/Web/Stripe/Card.hs b/src/Web/Stripe/Card.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/Card.hs @@ -0,0 +1,481 @@ +{-# LANGUAGE OverloadedStrings #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Card +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#cards > +-- +-- @ +-- import Web.Stripe +-- import Web.Stripe.Customer +-- import Web.Stripe.Card +-- +-- main :: IO () +-- main = do +-- let config = SecretKey "secret_key" +-- credit = CardNumber "4242424242424242" +-- em = ExpMonth 12 +-- ey = ExpYear 2015 +-- cvc = CVC "123" +-- result <- stripe config $ do +-- Customer { customerId = cid } <- createEmptyCustomer +-- card <- createCustomerCard cid credit em ey cvc +-- return card +-- case result of +-- Right card -> print card +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.Card + ( -- * API + -- ** Customers + -- *** Create Customer Card + createCustomerCard + , createCustomerCardByToken + -- *** Get Customer Card(s) + , getCustomerCard + , getCustomerCardExpandable + , getCustomerCards + , getCustomerCardsExpandable + -- *** Update Customer Card + , updateCustomerCard + -- *** Delete Card + , deleteCustomerCard + -- ** Recipients + -- *** Create Recipient Card + , createRecipientCard + , createRecipientCardByToken + -- *** Get Recipient Card(s) + , getRecipientCard + , getRecipientCardExpandable + , getRecipientCards + , getRecipientCardsExpandable + -- *** Updated Recipient Card + , updateRecipientCard + -- *** Delete Recipient Card + , deleteRecipientCard + -- * Types + , Brand (..) + , Card (..) + , RecipientCard (..) + , CardId (..) + , RecipientCardId (..) + , CardNumber (..) + , ExpMonth (..) + , ExpYear (..) + , CVC (..) + , Name + , AddressLine1 (..) + , AddressLine2 (..) + , AddressCity (..) + , AddressCountry (..) + , AddressState (..) + , AddressZip (..) + , RecipientId (..) + ) where + +import Control.Applicative ((<$>)) +import Data.Aeson (FromJSON) +import Web.Stripe.Client.Internal +import Web.Stripe.Types +import Web.Stripe.Types.Util + +------------------------------------------------------------------------------ +-- | Base request function for `Card` creation, good for making custom create `Card` functions +createCardBase + :: FromJSON a + => URL -- ^ The `Recipient` or `Customer` on which to make the `Card` value can be "recipients" or "customers" only + -> ID -- ^ The `RecipientId` or `CustomerId` for which the `Card` can be made + -> Maybe TokenId -- ^ The `TokenId` to be used for `Card` creation + -> Maybe CardNumber -- ^ `CardNumber` for `Card` creation + -> Maybe ExpMonth -- ^ Expiration Month for `Card` creation + -> Maybe ExpYear -- ^ Expiration Year for `Card` creation + -> Maybe CVC -- ^ CVC for `Card` creation + -> Maybe Name -- ^ Name of `Recipient` or `Customer` to be used for `Card` + -> Maybe AddressCity -- ^ City associated with `Card` + -> Maybe AddressCountry -- ^ Country associated with `Card` + -> Maybe AddressLine1 -- ^ Address Line 1 associated with `Card` + -> Maybe AddressLine2 -- ^ Address Line 2 associated with `Card` + -> Maybe AddressState -- ^ Address State 2 associated with `Card` + -> Maybe AddressZip -- ^ Address Zip associated with `Card` + -> Stripe a +createCardBase + requestType + requestId + tokenid + cardNumber + expMonth + expYear + cvc + name + addressCity + addressCountry + addressLine1 + addressLine2 + addressState + addressZip = callAPI request + where request = StripeRequest POST url params + url = requestType requestId "cards" + params = getParams [ + ("card", (\(TokenId x) -> x) <$> tokenid) + , ("card[number]", (\(CardNumber x) -> x) <$> cardNumber) + , ("card[exp_month]", (\(ExpMonth x) -> toText x) <$> expMonth) + , ("card[exp_year]", (\(ExpYear x) -> toText x) <$> expYear) + , ("card[cvc]", (\(CVC x) -> x) <$> cvc) + , ("name", name) + , ("address_city", (\(AddressCity x) -> x) <$> addressCity) + , ("address_country", (\(AddressCountry x) -> x) <$> addressCountry) + , ("address_line1", (\(AddressLine1 x) -> x) <$> addressLine1 ) + , ("address_line2", (\(AddressLine2 x) -> x) <$> addressLine2 ) + , ("address_state", (\(AddressState x) -> x) <$> addressState ) + , ("address_zip", (\(AddressZip x) -> x) <$> addressZip ) + ] + +------------------------------------------------------------------------------ +-- | Create a `Customer` card using a `Token` +createCustomerCardByToken + :: CustomerId -- ^ The Customer to which the card will be added + -> TokenId -- ^ The Token representative of the card + -> Stripe Card +createCustomerCardByToken + customerid + tokenid = createCardBase "customers" (getCustomerId customerid) (Just tokenid) + Nothing Nothing Nothing + Nothing Nothing Nothing + Nothing Nothing Nothing + Nothing Nothing + +------------------------------------------------------------------------------ +-- | Create a `Recipient` card using a `Token` +createRecipientCardByToken + :: RecipientId -- ^ The Customer to which the card will be added + -> TokenId -- ^ The Token representative of the card + -> Stripe RecipientCard +createRecipientCardByToken + recipientid + tokenid = createCardBase "recipients" (getRecipientId recipientid) (Just tokenid) + Nothing Nothing Nothing + Nothing Nothing Nothing + Nothing Nothing Nothing + Nothing Nothing + +------------------------------------------------------------------------------ +-- | Add a `Card` on a `Customer` +createCustomerCard + :: CustomerId -- ^ `Customer` to which the card will be added + -> CardNumber -- ^ `Card` digits + -> ExpMonth -- ^ `Card` expiration month + -> ExpYear -- ^ `Card` expiration year + -> CVC -- ^ `Card` cvc number + -> Stripe Card +createCustomerCard + customerid + cardNumber + expMonth + expYear + cvc = createCardBase "customers" (getCustomerId customerid) Nothing + (Just cardNumber) (Just expMonth) (Just expYear) + (Just cvc) Nothing Nothing + Nothing Nothing Nothing + Nothing Nothing + +------------------------------------------------------------------------------ +-- | Create a `Recipient` `Card` by `CardNumber` +createRecipientCard + :: RecipientId -- ^ `Recipient` to which the card will be added + -> CardNumber -- ^ `Card` digits + -> ExpMonth -- ^ `Card` expiration month + -> ExpYear -- ^ `Card` expiration year + -> CVC -- ^ `Card` cvc number + -> Stripe RecipientCard +createRecipientCard + recipientid + cardNumber + expMonth + expYear + cvc = createCardBase "recipients" (getRecipientId recipientid) Nothing + (Just cardNumber) (Just expMonth) (Just expYear) + (Just cvc) Nothing Nothing + Nothing Nothing Nothing + Nothing Nothing + +------------------------------------------------------------------------------ +-- | Update a `Card`, any fields not specified will remain the same +updateCardBase + :: FromJSON a + => URL -- ^ The `Recipient` or `Customer` on which to make the `Card` value can be "recipients" or "customers" only + -> ID -- ^ The `RecipientId` or `CustomerId` for which the `Card` can be made + -> Either CardId RecipientCardId -- ^ The `CardId` associated with the `Card` to be updated + -> Maybe Name -- ^ Name of `Recipient` or `Customer` to be used for `Card` + -> Maybe AddressCity -- ^ City associated with `Card` + -> Maybe AddressCountry -- ^ Country associated with `Card` + -> Maybe AddressLine1 -- ^ Address Line 1 associated with `Card` + -> Maybe AddressLine2 -- ^ Address Line 2 associated with `Card` + -> Maybe AddressState -- ^ Address State 2 associated with `Card` + -> Maybe AddressZip -- ^ Address Zip associated with `Card` + -> Stripe a +updateCardBase + requestType + requestId + cardid + name + addressCity + addressCountry + addressLine1 + addressLine2 + addressState + addressZip = callAPI request + where request = StripeRequest POST url params + url = requestType requestId "cards" case cardid of + Right x -> getRecipientCardId x + Left x -> getCardId x + params = getParams [ + ("name", name) + , ("address_city", (\(AddressCity x) -> x) <$> addressCity) + , ("address_country", (\(AddressCountry x) -> x) <$> addressCountry) + , ("address_line1", (\(AddressLine1 x) -> x) <$> addressLine1 ) + , ("address_line2", (\(AddressLine2 x) -> x) <$> addressLine2 ) + , ("address_state", (\(AddressState x) -> x) <$> addressState ) + , ("address_zip", (\(AddressZip x) -> x) <$> addressZip ) + ] + +------------------------------------------------------------------------------ +-- | Update a `Customer` `Card` +updateCustomerCard + :: CustomerId -- ^ `CustomerId` associated with the `Card` to be updated + -> CardId -- ^ The `CardId` associated with the `Card` to be updated + -> Maybe Name -- ^ Name of `Recipient` or `Customer` to be used for `Card` + -> Maybe AddressCity -- ^ City associated with `Card` + -> Maybe AddressCountry -- ^ Country associated with `Card` + -> Maybe AddressLine1 -- ^ Address Line 1 associated with `Card` + -> Maybe AddressLine2 -- ^ Address Line 2 associated with `Card` + -> Maybe AddressState -- ^ Address State 2 associated with `Card` + -> Maybe AddressZip -- ^ Address Zip associated with `Card` + -> Stripe Card +updateCustomerCard + customerid + cardid = updateCardBase "customers" (getCustomerId customerid) (Left cardid) + +------------------------------------------------------------------------------ +-- | Update a `Recipient` `Card` +updateRecipientCard + :: RecipientId -- ^ `RecipientId` associated with the `Card` to be updated + -> RecipientCardId -- ^ The `CardId` associated with the `Card` to be updated + -> Maybe Name -- ^ Name of `Recipient` or `Customer` to be used for `Card` + -> Maybe AddressCity -- ^ City associated with `Card` + -> Maybe AddressCountry -- ^ Country associated with `Card` + -> Maybe AddressLine1 -- ^ Address Line 1 associated with `Card` + -> Maybe AddressLine2 -- ^ Address Line 2 associated with `Card` + -> Maybe AddressState -- ^ Address State 2 associated with `Card` + -> Maybe AddressZip -- ^ Address Zip associated with `Card` + -> Stripe RecipientCard +updateRecipientCard + recipientid + cardid = updateCardBase "recipients" (getRecipientId recipientid) (Right cardid) + +------------------------------------------------------------------------------ +-- | Base Request for retrieving cards from either a `Customer` or `Recipient` +getCardBase + :: FromJSON a + => URL -- ^ The type of the request to support (recipient or customer) + -> ID -- ^ `CustomerId` or `RecipientId` of the `Card` to retrieve + -> ID -- ^ `CardId` or `RecipientCardId` of the `Card` or `RecipientCard` to retrieve + -> ExpandParams -- ^ `ExpandParams` of the `Card` + -> Stripe a +getCardBase + requestType + requestId + cardid + expandParams = callAPI request + where request = StripeRequest GET url params + url = requestType requestId "cards" cardid + params = toExpandable expandParams + +------------------------------------------------------------------------------ +-- | Get card by `CustomerId` and `CardId` +getCustomerCard + :: CustomerId -- ^ `CustomerId` of the `Card` to retrieve + -> CardId -- ^ `CardId` of the card to retrieve + -> Stripe Card +getCustomerCard + customerid cardid = getCustomerCardExpandable customerid cardid [] + +------------------------------------------------------------------------------ +-- | Get card by `CustomerId` and `CardId` with `ExpandParams` +getCustomerCardExpandable + :: CustomerId -- ^ `CustomerId` of the `Card` to retrieve + -> CardId -- ^ `CardId` of the card to retrieve + -> ExpandParams -- ^ `ExpandParams` of the card to retrieve + -> Stripe Card +getCustomerCardExpandable + customerid cardid expandParams = + getCardBase "customers" (getCustomerId customerid) (getCardId cardid) expandParams + +------------------------------------------------------------------------------ +-- | Get card by `RecipientId` and `CardId` +getRecipientCard + :: RecipientId -- ^ `RecipientId` of the `Card` to retrieve + -> RecipientCardId -- ^ `CardId` of the `Recipient` `Card` to retrieve + -> Stripe RecipientCard +getRecipientCard + recipientid + cardid = getRecipientCardExpandable recipientid cardid [] + +------------------------------------------------------------------------------ +-- | Get card by `RecipientId` and `CardId` +getRecipientCardExpandable + :: RecipientId -- ^ `RecipientId` of the `Card` to retrieve + -> RecipientCardId -- ^ `CardId` of the `Recipient` `Card` to retrieve + -> ExpandParams -- ^ `ExpandParams` of the `Recipient` `Card` to retrieve + -> Stripe RecipientCard +getRecipientCardExpandable + recipientid + cardid + expandParams + = getCardBase "recipients" (getRecipientId recipientid) + (getRecipientCardId cardid) expandParams + +------------------------------------------------------------------------------ +-- | Base Request for retrieving `Customer` cards +getCustomerCardsBase + :: CustomerId -- ^ `CustomerId` of the `Card` to retrieve + -> Maybe Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter CardId -- ^ Paginate starting after the following `CardId` + -> EndingBefore CardId -- ^ Paginate ending before the following `CardId` + -> ExpandParams -- ^ Expansion on `Card` + -> Stripe (StripeList Card) +getCustomerCardsBase + customerid + limit + startingAfter + endingBefore + expandParams = callAPI request + where request = StripeRequest GET url params + url = "customers" getCustomerId customerid "cards" + params = getParams [ + ("limit", toText `fmap` limit ) + , ("starting_after", (\(CardId x) -> x) `fmap` startingAfter) + , ("ending_before", (\(CardId x) -> x) `fmap` endingBefore) + ] ++ toExpandable expandParams + +------------------------------------------------------------------------------ +-- | Base Request for retrieving `Customer` or `Recipient` cards +getRecipientCardsBase + :: RecipientId -- ^ `RecipientId` of the `Card` to retrieve + -> Maybe Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter RecipientCardId -- ^ Paginate starting after the following `CardId` + -> EndingBefore RecipientCardId -- ^ Paginate ending before the following `CardId` + -> ExpandParams -- ^ Expansion on `Card` + -> Stripe (StripeList RecipientCard) +getRecipientCardsBase + recipientid + limit + startingAfter + endingBefore + expandParams = callAPI request + where request = StripeRequest GET url params + url = "recipients" getRecipientId recipientid "cards" + params = getParams [ + ("limit", toText `fmap` limit ) + , ("starting_after", (\(RecipientCardId x) -> x) `fmap` startingAfter) + , ("ending_before", (\(RecipientCardId x) -> x) `fmap` endingBefore) + ] ++ toExpandable expandParams + + +------------------------------------------------------------------------------ +-- | Retrieve all cards associated with a `Customer` +getCustomerCards + :: CustomerId -- ^ The `CustomerId` associated with the cards + -> Maybe Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter CardId -- ^ Paginate starting after the following `CardId` + -> EndingBefore CardId -- ^ Paginate ending before the following `CardId` + -> Stripe (StripeList Card) +getCustomerCards + customerid + limit + startingAfter + endingBefore + = getCustomerCardsExpandable customerid limit startingAfter endingBefore [] + +------------------------------------------------------------------------------ +-- | Retrieve all cards associated with a `Customer` +getCustomerCardsExpandable + :: CustomerId -- ^ The `CustomerId` associated with the cards + -> Maybe Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter CardId -- ^ Paginate starting after the following `CardId` + -> EndingBefore CardId -- ^ Paginate ending before the following `CardId` + -> ExpandParams -- ^ Expansion on `Card` + -> Stripe (StripeList Card) +getCustomerCardsExpandable + customerid + limit + startingAfter + endingBefore + expandParams = + getCustomerCardsBase customerid + limit startingAfter endingBefore expandParams + +------------------------------------------------------------------------------ +-- | Retrieve all cards associated with a `Recipient` +getRecipientCards + :: RecipientId -- ^ The `RecipientId` associated with the cards + -> Maybe Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter RecipientCardId -- ^ Paginate starting after the following `CardId` + -> EndingBefore RecipientCardId -- ^ Paginate ending before the following `CardId` + -> Stripe (StripeList RecipientCard) +getRecipientCards + recipientid + limit + startingAfter + endingBefore = + getRecipientCardsExpandable recipientid limit + startingAfter endingBefore [] + +------------------------------------------------------------------------------ +-- | Retrieve all cards associated with a `Recipient` +getRecipientCardsExpandable + :: RecipientId -- ^ The `RecipientId` associated with the cards + -> Maybe Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter RecipientCardId -- ^ Paginate starting after the following `CardId` + -> EndingBefore RecipientCardId -- ^ Paginate ending before the following `CardId` + -> ExpandParams -- ^ The `ExpandParams` of the object to be expanded + -> Stripe (StripeList RecipientCard) +getRecipientCardsExpandable + recipientid + limit + startingAfter + endingBefore + expandParams = + getRecipientCardsBase recipientid + limit startingAfter endingBefore expandParams + +------------------------------------------------------------------------------ +-- | Removes a card from a `Customer` +deleteCustomerCard + :: CustomerId -- ^ `CustomerId` of the `Card` to retrieve + -> CardId -- ^ `CardId` associated with `Card` to be deleted + -> Stripe StripeDeleteResult +deleteCustomerCard + customerid + cardid = callAPI request + where request = StripeRequest DELETE url params + url = "customers" getCustomerId customerid "cards" getCardId cardid + params = [] + +------------------------------------------------------------------------------ +-- | Removes a card from a `Customer` +deleteRecipientCard + :: RecipientId -- ^ The `RecipientId` associated with the `Card` to be removed + -> RecipientCardId -- ^ The `CardId` of the `Card` to be removed + -> Stripe StripeDeleteResult +deleteRecipientCard + recipientid + cardid = callAPI request + where request = StripeRequest DELETE url params + url = "recipients" getRecipientId recipientid + "cards" + getRecipientCardId cardid + params = [] diff --git a/src/Web/Stripe/Charge.hs b/src/Web/Stripe/Charge.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/Charge.hs @@ -0,0 +1,323 @@ +{-# LANGUAGE OverloadedStrings #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Charge +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#charges > +-- +-- @ +-- import Web.Stripe +-- import Web.Stripe.Customer +-- import Web.Stripe.Charge +-- +-- main :: IO () +-- main = do +-- let config = SecretKey "secret_key" +-- credit = CardNumber "4242424242424242" +-- em = ExpMonth 12 +-- ey = ExpYear 2015 +-- cvc = CVC "123" +-- result <- stripe config $ do +-- Customer { customerId = cid } <- createCustomerByCard cn em ey cvc +-- charge <- chargeCustomer cid USD 100 Nothing +-- return charge +-- case result of +-- Right charge -> print charge +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.Charge + ( -- * API + ---- * Create Charges + chargeCustomer + , chargeCardByToken + , chargeCustomerByCardId + , chargeCard + , chargeBase + ---- * Get Charge(s) + , getCharge + , getChargeExpandable + , getCharges + , getChargesExpandable + , getCustomerCharges + , getCustomerChargesExpandable + ---- * Update Charge + , updateCharge + ---- * Capture Charge + , captureCharge + -- * Types + , Charge (..) + , TokenId (..) + , ChargeId (..) + , CustomerId (..) + , Customer (..) + , Currency (..) + , CardNumber (..) + , CVC (..) + , ExpMonth (..) + , ExpYear (..) + , StripeList (..) + , Email (..) + , Description + , StatementDescription + , Amount + , Capture + ) where + +import Web.Stripe.Client.Internal (Method (GET, POST), Stripe, + StripeRequest (..), callAPI, + getParams, toMetaData, toText, toExpandable, + toTextLower, ()) +import Web.Stripe.Types (Amount, CVC (..), Capture, + CardNumber (..), Charge (..), + ChargeId (..), Currency (..), + CustomerId (..), Description, + EndingBefore, ExpMonth (..), + ExpYear (..), Limit, MetaData, + Email (..), StartingAfter, Customer(..), + StatementDescription(..), ExpandParams, + StripeList (..), TokenId (..), CardId(..)) +import Web.Stripe.Types.Util (getCardId, getChargeId, getCustomerId) + +------------------------------------------------------------------------------ +-- | Charge `Customer``s by `CustomerId`, will charge the default `Card` if exists +chargeCustomer + :: CustomerId -- ^ The `CustomerId` of the `Customer` to be charged + -> Currency -- ^ Required, 3-letter ISO Code + -> Amount -- ^ Required, Integer value of 100 represents $1 + -> Maybe Description -- ^ Optional, default is null + -> Stripe Charge +chargeCustomer customerid currency amount description = + chargeBase amount currency description (Just customerid) + Nothing Nothing Nothing True + Nothing Nothing Nothing Nothing [] + +------------------------------------------------------------------------------ +-- | Charge `Customer`s by `CustomerId` +chargeCustomerByCardId + :: CustomerId -- ^ The `CustomerId` of the `Customer` to be charged + -> CardId -- ^ `CardId` of `Customer` to charge + -> Currency -- ^ Required, 3-letter ISO Code + -> Amount -- ^ Required, Integer value of 100 represents $1 + -> Maybe Description -- ^ Optional, default is null + -> Stripe Charge +chargeCustomerByCardId + customerid + cardid + currency + amount + description = + chargeBase amount currency description + (Just customerid) (Just $ TokenId $ getCardId cardid) Nothing + Nothing True Nothing Nothing + Nothing Nothing [] + +------------------------------------------------------------------------------ +-- | Charge a card by a `TokenId` +chargeCardByToken + :: TokenId -- ^ The `TokenId` representative of a `Card` + -> Currency -- ^ Required, 3-letter ISO Code + -> Amount -- ^ Required, Integer value of 100 represents $1 + -> Maybe Description -- ^ Optional, default is null + -> Stripe Charge +chargeCardByToken tokenId currency amount description = + chargeBase amount currency description Nothing (Just tokenId) + Nothing Nothing True Nothing Nothing Nothing Nothing [] + +------------------------------------------------------------------------------ +-- | Charge a card by `CardNumber` +chargeCard + :: CardNumber -- ^ Required, Credit Card Number + -> ExpMonth -- ^ Required, Expiration Month (i.e. 09) + -> ExpYear -- ^ Required, Expiration Year (i.e. 2018) + -> CVC -- ^ Required, CVC Number (i.e. 000) + -> Currency -- ^ Required, 3-letter ISO Code + -> Amount -- ^ Required, Integer value of 100 represents $1 + -> Maybe Description -- ^ Optional, default is null + -> Stripe Charge +chargeCard cardNumber expMonth expYear cvc currency amount description = + chargeBase amount currency description + Nothing Nothing Nothing Nothing True + (Just cardNumber) (Just expMonth) + (Just expYear) (Just cvc) [] + +------------------------------------------------------------------------------ +-- | Base method for creating a `Charge` +chargeBase + :: Amount -- ^ Required, Integer value of 100 represents $1 + -> Currency -- ^ Required, 3-letter ISO Code + -> Maybe Description -- ^ Optional, default is nullo + -> Maybe CustomerId -- ^ Optional, either `CustomerId` or `TokenId` has to be specified + -> Maybe TokenId -- ^ Optional, either `CustomerId` or `TokenId` has to be specified + -> Maybe StatementDescription -- ^ Optional, Arbitrary string to include on CC statements + -> Maybe Email -- ^ Optional, Arbitrary string to include on CC statements + -> Capture -- ^ Optional, default is True + -> Maybe CardNumber -- ^ Optional, Credit Card Number + -> Maybe ExpMonth -- ^ `Card` Expiration Month + -> Maybe ExpYear -- ^ `Card` Expiration Year + -> Maybe CVC -- ^ `Card` `CVC` + -> MetaData -- ^ `Card` `MetaData` + -> Stripe Charge +chargeBase + amount + currency + description + customerid + tokenId + statementDescription + receiptEmail + capture + cardNumber + expMonth + expYear + cvc' + metadata = callAPI request + where request = StripeRequest POST url params + url = "charges" + params = toMetaData metadata ++ getParams [ + ("amount", toText `fmap` Just amount) + , ("customer", (\(CustomerId cid) -> cid) `fmap` customerid) + , ("currency", toTextLower `fmap` Just currency) + , ("card", (\(TokenId tokenid) -> tokenid) `fmap` tokenId) + , ("description", description) + , ("statement_description", (\(StatementDescription x) -> x) `fmap` statementDescription) + , ("receipt_email", (\(Email email) -> email) `fmap` receiptEmail) + , ("capture", (\x -> if x then "true" else "false") `fmap` Just capture) + , ("card[number]", (\(CardNumber c) -> c) `fmap` cardNumber) + , ("card[exp_month]", (\(ExpMonth m) -> toText m) `fmap` expMonth) + , ("card[exp_year]", (\(ExpYear y) -> toText y) `fmap` expYear) + , ("card[cvc]", (\(CVC c) -> c) `fmap` cvc') + ] + +------------------------------------------------------------------------------ +-- | Retrieve a `Charge` by `ChargeId` +getCharge + :: ChargeId -- ^ The `Charge` to retrive + -> Stripe Charge +getCharge chargeid = getChargeExpandable chargeid [] + +------------------------------------------------------------------------------ +-- | Retrieve a `Charge` by `ChargeId` with `ExpandParams` +getChargeExpandable + :: ChargeId -- ^ The `Charge` retrive + -> ExpandParams -- ^ The `ExpandParams` to retrive + -> Stripe Charge +getChargeExpandable + chargeid + expandParams = callAPI request + where request = StripeRequest GET url params + url = "charges" getChargeId chargeid + params = toExpandable expandParams + +------------------------------------------------------------------------------ +-- | Retrieve all `Charge`s +getCharges + :: Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter ChargeId -- ^ Paginate starting after the following CustomerID + -> EndingBefore ChargeId -- ^ Paginate ending before the following CustomerID + -> Stripe (StripeList Charge) +getCharges + limit + startingAfter + endingBefore = + getChargesExpandable limit startingAfter endingBefore [] + +------------------------------------------------------------------------------ +-- | Retrieve all `Charge`s +getChargesExpandable + :: Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter ChargeId -- ^ Paginate starting after the following `CustomerId` + -> EndingBefore ChargeId -- ^ Paginate ending before the following `CustomerId` + -> ExpandParams -- ^ Get Charges with `ExpandParams` + -> Stripe (StripeList Charge) +getChargesExpandable + limit + startingAfter + endingBefore + expandParams = callAPI request + where request = StripeRequest GET url params + url = "charges" + params = getParams [ + ("limit", toText `fmap` limit ) + , ("starting_after", (\(ChargeId x) -> x) `fmap` startingAfter) + , ("ending_before", (\(ChargeId x) -> x) `fmap` endingBefore) + ] ++ toExpandable expandParams + + +------------------------------------------------------------------------------ +-- | Retrieve all `Charge`s for a specified `Customer` +getCustomerCharges + :: CustomerId + -> Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter ChargeId -- ^ Paginate starting after the following `CustomerId` + -> EndingBefore ChargeId -- ^ Paginate ending before the following `CustomerId` + -> Stripe (StripeList Charge) +getCustomerCharges + customerid + limit + startingAfter + endingBefore = + getCustomerChargesExpandable customerid limit + startingAfter endingBefore [] + +------------------------------------------------------------------------------ +-- | Retrieve all `Charge`s for a specified `Customer` with `ExpandParams` +getCustomerChargesExpandable + :: CustomerId + -> Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter ChargeId -- ^ Paginate starting after the following `CustomerId` + -> EndingBefore ChargeId -- ^ Paginate ending before the following `CustomerId` + -> ExpandParams -- ^ Get `Customer` `Charge`s with `ExpandParams` + -> Stripe (StripeList Charge) +getCustomerChargesExpandable + customerid + limit + startingAfter + endingBefore + expandParams = callAPI request + where request = StripeRequest GET url params + url = "charges" + params = getParams [ + ("customer", Just $ getCustomerId customerid ) + , ("limit", toText `fmap` limit ) + , ("starting_after", (\(ChargeId x) -> x) `fmap` startingAfter) + , ("ending_before", (\(ChargeId x) -> x) `fmap` endingBefore) + ] ++ toExpandable expandParams + +------------------------------------------------------------------------------ +-- | A `Charge` to be updated +updateCharge + :: ChargeId -- ^ The `Charge` to update + -> Description -- ^ The `Charge` `Description` to update + -> MetaData -- ^ The `Charge` `MetaData` to update + -> Stripe Charge +updateCharge + chargeid + description + metadata = callAPI request + where request = StripeRequest POST url params + url = "charges" getChargeId chargeid + params = toMetaData metadata ++ getParams [ + ("description", Just description) + ] + +------------------------------------------------------------------------------ +-- | a `Charge` to be captured +captureCharge + :: ChargeId -- ^ The `ChargeId` of the `Charge` to capture + -> Maybe Amount -- ^ If Nothing the entire charge will be captured, otherwise the remaining will be refunded + -> Maybe Email -- ^ `Email` to send `Charge` receipt + -> Stripe Charge +captureCharge + chargeid + amount + receiptEmail = callAPI request + where request = StripeRequest POST url params + url = "charges" getChargeId chargeid "capture" + params = getParams [ + ("amount", toText `fmap` amount) + , ("receipt_email", (\(Email email) -> email) `fmap` receiptEmail) + ] diff --git a/src/Web/Stripe/Client.hs b/src/Web/Stripe/Client.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/Client.hs @@ -0,0 +1,21 @@ +-- | +-- Module : Web.Stripe.Client +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +module Web.Stripe.Client + ( -- * Execute a `Stripe` action + stripe + -- * `Stripe` Monad + , Stripe + -- * `Stripe` Secret Key + , StripeConfig (..) + -- * Error type for Request + , module Web.Stripe.Client.Error + ) where + +import Web.Stripe.Client.Internal +import Web.Stripe.Client.Error + + diff --git a/src/Web/Stripe/Client/Error.hs b/src/Web/Stripe/Client/Error.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/Client/Error.hs @@ -0,0 +1,109 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Web.Stripe.Client.Error +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +module Web.Stripe.Client.Error + ( -- * Types + StripeErrorHTTPCode (..) + , StripeErrorType (..) + , StripeErrorCode (..) + , StripeError (..) + ) where + +import Control.Applicative ((<$>)) +import Data.Aeson +import Data.Text (Text) +import Control.Monad (mzero) + +------------------------------------------------------------------------------ +-- | Error Codes for HTTP Responses +data StripeErrorHTTPCode = + BadRequest -- ^ 400 + | UnAuthorized -- ^ 401 + | RequestFailed -- ^ 402 + | NotFound -- ^ 404 + | StripeServerError -- ^ (>=500) + | UnknownHTTPCode -- ^ All other codes + deriving Show + +------------------------------------------------------------------------------ +-- | Stripe Error Types +data StripeErrorType = + InvalidRequest + | APIError + | CardError + | ConnectionFailure + | ParseFailure + | UnknownErrorType + deriving Show + +------------------------------------------------------------------------------ +-- | Stripe Error Codes +data StripeErrorCode = + IncorrectNumber + | InvalidNumber + | InvalidExpiryMonth + | InvalidExpiryYear + | InvalidCVC + | ExpiredCard + | IncorrectCVC + | IncorrectZIP + | CardDeclined + | Missing + | ProcessingError + | RateLimit + | UnknownError + deriving Show + +------------------------------------------------------------------------------ +-- | Stripe Error +data StripeError = StripeError { + errorType :: StripeErrorType + , errorMsg :: Text + , errorCode :: Maybe StripeErrorCode + , errorParam :: Maybe Text + , errorHTTP :: Maybe StripeErrorHTTPCode + } deriving Show + +------------------------------------------------------------------------------ +-- | Parses an error message into a `StripeErrorType` +toErrorType + :: Text + -> StripeErrorType +toErrorType "invalid_request_error" = InvalidRequest +toErrorType "api_error" = APIError +toErrorType "card_error" = CardError +toErrorType _ = UnknownErrorType + +------------------------------------------------------------------------------ +-- | Parses an error message into a `StripeErrorCode` +toErrorCode + :: Text + -> StripeErrorCode +toErrorCode "incorrect_number" = IncorrectNumber +toErrorCode "invalid_number" = InvalidNumber +toErrorCode "invalid_expiry_month" = InvalidExpiryMonth +toErrorCode "invalid_expiry_year" = InvalidExpiryYear +toErrorCode "invalid_cvc" = InvalidCVC +toErrorCode "expired_card" = ExpiredCard +toErrorCode "incorrect_cvc" = IncorrectCVC +toErrorCode "incorrect_zip" = IncorrectZIP +toErrorCode "card_declined" = CardDeclined +toErrorCode "missing" = Missing +toErrorCode "processing_error" = ProcessingError +toErrorCode "rate_limit" = RateLimit +toErrorCode _ = UnknownError + +instance FromJSON StripeError where + parseJSON (Object o) = do + e <- o .: "error" + typ <- toErrorType <$> e .: "type" + msg <- e .: "message" + code <- fmap toErrorCode <$> e .:? "code" + param <- e .:? "param" + return $ StripeError typ msg code param Nothing + parseJSON _ = mzero + diff --git a/src/Web/Stripe/Client/Internal.hs b/src/Web/Stripe/Client/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/Client/Internal.hs @@ -0,0 +1,127 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +-- | +-- Module : Web.Stripe.Client.Internal +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +module Web.Stripe.Client.Internal + ( callAPI + , stripe + , Stripe + , StripeRequest (..) + , StripeError (..) + , StripeConfig (..) + , Method (..) + , module Web.Stripe.Client.Util + , module Web.Stripe.Client.Error + ) where + +import Control.Exception (SomeException, try) +import Control.Monad (when) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Control.Monad.Reader (ask, runReaderT) +import Control.Monad.Trans.Either (left, runEitherT, right) +import Data.Aeson (FromJSON, Value(..), eitherDecodeStrict) +import Data.Monoid (mempty, (<>)) +import qualified Data.Text as T +import Network.Http.Client (Connection, Method (..), + baselineContextSSL, buildRequest, + closeConnection, concatHandler, + getStatusCode, http, + inputStreamBody, openConnectionSSL, + receiveResponse, sendRequest, + setAuthorizationBasic, + setContentType, setHeader) +import OpenSSL (withOpenSSL) +import Web.Stripe.Client.Error (StripeError (..), + StripeErrorHTTPCode (..), + StripeErrorType (..)) +import Web.Stripe.Client.Types (APIVersion (..), Stripe, + StripeConfig (..), + StripeRequest (..)) +import Web.Stripe.Client.Util (fromSeconds, getParams, + paramsToByteString, toBytestring, + toExpandable, toMetaData, toText, + toTextLower, ()) + +import qualified Data.ByteString as S +import qualified Data.Text.Encoding as T +import qualified System.IO.Streams as Streams + +------------------------------------------------------------------------------ +-- | Create a request to `Stripe`'s API +stripe + :: FromJSON a + => StripeConfig + -> Stripe a + -> IO (Either StripeError a) +stripe config requests = do + withOpenSSL $ do + ctx <- baselineContextSSL + result <- try (openConnectionSSL ctx "api.stripe.com" 443) :: IO (Either SomeException Connection) + case result of + Left msg -> return $ Left $ StripeError ConnectionFailure (toText msg) Nothing Nothing Nothing + Right conn -> do + json <- flip runReaderT (config, conn) $ runEitherT requests + closeConnection conn + return json + +------------------------------------------------------------------------------ +-- | Debug Helper +debug :: Bool +debug = False + +------------------------------------------------------------------------------ +-- | API Request to be issued +callAPI :: FromJSON a => StripeRequest -> Stripe a +callAPI StripeRequest{..} = do + (StripeConfig{..}, conn) <- ask + let reqBody | method == GET = mempty + | otherwise = paramsToByteString queryParams + reqURL | method == GET = S.concat [ + T.encodeUtf8 endpoint + , "?" + , paramsToByteString queryParams + ] + | otherwise = T.encodeUtf8 endpoint + handleStream =<< liftIO (do + req <- buildRequest $ do + http method $ "/v1/" <> reqURL + setAuthorizationBasic secretKey mempty + setContentType "application/x-www-form-urlencoded" + setHeader "Stripe-Version" (toBytestring V20141007) + setHeader "Connection" "Keep-Alive" + body <- Streams.fromByteString reqBody + sendRequest conn req $ inputStreamBody body + receiveResponse conn $ \response inputStream -> + do when debug $ print response + result <- concatHandler response inputStream + return (response, result)) + where + parseFail errorMessage = + left $ StripeError ParseFailure (T.pack errorMessage) Nothing Nothing Nothing + unknownCode = left $ StripeError UnknownErrorType mempty Nothing Nothing Nothing + handleStream (p,x) = + case getStatusCode p of + 200 -> case eitherDecodeStrict x of + Left message -> do + when debug $ liftIO $ print (eitherDecodeStrict x :: Either String Value) + parseFail message + Right json -> right json + code | code >= 400 -> + case eitherDecodeStrict x :: Either String StripeError of + Left message -> parseFail message + Right json -> + left $ case code of + 400 -> json { errorHTTP = Just BadRequest } + 401 -> json { errorHTTP = Just UnAuthorized } + 402 -> json { errorHTTP = Just RequestFailed } + 404 -> json { errorHTTP = Just NotFound } + 500 -> json { errorHTTP = Just StripeServerError } + 502 -> json { errorHTTP = Just StripeServerError } + 503 -> json { errorHTTP = Just StripeServerError } + 504 -> json { errorHTTP = Just StripeServerError } + _ -> json { errorHTTP = Just UnknownHTTPCode } + _ -> unknownCode diff --git a/src/Web/Stripe/Client/Types.hs b/src/Web/Stripe/Client/Types.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/Client/Types.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Web.Stripe.Client.Types +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +module Web.Stripe.Client.Types + ( -- * Types + Stripe + , StripeRequest (..) + , StripeConfig (..) + , APIVersion (..) + ) where + +import Control.Monad.Reader (ReaderT) +import Control.Monad.Trans.Either (EitherT) +import Data.ByteString (ByteString) +import Data.Text (Text) +import Network.Http.Client (Connection, Method) +import Web.Stripe.Client.Error (StripeError (..)) + +------------------------------------------------------------------------------ +-- | The `Stripe` Monad +type Stripe a = EitherT StripeError (ReaderT (StripeConfig, Connection) IO) a + +------------------------------------------------------------------------------ +-- | HTTP Params +type Params = [(ByteString, ByteString)] + +------------------------------------------------------------------------------ +-- | Stripe Request holding `Method`, URL and `Params` for a Request +data StripeRequest = StripeRequest + { method :: Method -- ^ Method of StripeRequest (i.e. `GET`, `PUT`, `POST`, `PUT`) + , endpoint :: Text -- ^ Endpoint of StripeRequest + , queryParams :: Params -- ^ Query Parameters of StripeRequest + } deriving Show + +------------------------------------------------------------------------------ +-- | Stripe secret key +data StripeConfig = StripeConfig + { secretKey :: ByteString + } deriving Show + +------------------------------------------------------------------------------ +-- | API Version +data APIVersion = + V20141007 -- ^ Stripe API Version for this package release + deriving Eq + +instance Show APIVersion where + show V20141007 = "2014-10-07" + diff --git a/src/Web/Stripe/Client/Util.hs b/src/Web/Stripe/Client/Util.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/Client/Util.hs @@ -0,0 +1,107 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Web.Stripe.Client.Util +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +module Web.Stripe.Client.Util + ( -- * Utils + fromSeconds + , toSeconds + , paramsToByteString + , toText + , toTextLower + , getParams + , toBytestring + , () + , toMetaData + , toExpandable + ) where + +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as B8 +import Data.Monoid (Monoid, mconcat, mempty, (<>)) +import Data.String (IsString) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Time.Clock (UTCTime) +import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) + +------------------------------------------------------------------------------ +-- | Conversion from a `Show` constrained type to `Text` +toText + :: Show a + => a + -> Text +toText = T.pack . show + +------------------------------------------------------------------------------ +-- | Conversion from a `Show` constrained type to lowercase `Text` +toTextLower + :: Show a + => a + -> Text +toTextLower = T.toLower . T.pack . show + +------------------------------------------------------------------------------ +-- | Conversion of a key value pair to a query parameterized string +paramsToByteString + :: (Monoid m, IsString m) + => [(m, m)] + -> m +paramsToByteString [] = mempty +paramsToByteString ((x,y) : []) = x <> "=" <> y +paramsToByteString ((x,y) : xs) = + mconcat [ x, "=", y, "&" ] <> paramsToByteString xs + +------------------------------------------------------------------------------ +-- | Forward slash interspersion on `Monoid` and `IsString` +-- constrained types +() + :: (Monoid m, IsString m) + => m + -> m + -> m +m1 m2 = m1 <> "/" <> m2 + +------------------------------------------------------------------------------ +-- | Convert an `Integer` to a `UTCTime` +fromSeconds + :: Integer + -> UTCTime +fromSeconds = posixSecondsToUTCTime . fromInteger + +------------------------------------------------------------------------------ +-- | Convert a `UTCTime` to a `Integer` +toSeconds + :: UTCTime + -> Integer +toSeconds = read . takeWhile (/='.') . show . utcTimeToPOSIXSeconds + +------------------------------------------------------------------------------ +-- | Retrieve and encode the optional parameters +getParams + :: [(ByteString, Maybe Text)] + -> [(ByteString, ByteString)] +getParams xs = [ (x, T.encodeUtf8 y) | (x, Just y) <- xs ] + +------------------------------------------------------------------------------ +-- | Convert APITVersion to a ByteString +toBytestring :: Show a => a -> ByteString +toBytestring = B8.pack . show + +------------------------------------------------------------------------------ +-- | To MetaData +toMetaData :: [(Text, Text)] -> [(ByteString, ByteString)] +toMetaData = map toKV + where + toKV (k,v) = ("metadata[" <> T.encodeUtf8 k <> "]", T.encodeUtf8 v) + +------------------------------------------------------------------------------ +-- | To Expandable +toExpandable :: [Text] -> [(ByteString, ByteString)] +toExpandable = map toKV + where + toKV v = ("expand[]", T.encodeUtf8 v) diff --git a/src/Web/Stripe/Coupon.hs b/src/Web/Stripe/Coupon.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/Coupon.hs @@ -0,0 +1,157 @@ +{-# LANGUAGE OverloadedStrings #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Coupon +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#coupons > +-- +-- @ +-- import Web.Stripe +-- import Web.Stripe.Coupon +-- +-- main :: IO () +-- main = do +-- let config = SecretKey "secret_key" +-- result <- createCoupon +-- (Just $ CouponId "$1 Off!") +-- Once +-- (Just $ AmountOff 1) +-- (Just USD) +-- Nothing +-- Nothing +-- Nothing +-- Nothing +-- [] +-- case result of +-- Right coupon -> print coupon +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.Coupon + ( -- * API + createCoupon + , getCoupon + , getCoupons + , updateCoupon + , deleteCoupon + -- * Types + , Duration (..) + , AmountOff (..) + , CouponId (..) + , Coupon (..) + , Currency (..) + , DurationInMonths (..) + , MaxRedemptions (..) + , PercentOff (..) + , RedeemBy (..) + , StripeList (..) + , StripeDeleteResult (..) + ) where + +import Web.Stripe.Client.Internal (Method (POST, DELETE, GET), Stripe, + StripeRequest (..), callAPI, toMetaData, + getParams, toText, (), toTextLower) +import Web.Stripe.Types (AmountOff (..), Coupon (..), + CouponId (..), Currency (..), + Duration(..), DurationInMonths (..), + EndingBefore, Limit, MetaData, + MaxRedemptions (..), + PercentOff (..), RedeemBy (..), + StartingAfter, + StripeDeleteResult (..), + StripeList (..)) + +------------------------------------------------------------------------------ +-- | `Coupon` creation +createCoupon + :: Maybe CouponId -- ^ Name of the `Coupon` + -> Duration -- ^ `Duration` of the `Coupon` + -> Maybe AmountOff -- ^ `AmountOff` of the `Coupon` + -> Maybe Currency -- ^ `Currency` of the `Coupon` + -> Maybe DurationInMonths -- ^ `DurationInMonths` of the `Coupon` + -> Maybe MaxRedemptions -- ^ `MaxRedemptions` of the `Coupon` + -> Maybe PercentOff -- ^ `PercentOff` of the `Coupon` + -> Maybe RedeemBy -- ^ `RedeemBy` date of the `Coupon` + -> MetaData -- ^ `MetaData` of the `Coupon` + -> Stripe Coupon +createCoupon + couponid + duration + amountOff + currency + durationInMonths + maxRedemptions + percentOff + redeemBy + metadata = callAPI request + where request = StripeRequest POST url params + url = "coupons" + params = toMetaData metadata ++ getParams [ + ("id", (\(CouponId x) -> x) `fmap` couponid ) + , ("duration", toText `fmap` Just duration ) + , ("amount_off", (\(AmountOff x) -> toText x) `fmap` amountOff ) + , ("currency", toTextLower `fmap` currency) + , ("duration_in_months", (\(DurationInMonths x) -> toText x) `fmap` durationInMonths ) + , ("max_redemptions", (\(MaxRedemptions x) -> toText x) `fmap` maxRedemptions ) + , ("percent_off", (\(PercentOff x) -> toText x) `fmap` percentOff ) + , ("redeem_by", (\(RedeemBy x) -> toText x) `fmap` redeemBy ) + ] + +------------------------------------------------------------------------------ +-- | Retrieve a `Coupon` by `CouponId` +getCoupon + :: CouponId -- ^ `CouponId` of the `Coupon` to retrieve + -> Stripe Coupon +getCoupon + (CouponId couponid) = callAPI request + where request = StripeRequest GET url params + url = "coupons" couponid + params = [] + +------------------------------------------------------------------------------ +-- | Retrieve a list of 'Coupon's +getCoupons + :: Maybe Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter CouponId -- ^ Paginate starting after the following `CouponId` + -> EndingBefore CouponId -- ^ Paginate ending before the following `CouponId` + -> Stripe (StripeList Coupon) +getCoupons + limit + startingAfter + endingBefore + = callAPI request + where request = StripeRequest GET url params + url = "coupons" + params = getParams [ + ("limit", toText `fmap` limit ) + , ("starting_after", (\(CouponId x) -> x) `fmap` startingAfter) + , ("ending_before", (\(CouponId x) -> x) `fmap` endingBefore) + ] + +------------------------------------------------------------------------------ +-- | Update 'Coupon' +updateCoupon + :: CouponId -- ^ The `CoupondId` of the `Coupon` to update + -> MetaData -- ^ The `MetaData` for the `Coupon` + -> Stripe Coupon +updateCoupon + (CouponId couponid) + metadata = callAPI request + where request = StripeRequest POST url params + url = "coupons" couponid + params = toMetaData metadata + +------------------------------------------------------------------------------ +-- | Delete 'Coupon" by 'CouponId' +deleteCoupon + :: CouponId -- ^ The `CoupondId` of the `Coupon` to update + -> Stripe StripeDeleteResult +deleteCoupon + (CouponId couponid) = callAPI request + where request = StripeRequest DELETE url params + url = "coupons" couponid + params = [] + diff --git a/src/Web/Stripe/Customer.hs b/src/Web/Stripe/Customer.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/Customer.hs @@ -0,0 +1,310 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Customer +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#customers > +-- +-- @ +-- import Web.Stripe +-- import Web.Stripe.Customer +-- +-- main :: IO () +-- main = do +-- let config = SecretKey "secret_key" +-- result <- stripe config createEmptyCustomer +-- case result of +-- Right customer -> print customer +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.Customer + ( -- * API + ---- * Create customer + createEmptyCustomer + , createCustomerByEmail + , createCustomerByToken + , createCustomerByCard + , createCustomerBase + ---- * Update customer + , updateCustomerBase + , updateCustomerAccountBalance + , updateCustomerDefaultCard + ---- * Delete customer + , deleteCustomer + ---- * Get customer(s) + , getCustomer + , getCustomerExpandable + , getCustomers + , getCustomersExpandable + -- * Types + , Customer (..) + , CustomerId (..) + , CardId (..) + , StripeList (..) + , TokenId (..) + , CardNumber (..) + , ExpMonth (..) + , ExpYear (..) + , CVC (..) + , CouponId (..) + , Email (..) + , PlanId (..) + , Quantity (..) + , StripeDeleteResult (..) + , Description + , AccountBalance + , TrialPeriod + , Limit + ) where + +import Web.Stripe.Client.Internal (Method (GET, POST, DELETE), Stripe, + StripeRequest (..), callAPI, toMetaData, + getParams, toText, (), toExpandable) +import Web.Stripe.Types (AccountBalance, CVC (..), + CardId (..), CardNumber (..), + CouponId (..), Customer (..), + CustomerId (..), Description, + Email (..), EndingBefore, + ExpMonth (..), ExpYear (..), Limit, + PlanId (..), Quantity (..), MetaData, + StartingAfter, + StripeDeleteResult (..), + StripeList (..), TokenId (..), + TrialPeriod, ExpandParams) +import Web.Stripe.Types.Util + +------------------------------------------------------------------------------ +-- | The base request for customer creation +createCustomerBase + :: Maybe AccountBalance -- ^ Integer amount corresponding to AccountBalance + -> Maybe TokenId -- ^ Either a dictionary of a card or a 'TokenId' + -> Maybe CardNumber -- ^ Card Number + -> Maybe ExpMonth -- ^ Card Expiration Month + -> Maybe ExpYear -- ^ Card Expiration Year + -> Maybe CVC -- ^ Card CVC + -> Maybe CouponId -- ^ Discount on all recurring charges + -> Maybe Description -- ^ Arbitrary string to attach to a customer object + -> Maybe Email -- ^ Email address of customer + -> Maybe PlanId -- ^ Identifier of plan to subscribe customer to + -> Maybe Quantity -- ^ The quantity you'd like to apply to the subscription you're creating + -> Maybe TrialPeriod -- ^ TimeStamp representing the trial period the customer will get + -> MetaData -- ^ MetaData associated with the customer being created + -> Stripe Customer +createCustomerBase + accountBalance + cardId + cardNumber + expMonth + expYear + cvc + couponId + description + email + planId + quantity + trialEnd + metadata = callAPI request + where request = StripeRequest POST "customers" params + params = toMetaData metadata ++ getParams [ + ("account_balance", toText `fmap` accountBalance) + , ("card", (\(TokenId x) -> x) `fmap` cardId) + , ("card[number]", (\(CardNumber x) -> x) `fmap` cardNumber) + , ("card[exp_month]", (\(ExpMonth x) -> toText x) `fmap` expMonth) + , ("card[exp_year]", (\(ExpYear x) -> toText x) `fmap` expYear) + , ("card[cvc]", (\(CVC x) -> x) `fmap` cvc) + , ("coupon", (\(CouponId x) -> x) `fmap` couponId) + , ("description", description) + , ("email", (\(Email x) -> x) `fmap` email) + , ("plan", (\(PlanId x) -> x) `fmap` planId) + , ("quantity", (\(Quantity x) -> toText x) `fmap` quantity) + , ("trial_end", toText `fmap` trialEnd) + ] + +------------------------------------------------------------------------------ +-- | Creates a customer by his/her email +createCustomerByEmail + :: Email -- ^ The `Email` of the `Customer` to create + -> Stripe Customer +createCustomerByEmail e = + createCustomerBase Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing + (Just e) Nothing Nothing Nothing [] + +------------------------------------------------------------------------------ +-- | Creates a blank customer +createEmptyCustomer + :: Stripe Customer +createEmptyCustomer = + createCustomerBase Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing [] + +------------------------------------------------------------------------------ +-- | Creates a customer by a Token created from stripe.js or the stripe API. +createCustomerByToken + :: TokenId -- ^ The `TokenId` of the `Customer` to create + -> Stripe Customer +createCustomerByToken t = + createCustomerBase Nothing (Just t) Nothing Nothing + Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing [] + +------------------------------------------------------------------------------ +-- | Creates a 'Customer' with a 'Card' +createCustomerByCard + :: CardNumber -- ^ Card Number + -> ExpMonth -- ^ Card Expiration Month + -> ExpYear -- ^ Card Expiration Year + -> CVC -- ^ Card `CVC` + -> Stripe Customer +createCustomerByCard + cardNumber + expMonth + expYear + cvc = createCustomerBase Nothing Nothing (Just cardNumber) (Just expMonth) + (Just expYear) (Just cvc) Nothing Nothing + Nothing Nothing Nothing Nothing [] + +------------------------------------------------------------------------------ +-- | Updates a customer +updateCustomerBase + :: CustomerId -- ^ `CustomerId` associated with the `Customer` to update + -> Maybe AccountBalance -- ^ Integer amount corresponding to AccountBalance + -> Maybe TokenId -- ^ Either a dictionary of a card or a tokenId + -> Maybe CardNumber -- ^ Either a dictionary of a card or a tokenId + -> Maybe ExpMonth -- ^ `Card` Expiration Month + -> Maybe ExpYear -- ^ `Card` Expiration Year + -> Maybe CVC -- ^ `Card` CVC + -> Maybe CouponId -- ^ Discount on all recurring charges + -> Maybe CardId -- ^ `CardId` to set as default for customer + -> Maybe Description -- ^ Arbitrary string to attach to a customer object + -> Maybe Email -- ^ Email address of customer + -> MetaData -- ^ MetaData associated with the customer being created + -> Stripe Customer +updateCustomerBase + customerid + accountBalance + cardId + cardNumber + expMonth + expYear + cvc + couponId + defaultCardId + description + email + metadata = callAPI request + where request = StripeRequest POST url params + url = "customers" getCustomerId customerid + params = toMetaData metadata ++ getParams [ + ("account_balance", toText `fmap` accountBalance) + , ("card", (\(TokenId x) -> x) `fmap` cardId) + , ("card[number]", (\(CardNumber x) -> x) `fmap` cardNumber) + , ("card[exp_month]", (\(ExpMonth x) -> toText x) `fmap` expMonth) + , ("card[exp_year]", (\(ExpYear x) -> toText x) `fmap` expYear) + , ("card[cvc]", (\(CVC x) -> x) `fmap` cvc) + , ("coupon", (\(CouponId x) -> x) `fmap` couponId) + , ("default_card", (\(CardId x) -> x) `fmap` defaultCardId) + , ("description", description) + , ("email", (\(Email x) -> x) `fmap` email) + ] + +------------------------------------------------------------------------------ +-- | Update Customer Account Balance +updateCustomerAccountBalance + :: CustomerId -- ^ `CustomerId` associated with the `Customer` to update + -> AccountBalance -- ^ `AccountBalance` associated + -> Stripe Customer +updateCustomerAccountBalance + customerid + accountbalance + = updateCustomerBase customerid (Just accountbalance) + Nothing Nothing Nothing + Nothing Nothing Nothing + Nothing Nothing Nothing [] + +------------------------------------------------------------------------------ +-- | Update Customer Account Balance +updateCustomerDefaultCard + :: CustomerId -- ^ `CustomerId` associated with the `Customer` to update + -> CardId -- ^ 'CardId' to become default card + -> Stripe Customer +updateCustomerDefaultCard + customerId + defaultCard + = updateCustomerBase customerId Nothing + Nothing Nothing Nothing + Nothing Nothing Nothing + (Just defaultCard) Nothing Nothing [] + +------------------------------------------------------------------------------ +-- | Deletes the specified customer +deleteCustomer + :: CustomerId -- ^ The `CustomerId` of the `Customer` to delete + -> Stripe StripeDeleteResult +deleteCustomer customerid = callAPI request + where request = StripeRequest DELETE url params + url = "customers" getCustomerId customerid + params = [] + +------------------------------------------------------------------------------ +-- | Retrieves a customer by his/her ID. +getCustomer + :: CustomerId -- ^ The `CustomerId` of the `Customer` to retrieve + -> Stripe Customer +getCustomer customerid = + getCustomerExpandable customerid [] + +------------------------------------------------------------------------------ +-- | Retrieves a customer by his/her `CustomerID` with `ExpandParams` +getCustomerExpandable + :: CustomerId -- ^ The `CustomerId` of the `Customer` to retrieve + -> ExpandParams -- ^ The `ExpandParams` of the object to expand + -> Stripe Customer +getCustomerExpandable + customerid + expandParams = callAPI request + where request = StripeRequest GET url params + url = "customers" getCustomerId customerid + params = toExpandable expandParams + +------------------------------------------------------------------------------ +-- | Retrieve up to 100 customers at a time +getCustomers + :: Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter CustomerId -- ^ Paginate starting after the following `CustomerId` + -> EndingBefore CustomerId -- ^ Paginate ending before the following `CustomerId` + -> Stripe (StripeList Customer) +getCustomers + limit + startingAfter + endingBefore = + getCustomersExpandable limit startingAfter endingBefore [] + +------------------------------------------------------------------------------ +-- | Retrieve up to 100 customers at a time +getCustomersExpandable + :: Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter CustomerId -- ^ Paginate starting after the following `CustomerId` + -> EndingBefore CustomerId -- ^ Paginate ending before the following `CustomerId` + -> ExpandParams -- ^ Get Customers with `ExpandParams` + -> Stripe (StripeList Customer) +getCustomersExpandable + limit + startingAfter + endingBefore + expandParams = callAPI request + where request = StripeRequest GET url params + url = "customers" + params = getParams [ + ("limit", toText `fmap` limit ) + , ("starting_after", (\(CustomerId x) -> x) `fmap` startingAfter) + , ("ending_before", (\(CustomerId x) -> x) `fmap` endingBefore) + ] ++ toExpandable expandParams + + diff --git a/src/Web/Stripe/Discount.hs b/src/Web/Stripe/Discount.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/Discount.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE OverloadedStrings #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Discount +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#discounts > +-- +-- @ +-- import Web.Stripe +-- import Web.Stripe.Discount +-- import Web.Stripe.Customer +-- +-- main :: IO () +-- main = do +-- let config = SecretKey "secret_key" +-- result <- stripe config $ deleteCustomerDiscount (CustomerId "customer_id") +-- case result of +-- Right deleteResult -> print deleteResult +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.Discount + ( -- * API + deleteCustomerDiscount + , deleteSubscriptionDiscount + -- * Types + , StripeDeleteResult (..) + , CustomerId (..) + , SubscriptionId (..) + , Discount (..) + ) where + +import Web.Stripe.Client.Internal (Method (DELETE), Stripe, + StripeRequest (..), callAPI, + ()) +import Web.Stripe.Types (CustomerId (..), Discount(..), + StripeDeleteResult (..), + SubscriptionId (..)) +import Web.Stripe.Types.Util (getCustomerId) + +------------------------------------------------------------------------------ +-- | Delete `Customer` `Discount` by `CustomerId` +deleteCustomerDiscount + :: CustomerId -- ^ The `Customer` upon which to remove the `Discount` + -> Stripe StripeDeleteResult +deleteCustomerDiscount + customerId = callAPI request + where request = StripeRequest DELETE url params + url = "customers" getCustomerId customerId "discount" + params = [] + +------------------------------------------------------------------------------ +-- | Delete `Subscription` `Discount` by `CustomerId` and `SubscriptionId` +deleteSubscriptionDiscount + :: CustomerId -- ^ The `Customer` to remove the `Discount` from + -> SubscriptionId -- ^ The `Subscription` to remove the `Discount` from + -> Stripe StripeDeleteResult +deleteSubscriptionDiscount + customerId + (SubscriptionId subId) = callAPI request + where request = StripeRequest DELETE url params + url = "customers" getCustomerId customerId "subscriptions" subId "discount" + params = [] diff --git a/src/Web/Stripe/Dispute.hs b/src/Web/Stripe/Dispute.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/Dispute.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE OverloadedStrings #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Dispute +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#diputes > +-- +-- @ +-- import Web.Stripe +-- import Web.Stripe.Charge +-- import Web.Stripe.Dispute +-- +-- main :: IO () +-- main = do +-- let config = SecretKey "secret_key" +-- result <- stripe config $ do +-- Charge { chargeDispute = dispute } <- getCharge (ChargeId "charge_id") +-- return dispute +-- case result of +-- Right (Just dispute) -> print dispute +-- Right Nothing -> print "no dispute on this charge" +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.Dispute + ( -- * API + updateDispute + , closeDispute + -- * Types + , ChargeId (..) + , Dispute (..) + , DisputeReason (..) + , DisputeStatus (..) + , Evidence (..) + ) where + +import Web.Stripe.Client.Internal (Method (POST), Stripe, + StripeRequest (..), callAPI, + getParams, (), toMetaData) +import Web.Stripe.Types (ChargeId (..), Dispute (..), + DisputeReason (..), + DisputeStatus (..), + Evidence (..), MetaData) +import Web.Stripe.Types.Util (getChargeId) + +------------------------------------------------------------------------------ +-- | `Dispute` to be updated +updateDispute + :: ChargeId -- ^ The ID of the Charge being disputed + -> Maybe Evidence -- ^ Text-only evidence of the dispute + -> MetaData -- ^ `MetaData` associated with `Dispute` + -> Stripe Dispute +updateDispute + chargeId + evidence + metadata = callAPI request + where request = StripeRequest POST url params + url = "charges" getChargeId chargeId "dispute" + params = toMetaData metadata ++ getParams [ + ("evidence", (\(Evidence x) -> x) `fmap` evidence) + ] +------------------------------------------------------------------------------ +-- | `Dispute` to be closed +closeDispute + :: ChargeId -- ^ The ID of the Charge being disputed + -> Stripe Dispute +closeDispute + chargeId = callAPI request + where request = StripeRequest POST url params + url = "charges" getChargeId chargeId "dispute" "close" + params = [] diff --git a/src/Web/Stripe/Event.hs b/src/Web/Stripe/Event.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/Event.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE OverloadedStrings #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Event +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#events > +-- +-- @ +-- import Web.Stripe +-- import Web.Stripe.Event +-- +-- main :: IO () +-- main = do +-- let config = SecretKey "secret_key" +-- result <- stripe config $ getEvents Nothing Nothing Nothing +-- case result of +-- Right events -> print events +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.Event + ( -- * API + getEvent + , getEvents + -- * Types + , EventId (..) + , Event (..) + , EventData (..) + , EventType (..) + , StripeList (..) + , Limit + ) where + +import Web.Stripe.Client.Internal (Method (GET), Stripe, Stripe, + StripeRequest (..), callAPI, (), getParams, toText) +import Web.Stripe.Types (Event (..), EventId (..), Limit, EventData(..), + EventType(..), StripeList (..), Limit, + StartingAfter, EndingBefore) + +------------------------------------------------------------------------------ +-- | `Event` to retrieve by `EventId` +getEvent + :: EventId -- ^ The ID of the Event to retrieve + -> Stripe Event +getEvent (EventId eventid) = callAPI request + where request = StripeRequest GET url params + url = "events" eventid + params = [] + +------------------------------------------------------------------------------ +-- | `StripeList` of `Event`s to retrieve +getEvents + :: Maybe Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter EventId -- ^ Paginate starting after the following `EventId` + -> EndingBefore EventId -- ^ Paginate ending before the following `EventId` + -> Stripe (StripeList Event) +getEvents + limit + startingAfter + endingBefore = callAPI request + where request = StripeRequest GET url params + url = "events" + params = getParams [ + ("limit", toText `fmap` limit ) + , ("starting_after", (\(EventId x) -> x) `fmap` startingAfter) + , ("ending_before", (\(EventId x) -> x) `fmap` endingBefore) + ] + + diff --git a/src/Web/Stripe/Invoice.hs b/src/Web/Stripe/Invoice.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/Invoice.hs @@ -0,0 +1,197 @@ +{-# LANGUAGE OverloadedStrings #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Invoice +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#invoices > +-- +-- @ +-- 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 = SecretKey "secret_key" +-- result <- stripe config $ do +-- Customer { customerId = cid } <- createEmptyCustomer +-- Plan { } <- createPlan (PlanId "planid") 20 USD Day "testplan" [] +-- InvoiceItem { } <- createInvoiceItem cid 100 USD Nothing Nothing Nothing [] +-- createInvoice cid [] +-- case result of +-- Right invoice -> print invoice +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.Invoice + ( -- * API + createInvoice + , getInvoice + , getInvoiceExpandable + , getInvoices + , getInvoicesExpandable + , getInvoiceLineItems + , getUpcomingInvoice + , getUpcomingInvoices + , updateInvoice + , payInvoice + -- * Types + , Invoice (..) + , InvoiceId (..) + , InvoiceLineItem (..) + , InvoiceLineItemId (..) + , InvoiceLineItemType (..) + , Discount (..) + , Period (..) + ) where + +import Web.Stripe.Client.Internal +import Web.Stripe.Types +import Web.Stripe.Types.Util + +------------------------------------------------------------------------------ +-- | The `Invoice` to be created for a `Customer` +createInvoice + :: CustomerId -- ^ `CustomerId` of `Customer` to `Invoice` + -> MetaData -- ^ `MetaData` of `Customer` to `Invoice` + -> Stripe Invoice +createInvoice + customerid + metadata = callAPI request + where request = StripeRequest POST url params + url = "invoices" + params = toMetaData metadata ++ getParams [ + ("customer", Just $ getCustomerId customerid) + ] + +------------------------------------------------------------------------------ +-- | Retrieve an `Invoice` by `InvoiceId` +getInvoice + :: InvoiceId -- ^ Get an `Invoice` by `InvoiceId` + -> Stripe Invoice +getInvoice + invoiceid = getInvoiceExpandable invoiceid [] + +------------------------------------------------------------------------------ +-- | Retrieve an `Invoice` by `InvoiceId` with `ExpandParams` +getInvoiceExpandable + :: InvoiceId -- ^ Get an `Invoice` by `InvoiceId` + -> ExpandParams -- ^ `ExpandParams` of the objects for expansion + -> Stripe Invoice +getInvoiceExpandable + invoiceid + expandParams = callAPI request + where request = StripeRequest GET url params + url = "invoices" getInvoiceId invoiceid + params = toExpandable expandParams + +------------------------------------------------------------------------------ +-- | Retrieve a `StripeList` of `Invoice`s +getInvoices + :: Maybe Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter InvoiceItemId -- ^ Paginate starting after the following `Customer` + -> EndingBefore InvoiceItemId -- ^ Paginate ending before the following `CustomerID` + -> Stripe (StripeList Invoice) +getInvoices + limit + startingAfter + endingBefore = + getInvoicesExpandable limit startingAfter endingBefore [] + +------------------------------------------------------------------------------ +-- | Retrieve a `StripeList` of `Invoice`s with `ExpandParams` +getInvoicesExpandable + :: Maybe Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter InvoiceItemId -- ^ Paginate starting after the following `Customer` + -> EndingBefore InvoiceItemId -- ^ Paginate ending before the following `CustomerID` + -> ExpandParams -- ^ `ExpandParams` of the objects for expansion + -> Stripe (StripeList Invoice) +getInvoicesExpandable + limit + startingAfter + endingBefore + expandParams = callAPI request + where request = StripeRequest GET url params + url = "invoices" + params = getParams [ + ("limit", toText `fmap` limit ) + , ("starting_after", (\(InvoiceItemId x) -> x) `fmap` startingAfter) + , ("ending_before", (\(InvoiceItemId x) -> x) `fmap` endingBefore) + ] ++ toExpandable expandParams + +------------------------------------------------------------------------------ +-- | Retrieve an `Invoice` by `InvoiceId` +getInvoiceLineItems + :: InvoiceId -- ^ Get an `Invoice` by `InvoiceId` + -> Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter InvoiceLineItemId -- ^ Paginate starting after the following `InvoiceLineItemId` + -> EndingBefore InvoiceLineItemId -- ^ Paginate ending before the following `InvoiceLineItemId` + -> Stripe (StripeList InvoiceLineItem) +getInvoiceLineItems + invoiceid + limit + startingAfter + endingBefore = callAPI request + where request = StripeRequest GET url params + url = "invoices" getInvoiceId invoiceid "lines" + params = getParams [ + ("limit", toText `fmap` limit ) + , ("starting_after", (\(InvoiceLineItemId x) -> x) `fmap` startingAfter) + , ("ending_before", (\(InvoiceLineItemId x) -> x) `fmap` endingBefore) + ] + + +------------------------------------------------------------------------------ +-- | Pay `Invoice` by `InvoiceId` +payInvoice + :: InvoiceId -- ^ The `InvoiceId` of the `Invoice` to pay + -> Stripe Invoice +payInvoice + invoiceid = callAPI request + where request = StripeRequest POST url params + url = "invoices" getInvoiceId invoiceid "pay" + params = [] + +------------------------------------------------------------------------------ +-- | Update `Invoice` by `InvoiceId` +updateInvoice + :: InvoiceId -- ^ The `InvoiceId` of the `Invoice` to update + -> MetaData -- ^ `MetaData` of `Customer` to `Invoice` + -> Stripe Invoice +updateInvoice + invoiceid + metadata = callAPI request + where request = StripeRequest POST url params + url = "invoices" getInvoiceId invoiceid + params = toMetaData metadata + +------------------------------------------------------------------------------ +-- | Retrieve an upcoming `Invoice` for a `Customer` by `CustomerId` +getUpcomingInvoice + :: CustomerId -- ^ The `InvoiceId` of the `Invoice` to retrieve + -> Stripe Invoice +getUpcomingInvoice + customerid = callAPI request + where request = StripeRequest GET url params + url = "invoices" "upcoming" + params = getParams [ + ("customer", Just $ getCustomerId customerid) + ] + +------------------------------------------------------------------------------ +-- | Retrieve a `StripeList` of `Invoice`s +getUpcomingInvoices + :: CustomerId -- ^ The `InvoiceId` of the `Invoice` to retrieve + -> Stripe (StripeList Invoice) +getUpcomingInvoices + customerid = callAPI request + where request = StripeRequest GET url params + url = "invoices" + params = getParams [ + ("customer", Just $ getCustomerId customerid) + ] diff --git a/src/Web/Stripe/InvoiceItem.hs b/src/Web/Stripe/InvoiceItem.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/InvoiceItem.hs @@ -0,0 +1,189 @@ +{-# LANGUAGE OverloadedStrings #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.InvoiceItem +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#invoiceitems > +-- +-- @ +-- import Web.Stripe +-- import Web.Stripe.Customer +-- import Web.Stripe.InvoiceItem +-- +-- main :: IO () +-- main = do +-- let config = SecretKey "secret_key" +-- result <- stripe config $ do +-- Customer { customerId = cid } <- createEmptyCustomer +-- createInvoiceItem cid 100 USD Nothing Nothing (Just "description") [] +-- case result of +-- Right invoiceitem -> print invoiceitem +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.InvoiceItem + ( -- * API + createInvoiceItem + , getInvoiceItem + , getInvoiceItemExpandable + , getInvoiceItems + , getInvoiceItemsExpandable + , updateInvoiceItem + , deleteInvoiceItem + -- * Types + , InvoiceItemId (..) + , InvoiceItem (..) + , CustomerId (..) + , Currency (..) + , InvoiceId (..) + , Invoice (..) + , SubscriptionId (..) + , StripeDeleteResult (..) + , StripeList (..) + , Description + , Amount + ) where + +import Web.Stripe.Client.Internal (Method (GET, POST, DELETE), Stripe, + StripeRequest (..), callAPI, toMetaData, toExpandable, + getParams, toText, (), toTextLower) +import Web.Stripe.Types (Amount, Currency (..), StripeList(..), + CustomerId (..), Description, + InvoiceId (..), InvoiceItem (..), Invoice(..), + InvoiceItemId (..), Limit, StartingAfter, EndingBefore, + StripeDeleteResult (..), ExpandParams, + SubscriptionId (..), MetaData) +import Web.Stripe.Types.Util + +------------------------------------------------------------------------------ +-- | Create an invoice for a Customer +createInvoiceItem + :: CustomerId -- ^ `CustomerId` of `Customer` on which to create an `InvoiceItem` + -> Amount -- ^ `Amount` associated with `InvoiceItem` + -> Currency -- ^ `Currency` to use for `InvoiceItem` + -> Maybe InvoiceId -- ^ `InvoiceId` to use for `InvoiceItem` + -> Maybe SubscriptionId -- ^ `SubscriptionId` to use for `InvoiceItem` + -> Maybe Description -- ^ `Description` to use for `InvoiceItem` + -> MetaData -- ^ `MetaData` to use for `InvoiceItem` + -> Stripe InvoiceItem +createInvoiceItem + customerid + amount + currency + invoiceid + subscriptionId + description + metadata = callAPI request + where request = StripeRequest POST url params + url = "invoiceitems" + params = toMetaData metadata ++ getParams [ + ("customer", Just $ getCustomerId customerid) + , ("amount", toText `fmap` Just amount) + , ("currency", toTextLower `fmap` Just currency) + , ("invoice", (\(InvoiceId x) -> x) `fmap` invoiceid) + , ("subscription", (\(SubscriptionId x) -> x) `fmap` subscriptionId) + , ("description", description) + ] + +------------------------------------------------------------------------------ +-- | Retrieve an `InvoiceItem` by `InvoiceItemId` +getInvoiceItems + :: Maybe CustomerId -- ^ When specified, only `InvoiceItems` for this `Customer` are returned + -> Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter InvoiceItemId -- ^ Paginate starting after the following `InvoiceItemId` + -> EndingBefore InvoiceItemId -- ^ Paginate ending before the following `InvoiceItemId` + -> Stripe (StripeList InvoiceItem) +getInvoiceItems + customerid + limit + startingAfter + endingBefore = callAPI request + where request = StripeRequest GET url params + url = "invoiceitems" + params = getParams [ + ("limit", toText `fmap` limit ) + , ("starting_after", (\(InvoiceItemId x) -> x) `fmap` startingAfter) + , ("ending_before", (\(InvoiceItemId x) -> x) `fmap` endingBefore) + , ("customer", (\(CustomerId x) -> x) `fmap` customerid) + ] + +------------------------------------------------------------------------------ +-- | Retrieve an `InvoiceItem` by `InvoiceItemId` with `ExpandParams` +getInvoiceItemsExpandable + :: Maybe CustomerId -- ^ When specified, only `InvoiceItems` for this `Customer` are returned + -> Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter InvoiceItemId -- ^ Paginate starting after the following `InvoiceItemId` + -> EndingBefore InvoiceItemId -- ^ Paginate ending before the following `InvoiceItemId` + -> ExpandParams -- ^ `ExpandParams` of the objects for expansion + -> Stripe (StripeList InvoiceItem) +getInvoiceItemsExpandable + customerid + limit + startingAfter + endingBefore + expandParams = callAPI request + where request = StripeRequest GET url params + url = "invoiceitems" + params = getParams [ + ("limit", toText `fmap` limit ) + , ("starting_after", (\(InvoiceItemId x) -> x) `fmap` startingAfter) + , ("ending_before", (\(InvoiceItemId x) -> x) `fmap` endingBefore) + , ("customer", (\(CustomerId x) -> x) `fmap` customerid) + ] ++ toExpandable expandParams + +------------------------------------------------------------------------------ +-- | Retrieve an `InvoiceItem` by `InvoiceItemId` +getInvoiceItem + :: InvoiceItemId -- ^ `InvoiceItemId` of `InvoiceItem` to retrieve + -> Stripe InvoiceItem +getInvoiceItem + invoiceitemid = + getInvoiceItemExpandable invoiceitemid [] + +------------------------------------------------------------------------------ +-- | Retrieve an `InvoiceItem` by `InvoiceItemId` +getInvoiceItemExpandable + :: InvoiceItemId -- ^ `InvoiceItemId` of `InvoiceItem` to retrieve + -> ExpandParams -- ^ `ExpandParams` of the objects for expansion + -> Stripe InvoiceItem +getInvoiceItemExpandable + invoiceitemid + expandParams = callAPI request + where request = StripeRequest GET url params + url = "invoiceitems" getInvoiceItemId invoiceitemid + params = toExpandable expandParams + +------------------------------------------------------------------------------ +-- | Update an `InvoiceItem` by `InvoiceItemId` +updateInvoiceItem + :: InvoiceItemId -- ^ `InvoiceItemId` of to update + -> Maybe Amount -- ^ `Amount` in cents of the charge to be applied to the invoice + -> Maybe Description -- ^ `Amount` in cents of the charge to be applied to the invoice + -> MetaData -- ^ `MetaData` of `InvoiceItem` to update + -> Stripe InvoiceItem +updateInvoiceItem + invoiceitemid + amount + description + metadata = callAPI request + where request = StripeRequest POST url params + url = "invoiceitems" getInvoiceItemId invoiceitemid + params = toMetaData metadata ++ getParams [ + ("amount", toText `fmap` amount) + , ("description", description) + ] + +------------------------------------------------------------------------------ +-- | Delete an `InvoiceItem` by `InvoiceItemId` +deleteInvoiceItem + :: InvoiceItemId -- ^ `InvoiceItemdId` of `InvoiceItem` to be deleted + -> Stripe StripeDeleteResult +deleteInvoiceItem + invoiceitemid = callAPI request + where request = StripeRequest DELETE url params + url = "invoiceitems" getInvoiceItemId invoiceitemid + params = [] + diff --git a/src/Web/Stripe/Plan.hs b/src/Web/Stripe/Plan.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/Plan.hs @@ -0,0 +1,259 @@ +{-# LANGUAGE OverloadedStrings #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Plan +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#plans > +-- +-- @ +-- import Web.Stripe +-- import Web.Stripe.Plan +-- +-- main :: IO () +-- main = do +-- let config = SecretKey "secret_key" +-- result <- stripe config $ do +-- createPlan (PlanId "free plan") +-- (0 :: Amount) +-- (USD :: Currency) +-- (Month :: Interval) +-- ("a sample free plan" :: Name) +-- ([] :: MetaData) +-- case result of +-- Right plan -> print plan +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.Plan + ( -- * API + createPlan + , createPlanIntervalCount + , createPlanTrialPeriodDays + , createPlanBase + , getPlan + , getPlans + , updatePlanName + , updatePlanDescription + , updatePlanBase + , deletePlan + -- * Types + , PlanId (..) + , Plan (..) + , Interval (..) + , StripeList (..) + , IntervalCount (..) + , TrialPeriodDays (..) + , StripeDeleteResult (..) + , Currency (..) + , Limit + , StartingAfter + , EndingBefore + , Name + , Amount + , Description + , MetaData + ) where + +import Web.Stripe.Client.Internal (callAPI, Method(POST, GET, DELETE), toText, + getParams, toMetaData, Stripe, + StripeRequest(..), toTextLower, ()) + +import Web.Stripe.Types (PlanId (..) , Plan (..), Interval (..), StripeList(..), + IntervalCount (..), TrialPeriodDays (..), Limit, + StartingAfter, EndingBefore, StripeDeleteResult(..), + Currency (..), Name, Amount, Description, MetaData) + +------------------------------------------------------------------------------ +-- | Base Request for creating a 'Plan', useful for making custom `Plan` creation requests +createPlanBase + :: PlanId -- ^ Unique string used to identify `Plan` + -> Amount -- ^ Positive integer in cents representing how much to charge on a recurring basis + -> Currency -- ^ `Currency` of `Plan` + -> Interval -- ^ Billing Frequency (i.e. `Day`, `Week` or `Month`) + -> Name -- ^ Name of `Plan` to be displayed on `Invoice`s + -> Maybe IntervalCount -- ^ Number of intervals between each `Subscription` billing, default 1 + -> Maybe TrialPeriodDays -- ^ Integer number of days a trial will have + -> Maybe Description -- ^ An arbitrary string to be displayed on `Customer` credit card statements + -> MetaData -- ^ `MetaData` for the `Plan` + -> Stripe Plan +createPlanBase + (PlanId planid) + amount + currency + interval + name + intervalCount + trialPeriodDays + description + metadata = callAPI request + where request = StripeRequest POST url params + url = "plans" + params = toMetaData metadata ++ getParams [ + ("id", Just planid) + , ("amount", toText `fmap` Just amount) + , ("currency", toTextLower `fmap` Just currency) + , ("interval", toText `fmap` Just interval) + , ("name", Just name) + , ("interval_count", (\(IntervalCount x) -> toText x) `fmap` intervalCount ) + , ("trial_period_days", (\(TrialPeriodDays x) -> toText x) `fmap` trialPeriodDays ) + , ("statement_description", description ) + ] + +------------------------------------------------------------------------------ +-- | Create a `Plan` +createPlan + :: PlanId -- ^ Unique string used to identify `Plan` + -> Amount -- ^ Positive integer in cents (or 0 for a free plan) representing how much to charge on a recurring basis + -> Currency -- ^ `Currency` of `Plan` + -> Interval -- ^ Billing Frequency + -> Name -- ^ Name of `Plan` to be displayed on `Invoice`s + -> MetaData -- ^ MetaData for the Plan + -> Stripe Plan +createPlan + planid + amount + currency + intervalCount + name = createPlanBase planid amount currency intervalCount name Nothing Nothing Nothing + +------------------------------------------------------------------------------ +-- | Create a `Plan` with a specified `IntervalCount` +createPlanIntervalCount + :: PlanId -- ^ Unique string used to identify `Plan` + -> Amount -- ^ Positive integer in cents (or 0 for a free plan) representing how much to charge on a recurring basis + -> Currency -- ^ `Currency` of `Plan` + -> Interval -- ^ Billing Frequency + -> Name -- ^ Name of `Plan` to be displayed on `Invoice`s + -> IntervalCount -- ^ # of billins between each `Subscription` billing + -> Stripe Plan +createPlanIntervalCount + planid + amount + currency + interval + name + intervalCount = createPlanBase planid amount + currency interval name + (Just intervalCount) Nothing Nothing [] + +------------------------------------------------------------------------------ +-- | Create a `Plan` with a specified number of `TrialPeriodDays` +createPlanTrialPeriodDays + :: PlanId -- ^ Unique string used to identify `Plan` + -> Amount -- ^ Positive integer in cents (or 0 for a free plan) representing how much to charge on a recurring basis + -> Currency -- ^ `Currency` of `Plan` + -> Interval -- ^ Billing Frequency + -> Name -- ^ Name of `Plan` to be displayed on `Invoice`s + -> TrialPeriodDays -- ^ Number of Trial Period Days to be displayed on `Invoice`s + -> Stripe Plan +createPlanTrialPeriodDays + planid + amount + currency + interval + name + trialPeriodDays = + createPlanBase + planid + amount + currency + interval + name + Nothing + (Just trialPeriodDays) + Nothing + [] + +------------------------------------------------------------------------------ +-- | Retrieve a `Plan` +getPlan + :: PlanId -- ^ The ID of the plan to retrieve + -> Stripe Plan +getPlan + (PlanId planid) = callAPI request + where request = StripeRequest GET url params + url = "plans" planid + params = [] + +------------------------------------------------------------------------------ +-- | Retrieve a `Plan` +getPlans + :: Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter PlanId -- ^ Paginate starting after the following `CustomerID` + -> EndingBefore PlanId -- ^ Paginate ending before the following `CustomerID` + -> Stripe (StripeList Plan) +getPlans + limit + startingAfter + endingBefore = callAPI request + where request = StripeRequest GET url params + url = "plans" + params = getParams [ + ("limit", toText `fmap` limit ) + , ("starting_after", (\(PlanId x) -> x) `fmap` startingAfter) + , ("ending_before", (\(PlanId x) -> x) `fmap` endingBefore) + ] + +------------------------------------------------------------------------------ +-- | Base Request for updating a `Plan`, useful for creating customer `Plan` update functions +updatePlanBase + :: PlanId -- ^ The ID of the `Plan` to update + -> Maybe Name -- ^ The `Name` of the `Plan` to update + -> Maybe Description -- ^ The `Description` of the `Plan` to update + -> MetaData -- ^ The `MetaData` for the `Plan` + -> Stripe Plan +updatePlanBase + (PlanId planid) + name + description + metadata = callAPI request + where request = StripeRequest POST url params + url = "plans" planid + params = toMetaData metadata ++ getParams [ + ("name", name) + , ("statement_description", description) + ] + +------------------------------------------------------------------------------ +-- | Update a `Plan` `Description` +updatePlanDescription + :: PlanId -- ^ The ID of the `Plan` to update + -> Description -- ^ The `Description` of the `Plan` to update + -> Stripe Plan +updatePlanDescription + (PlanId planid) + description = callAPI request + where request = StripeRequest POST url params + url = "plans" planid + params = getParams [ + ("statement_description", Just description) + ] + +------------------------------------------------------------------------------ +-- | Update a `Plan` `Name` +updatePlanName + :: PlanId -- ^ The ID of the `Plan` to update + -> Description -- ^ The `Name` of the `Plan` to update + -> Stripe Plan +updatePlanName + (PlanId planid) + name = callAPI request + where request = StripeRequest POST url params + url = "plans" planid + params = getParams [ + ("name", Just name) + ] + +------------------------------------------------------------------------------ +-- | Delete a `Plan` +deletePlan + :: PlanId -- ^ The ID of the `Plan` to delete + -> Stripe StripeDeleteResult +deletePlan + (PlanId planid) = callAPI request + where request = StripeRequest DELETE url params + url = "plans" planid + params = [] diff --git a/src/Web/Stripe/Recipient.hs b/src/Web/Stripe/Recipient.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/Recipient.hs @@ -0,0 +1,554 @@ +{-# LANGUAGE OverloadedStrings #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Recipient +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#recipients > +-- +-- @ +-- import Web.Stripe +-- import Web.Stripe.Recipient +-- +-- main :: IO () +-- main = do +-- let config = SecretKey "secret_key" +-- result <- stripe config $ +-- createRecipient (FirstName "simon") +-- (LastName "marlow") +-- Nothing -- what is Simon Marlow's middle initial? +-- (Invidiual :: RecipientType) +-- case result of +-- Right recipient -> print recipient +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.Recipient + ( -- * API + createRecipient + , createRecipientByCard + , createRecipientByToken + , createRecipientByBank + , createRecipientBase + , getRecipient + , getRecipientExpandable + , getRecipients + , getRecipientsExpandable + , updateRecipientName + , updateRecipientTaxID + , updateRecipientBankAccount + , updateRecipientTokenID +-- , updateRecipientCard + , updateRecipientDefaultCard + , updateRecipientEmail + , updateRecipientDescription + , updateRecipientMetaData + , updateRecipientBase + , deleteRecipient + -- * Types + , Recipient (..) + , RecipientId (..) + , FirstName (..) + , LastName (..) + , MiddleInitial + , RecipientType (..) + , TaxID + , BankAccount (..) + , TokenId + , CardNumber + , ExpMonth + , Email (..) + , ExpYear + , CVC + , Description + , Limit + , StripeDeleteResult (..) + , RoutingNumber (..) + , AccountNumber (..) + , Country (..) + , AddressCity (..) + , AddressCountry (..) + , AddressLine1 (..) + , AddressLine2 (..) + , AddressState (..) + , AddressZip (..) + , BankAccountId (..) + , BankAccountStatus (..) + ) where + +import Data.Monoid ((<>)) +import qualified Data.Text as T + +import Web.Stripe.Client.Internal (callAPI, Method(POST,GET,DELETE), Stripe, + StripeRequest(..), toMetaData, getParams, + toText, toExpandable, ()) +import Web.Stripe.Types (AccountNumber (..), + BankAccount (..), CVC, CVC (..), + CardId (..), CardNumber, BankAccountId (..), BankAccountStatus(..), + CardNumber (..), Country (..), + Description, Email, Email (..), + ExpMonth, ExpMonth (..), ExpYear, + RoutingNumber (..), AccountNumber (..), + Country (..), AddressCity (..), + AddressCountry (..), AddressLine1 (..), + AddressLine2 (..), AddressState (..), + AddressZip (..), ExpYear (..), + FirstName (..), LastName (..), Limit, + MiddleInitial, Recipient (..), + RecipientId (..), ExpandParams, + RecipientType (..), StripeDeleteResult(..), + RoutingNumber (..), EndingBefore, StartingAfter, + StripeList (..), TaxID, TokenId, + TokenId (..), MetaData) +import Web.Stripe.Types.Util (getRecipientId) + +------------------------------------------------------------------------------ +-- | Base Request for issues create `Recipient` requests +createRecipientBase + :: FirstName -- ^ First Name of `Recipient` + -> LastName -- ^ Last Name of `Recipient` + -> Maybe MiddleInitial -- ^ Middle Initial of `Recipient` + -> RecipientType -- ^ `Individual` or `Corporation` + -> Maybe TaxID -- ^ SSN for `Individual`, EIN for `Corporation` + -> Maybe Country -- ^ `Country` of BankAccount to attach to `Recipient` + -> Maybe RoutingNumber -- ^ `RoutingNumber` of BankAccount to attach to `Recipient` + -> Maybe AccountNumber -- ^ `AccountNumber` of BankAccount to attach to `Recipient` + -> Maybe TokenId -- ^ `TokenId` of `Card` or `BankAccount` to attach to a `Recipient` + -> Maybe CardNumber -- ^ `CardNumber` to attach to `Card` of `Recipient` + -> Maybe ExpMonth -- ^ Expiration Month of `Card` + -> Maybe ExpYear -- ^ Expiration Year of `Card` + -> Maybe CVC -- ^ CVC of Card + -> Maybe Email -- ^ Create `Email` with `Recipient` + -> Maybe Description -- ^ Create `Description` with `Recipient` + -> MetaData -- ^ The `MetaData` associated with the `Recipient` + -> Stripe Recipient +createRecipientBase + (FirstName firstName) + (LastName lastName) + middleInitial + recipienttype + taxId + country + routingNumber + accountNumber + tokenId + cardNumber + expMonth + expYear + cvc + email + description + metadata = callAPI request + where request = StripeRequest POST url params + url = "recipients" + params = + let name = firstName <> middle <> lastName + middle = maybe " " (\x -> " " <> T.singleton x <> " ") middleInitial + in toMetaData metadata ++ getParams [ + ("name", Just name) + , ("type", toText `fmap` Just recipienttype) + , ("tax_id", taxId) + , ("bank_account[country]", (\(Country x) -> x) `fmap` country) + , ("bank_account[routing_number]", (\(RoutingNumber x ) -> x) `fmap` routingNumber) + , ("bank_account[account_number]", (\(AccountNumber x ) -> x) `fmap` accountNumber) + , ("card", (\(TokenId x) -> x) `fmap` tokenId) + , ("card[number]", (\(CardNumber x) -> x) `fmap` cardNumber) + , ("card[exp_month]", (\(ExpMonth x) -> toText x) `fmap` expMonth) + , ("card[exp_year]", (\(ExpYear x) -> toText x) `fmap` expYear) + , ("card[cvc]", (\(CVC x) -> x) `fmap` cvc) + , ("email", (\(Email x) -> x) `fmap` email) + , ("description", description) + ] +------------------------------------------------------------------------------ +-- | Create a `Recipient` +createRecipient + :: FirstName -- ^ First Name of 'Recipient' + -> LastName -- ^ Last Name of 'Recipient' + -> Maybe MiddleInitial -- ^ Middle Initial of 'Recipient' + -> RecipientType -- ^ 'Individual' or 'Corporation' + -> Stripe Recipient +createRecipient + firstName + lastName + middleInitial + recipienttype + = createRecipientBase firstName lastName middleInitial recipienttype + Nothing Nothing Nothing Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing [] +------------------------------------------------------------------------------ +-- | Create a `Recipient` by a `Card` +createRecipientByCard + :: FirstName -- ^ First Name of 'Recipient' + -> LastName -- ^ Last Name of 'Recipient' + -> Maybe MiddleInitial -- ^ Middle Initial of 'Recipient' + -> RecipientType -- ^ 'Individual' or 'Corporation' + -> CardNumber -- ^ 'Card' Number + -> ExpMonth -- ^ Expiration Month + -> ExpYear -- ^ Expiration Year + -> CVC -- ^ 'CVC' (i.e. 117) + -> Stripe Recipient +createRecipientByCard + firstName + lastName + middleInitial + recipienttype + cardNumber + expMonth + expYear + cvc + = createRecipientBase firstName lastName middleInitial recipienttype + Nothing Nothing Nothing Nothing Nothing (Just cardNumber) (Just expMonth) + (Just expYear) (Just cvc) Nothing Nothing [] + +------------------------------------------------------------------------------ +-- | Create a `Recipient` by specifying a `TokenId` +createRecipientByToken + :: FirstName -- ^ First Name of `Recipient` + -> LastName -- ^ Last Name of `Recipient` + -> Maybe MiddleInitial -- ^ Middle Initial of `Recipient` + -> RecipientType -- ^ `Individual` or `Corporation` + -> TokenId -- ^ `TokenId` received from stripe.js or Token API + -> Stripe Recipient +createRecipientByToken + firstName + lastName + middleInitial + recipienttype + tokenId + = createRecipientBase firstName lastName middleInitial recipienttype + Nothing Nothing Nothing Nothing (Just tokenId) Nothing Nothing + Nothing Nothing Nothing Nothing [] + +------------------------------------------------------------------------------ +-- | Create a `Recipient` with a `BankAccount` +createRecipientByBank + :: FirstName -- ^ First Name of `Recipient` + -> LastName -- ^ Last Name of `Recipient` + -> Maybe MiddleInitial -- ^ Middle Initial of `Recipient` + -> RecipientType -- ^ `Individual` or `Corporation` + -> Country -- ^ `Country` of BankAccount to attach to `Recipient` + -> RoutingNumber -- ^ `RoutingNumber` of BankAccount to attach to `Recipient` + -> AccountNumber -- ^ `AccountNumber` of BankAccount to attach to `Recipient` + -> Stripe Recipient +createRecipientByBank + firstName + lastName + middleInitial + recipienttype + country + routingNumber + accountNumber + = createRecipientBase firstName lastName middleInitial recipienttype + Nothing (Just country) (Just routingNumber) (Just accountNumber) Nothing Nothing + Nothing Nothing Nothing Nothing Nothing [] + +------------------------------------------------------------------------------ +-- | Retrieve a 'Recipient' +getRecipient + :: RecipientId -- ^ The `RecipientId` of the `Recipient` to be retrieved + -> Stripe Recipient +getRecipient + recipientid = getRecipientExpandable recipientid [] + +------------------------------------------------------------------------------ +-- | Retrieve a `Recipient` +getRecipientExpandable + :: RecipientId -- ^ The `RecipientId` of the `Recipient` to be retrieved + -> ExpandParams -- ^ `ExpandParams` of the object to be expanded + -> Stripe Recipient +getRecipientExpandable + recipientid + expandParams = callAPI request + where request = StripeRequest GET url params + url = "recipients" getRecipientId recipientid + params = toExpandable expandParams + +------------------------------------------------------------------------------ +-- | Retrieve multiple 'Recipient's +getRecipients + :: Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter RecipientId -- ^ Paginate starting after the following `RecipientId` + -> EndingBefore RecipientId -- ^ Paginate ending before the following `RecipientId` + -> Stripe (StripeList Recipient) +getRecipients + limit + startingAfter + endingBefore = + getRecipientsExpandable + limit startingAfter endingBefore [] + +------------------------------------------------------------------------------ +-- | Retrieve multiple 'Recipient's with `ExpandParams` +getRecipientsExpandable + :: Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter RecipientId -- ^ Paginate starting after the following `RecipientId` + -> EndingBefore RecipientId -- ^ Paginate ending before the following `RecipientId` + -> ExpandParams -- ^ `ExpandParams` of the object to be expanded + -> Stripe (StripeList Recipient) +getRecipientsExpandable + limit + startingAfter + endingBefore + expandParams = callAPI request + where request = StripeRequest GET url params + url = "recipients" + params = getParams [ + ("limit", toText `fmap` limit ) + , ("starting_after", (\(RecipientId x) -> x) `fmap` startingAfter) + , ("ending_before", (\(RecipientId x) -> x) `fmap` endingBefore) + ] ++ toExpandable expandParams + + +------------------------------------------------------------------------------ +-- | Base Request for updating a `Recipient`, useful for creating custom `Recipient` update functions +updateRecipientBase + :: RecipientId -- ^ The `RecipientId` of the `Recipient` to be updated + -> Maybe FirstName -- ^ First Name of `Recipient` + -> Maybe LastName -- ^ Last Name of `Recipient` + -> Maybe MiddleInitial -- ^ Middle Initial of `Recipient` + -> Maybe TaxID -- ^ SSN for `Individual`, EIN for `Corporation` + -> Maybe Country -- ^ `Country` of BankAccount to attach to `Recipient` + -> Maybe RoutingNumber -- ^ `RoutingNumber` of BankAccount to attach to `Recipient` + -> Maybe AccountNumber -- ^ `AccountNumber` of BankAccount to attach to `Recipient` + -> Maybe TokenId -- ^ `TokenId` of `Card` to attach to a `Recipient` + -> Maybe CardNumber -- ^ `CardNumber` to attach to `Card` of `Recipient` + -> Maybe ExpMonth -- ^ Expiration Month of `Card` + -> Maybe ExpYear -- ^ Expiration Year of `Card` + -> Maybe CVC -- ^ CVC of Card + -> Maybe CardId -- ^ The Default `Card` for this `Recipient` to use + -> Maybe Email -- ^ Create `Email` with `Recipient` + -> Maybe Description -- ^ Create `Description` with `Recipient` + -> MetaData -- ^ The `MetaData` associated with the `Recipient` + -> Stripe Recipient +updateRecipientBase + recipientid + firstName + lastName + middleInitial + taxId + country + routingNumber + accountNumber + tokenId + cardNumber + expMonth + expYear + cvc + cardId + email + description + metadata = callAPI request + where request = StripeRequest POST url params + url = "recipients" getRecipientId recipientid + params = + let name = if firstName == Nothing || lastName == Nothing + then Nothing + else do let Just (FirstName f) = firstName + Just (LastName l) = lastName + middle = maybe " " (\x -> " " <> T.singleton x <> " ") middleInitial + Just $ f <> middle <> l + in getParams [ + ("name", name) + , ("tax_id", taxId) + , ("bank_account[country]", (\(Country x) -> x) `fmap` country) + , ("bank_account[routing_number]", (\(RoutingNumber x ) -> x) `fmap` routingNumber) + , ("bank_account[account_number]", (\(AccountNumber x ) -> x) `fmap` accountNumber) + , ("card", (\(TokenId x) -> x) `fmap` tokenId) + , ("card[number]", (\(CardNumber x) -> x) `fmap` cardNumber) + , ("card[exp_month]", (\(ExpMonth x) -> toText x) `fmap` expMonth) + , ("card[exp_year]", (\(ExpYear x) -> toText x) `fmap` expYear) + , ("card[cvc]", (\(CVC x) -> x) `fmap` cvc) + , ("default_card", (\(CardId x) -> x) `fmap` cardId) + , ("email", (\(Email x) -> x) `fmap` email) + , ("description", description) + ] ++ toMetaData metadata + +------------------------------------------------------------------------------ +-- | Update a `Recipient` `FirstName`, `LastName` and/or `MiddleInitial` +updateRecipientName + :: RecipientId -- ^ The `RecipientId` of the `Recipient` to be updated + -> FirstName -- ^ First Name of `Recipient` + -> LastName -- ^ Last Name of `Recipient` + -> MiddleInitial -- ^ Middle Initial of `Recipient` + -> Stripe Recipient +updateRecipientName + recipientid + firstName + lastName + middleInitial = updateRecipientBase + recipientid (Just firstName) (Just lastName) (Just middleInitial) + Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing [] + +------------------------------------------------------------------------------ +-- | Update a 'Recipient' 'BankAccount' +-- +-- > runStripe config $ updateRecipient (RecipientId "rp_4lpjaLFB5ecSks") BankAccount { +-- > bankAccountCountry = Country "us" +-- > , bankAccountRoutingNumber = RoutingNumber "071000013" +-- > , bankAccountNumber = AccountNumber "293058719045" +-- > } +-- +updateRecipientBankAccount + :: RecipientId -- ^ The `RecipientId` of the `Recipient` to be updated + -> Country -- ^ `Country` of BankAccount to attach to `Recipient` + -> RoutingNumber -- ^ `RoutingNumber` of BankAccount to attach to `Recipient` + -> AccountNumber -- ^ `AccountNumber` of BankAccount to attach to `Recipient` + -> Stripe Recipient +updateRecipientBankAccount + recipientid + country + routingNumber + accountNumber + = updateRecipientBase + recipientid Nothing Nothing Nothing + Nothing (Just country) (Just routingNumber) + (Just accountNumber) Nothing Nothing + Nothing Nothing Nothing Nothing + Nothing Nothing [] + +------------------------------------------------------------------------------ +-- | Update a `Recipient` `TaxID` +-- +-- > runStripe config $ updateRecipientTaxID (RecipientId "rp_4lpjaLFB5ecSks") "SampleTaxID" +-- +updateRecipientTaxID + :: RecipientId -- ^ The `RecipientId` of the `Recipient` to be updated + -> TaxID -- ^ `TaxID` of `Recipient` to be updated + -> Stripe Recipient +updateRecipientTaxID + recipientid + taxID = updateRecipientBase + recipientid Nothing Nothing Nothing + (Just taxID) Nothing Nothing Nothing + Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing [] + +------------------------------------------------------------------------------ +-- | Update a `Recipient` `Card` by `TokenId` +-- +-- > runStripe config $ updateRecipientTokenId (RecipientId "rp_4lpjaLFB5ecSks") (TokenId "tok_aksdjfh9823") +-- +updateRecipientTokenID + :: RecipientId -- ^ The `RecipientId` of the `Recipient` to be updated + -> TokenId -- ^ `TaxID` of `Recipient` to be updated + -> Stripe Recipient +updateRecipientTokenID + recipientid + tokenId = updateRecipientBase + recipientid Nothing Nothing Nothing + Nothing Nothing Nothing Nothing (Just tokenId) Nothing + Nothing Nothing Nothing Nothing Nothing Nothing [] + +------------------------------------------------------------------------------ +-- | Update a 'Recipient' 'Card' +-- +-- > runStripe config $ updateRecipientCard (RecipientId "rp_4lpjaLFB5ecSks") number month year cvc +-- > where +-- > number = CardNumber "4242424242424242" +-- > month = ExpMonth 12 +-- > year = ExpYear 2018 +-- > cvc = 117 +-- +-- updateRecipientDefaultCard +-- :: RecipientId -- ^ The 'RecipientId' of the 'Recipient' to be updated +-- -> CardNumber -- ^ 'CardNumber' to attach to 'Card' of 'Recipient' +-- -> ExpMonth -- ^ Expiration Month of 'Card' +-- -> ExpYear -- ^ Expiration Year of 'Card' +-- -> CVC -- ^ CVC of Card +-- -> Stripe Recipient +-- updateRecipientCard +-- recipientid +-- cardNumber +-- expMonth +-- expYear +-- cvc = updateRecipientBase +-- recipientid Nothing Nothing Nothing +-- Nothing Nothing Nothing Nothing Nothing (Just cardNumber) +-- (Just expMonth) (Just expYear) (Just cvc) +-- Nothing Nothing Nothing [] + +------------------------------------------------------------------------------ +-- | Update default `Card` of `Recipient` +-- +-- > runStripe config $ updateRecipientDefaultCard (RecipientId "rp_4lpjaLFB5ecSks") (CardId "card_4jQs35jE5wFOor") +-- +updateRecipientDefaultCard + :: RecipientId -- ^ The `RecipientId` of the `Recipient` to be updated + -> CardId -- ^ `CardId` of `Card` to be made default + -> Stripe Recipient +updateRecipientDefaultCard + recipientid + cardId = updateRecipientBase + recipientid Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing + (Just cardId) Nothing Nothing [] + +------------------------------------------------------------------------------ +-- | Update a `Recipient` `Email` Address +-- +-- > runStripe config $ updateRecipientEmail (RecipientId "rp_4lpjaLFB5ecSks") (Email "name@domain.com") +-- +updateRecipientEmail + :: RecipientId -- ^ The `RecipientId` of the `Recipient` to be updated + -> Email -- ^ `Email` of `Recipient` to be updated + -> Stripe Recipient +updateRecipientEmail + recipientid + email = updateRecipientBase + recipientid Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing + Nothing (Just email) Nothing [] + +------------------------------------------------------------------------------ +-- | Update a `Recipient` `Description` +-- +-- > runStripe config $ updateRecipientDescription (RecipientId "rp_4lpjaLFB5ecSks") (Email "name@domain.com") +-- +updateRecipientDescription + :: RecipientId -- ^ The `RecipientId` of the `Recipient` to be updated + -> Description -- ^ `Description` of `Recipient` to be updated + -> Stripe Recipient +updateRecipientDescription + recipientid + description = updateRecipientBase + recipientid Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing + Nothing Nothing (Just description) [] + +------------------------------------------------------------------------------ +-- | Update a `Recipient` `MetaData` +-- +-- > runStripe config $ updateRecipientMetaData (RecipientId "rp_4lpjaLFB5ecSks") [("key", "value")] +-- +updateRecipientMetaData + :: RecipientId -- ^ The `RecipientId` of the `Recipient` to be updated + -> MetaData -- ^ The `MetaData` associated with the `Recipient` + -> Stripe Recipient +updateRecipientMetaData + recipientid + metadata = updateRecipientBase + recipientid Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing + Nothing Nothing Nothing metadata + +------------------------------------------------------------------------------ +-- | Delete a `Recipient` +-- +-- >>> runStripe config $ deleteRecipient (RecipientId "rp_4lpjaLFB5ecSks") +-- +deleteRecipient + :: RecipientId -- ^ `RecipiendId` of `Recipient` to delete + -> Stripe StripeDeleteResult +deleteRecipient + recipientid = callAPI request + where request = StripeRequest DELETE url params + url = "recipients" getRecipientId recipientid + params = [] diff --git a/src/Web/Stripe/Refund.hs b/src/Web/Stripe/Refund.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/Refund.hs @@ -0,0 +1,157 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Refund +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#refunds > +-- +-- @ +-- import Web.Stripe +-- import Web.Stripe.Customer +-- import Web.Stripe.Charge +-- import Web.Stripe.Refund +-- +-- main :: IO () +-- main = do +-- let config = SecretKey "secret_key" +-- credit = CardNumber "4242424242424242" +-- em = ExpMonth 12 +-- ey = ExpYear 2015 +-- cvc = CVC "123" +-- result <- stripe config $ do +-- Customer { customerId = cid } <- createCustomerByCard cn em ey cvc +-- Charge { chargeId = chid } <- chargeCustomer cid USD 100 Nothing +-- createRefund chid ([] :: MetaData) +-- case result of +-- Right refund -> print refund +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.Refund + ( -- * API + createRefund + , getRefund + , getRefundExpandable + , getRefunds + , getRefundsExpandable + , updateRefund + -- * Types + , Refund (..) + , RefundId (..) + , ChargeId (..) + , Charge (..) + , StripeList (..) + ) where + +import Web.Stripe.Client.Internal (Method (GET, POST), Stripe, + StripeRequest (..), callAPI, + getParams, toMetaData, toText, + (), toExpandable) +import Web.Stripe.Types (Charge (..), ChargeId (..), + EndingBefore, Limit, MetaData, + Refund (..), Refund (..), + RefundId (..), StartingAfter, ExpandParams, + StripeList (..)) +import Web.Stripe.Types.Util (getChargeId) + +------------------------------------------------------------------------------ +-- | `Refund` a `Charge` +createRefund + :: ChargeId -- ^ `ChargeId` associated with the `Charge` to be refunded + -> MetaData -- ^ `MetaData` associated with a `Refund` + -> Stripe Refund +createRefund + chargeid + metadata = callAPI request + where request = StripeRequest POST url params + url = "charges" getChargeId chargeid "refunds" + params = toMetaData metadata + +------------------------------------------------------------------------------ +-- | Retrieve a `Refund` by `ChargeId` and `RefundId` +getRefund + :: ChargeId -- ^ `ChargeId` associated with the `Refund` to be retrieved + -> RefundId -- ^ `RefundId` associated with the `Refund` to be retrieved + -> Stripe Refund +getRefund + chargeid + (RefundId refundid) = callAPI request + where request = StripeRequest GET url params + url = "charges" getChargeId chargeid "refunds" refundid + params = [] + +------------------------------------------------------------------------------ +-- | Retrieve a `Refund` by `ChargeId` and `RefundId` with `ExpandParams` +getRefundExpandable + :: ChargeId -- ^ `ChargeId` associated with the `Charge` to be retrieved + -> RefundId -- ^ `RefundId` associated with the `Refund` to be retrieved + -> ExpandParams -- ^ `ExpandParams` of object for expansion + -> Stripe Refund +getRefundExpandable + chargeid + (RefundId refundid) + expandParams = callAPI request + where request = StripeRequest GET url params + url = "charges" getChargeId chargeid "refunds" refundid + params = toExpandable expandParams + +------------------------------------------------------------------------------ +-- | Update a `Refund` by `ChargeId` and `RefundId` +updateRefund + :: ChargeId -- ^ `ChargeId` associated with the `Charge` to be updated + -> RefundId -- ^ `RefundId` associated with the `Refund` to be retrieved + -> MetaData -- ^ `MetaData` associated with a `Refund` + -> Stripe Refund +updateRefund + chargeid + (RefundId refid) + metadata = callAPI request + where request = StripeRequest POST url params + url = "charges" getChargeId chargeid "refunds" refid + params = toMetaData metadata + +------------------------------------------------------------------------------ +-- | Retrieve a lot of Refunds by `ChargeId` +getRefunds + :: ChargeId -- ^ `ChargeId` associated with the `Charge` to be updated + -> Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter RefundId -- ^ Paginate starting after the following `RefundId` + -> EndingBefore RefundId -- ^ Paginate ending before the following `RefundId` + -> Stripe (StripeList Refund) +getRefunds + chargeid + limit + startingAfter + endingBefore = + getRefundsExpandable chargeid + limit startingAfter endingBefore [] + +------------------------------------------------------------------------------ +-- | Retrieve a lot of Refunds by `ChargeId` with `ExpandParams` +getRefundsExpandable + :: ChargeId -- ^ `ChargeId` associated with the `Charge` to be updated + -> Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter RefundId -- ^ Paginate starting after the following `RefundId` + -> EndingBefore RefundId -- ^ Paginate ending before the following `RefundId` + -> ExpandParams -- ^ `MetaData` associated with a `Refund` + -> Stripe (StripeList Refund) +getRefundsExpandable + chargeid + limit + startingAfter + endingBefore + expandParams = callAPI request + where request = StripeRequest GET url params + url = "charges" getChargeId chargeid "refunds" + params = getParams [ + ("limit", toText `fmap` limit ) + , ("starting_after", (\(RefundId x) -> x) `fmap` startingAfter) + , ("ending_before", (\(RefundId x) -> x) `fmap` endingBefore) + ] ++ toExpandable expandParams + + + diff --git a/src/Web/Stripe/Subscription.hs b/src/Web/Stripe/Subscription.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/Subscription.hs @@ -0,0 +1,181 @@ +{-# LANGUAGE OverloadedStrings #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Subscription +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#subscriptions > +-- +-- @ +-- import Web.Stripe +-- import Web.Stripe.Subscription +-- import Web.Stripe.Customer +-- import Web.Stripe.Plan +-- +-- main :: IO () +-- main = do +-- let config = SecretKey "secret_key" +-- result <- stripe config $ do +-- Customer { customerId = cid } <- createEmptyCustomer +-- Plan { planId = pid } <- createPlan (PlanId "free plan") +-- (0 :: Amount) -- free plan +-- (USD :: Currency) +-- (Month :: Inteval) +-- ("sample plan" :: Name) +-- ([] :: MetaData) +-- createSubscription cid pid ([] :: MetaData) +-- case result of +-- Right subscription -> print subscription +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.Subscription + ( -- * API + createSubscription + , getSubscription + , getSubscriptionExpandable + , getSubscriptions + , getSubscriptionsExpandable + , updateSubscription + , cancelSubscription + -- * Types + , Subscription (..) + , SubscriptionId (..) + , SubscriptionStatus (..) + , CustomerId (..) + , CouponId (..) + , Coupon (..) + , PlanId (..) + , StripeList (..) + ) where + +import Web.Stripe.Client.Internal (Method (GET, POST, DELETE), Stripe, + StripeRequest (..), callAPI, + getParams, toExpandable, + toMetaData, toText, ()) +import Web.Stripe.Types (CustomerId (..), EndingBefore, + ExpandParams, Limit, MetaData, + PlanId (..), StartingAfter, CouponId(..), + Subscription (..), StripeList(..), + SubscriptionId (..), Coupon(..), + SubscriptionStatus (..)) +import Web.Stripe.Types.Util (getCustomerId) + +------------------------------------------------------------------------------ +-- | Create a `Subscription` by `CustomerId` and `PlanId` +createSubscription + :: CustomerId -- ^ The `CustomerId` upon which to create the `Subscription` + -> PlanId -- ^ The `PlanId` to associate the `Subscription` with + -> MetaData -- ^ The `MetaData` associated with the `Subscription` + -> Stripe Subscription +createSubscription + customerid + (PlanId planid) + metadata = callAPI request + where request = StripeRequest POST url params + url = "customers" getCustomerId customerid "subscriptions" + params = toMetaData metadata ++ getParams [ ("plan", Just planid) ] + +------------------------------------------------------------------------------ +-- | Retrieve a `Subscription` by `CustomerId` and `SubscriptionId` +getSubscription + :: CustomerId -- ^ The `CustomerId` of the `Subscription` + -> SubscriptionId -- ^ The `SubscriptionId` of the `Subscription` to retrieve + -> Stripe Subscription +getSubscription + customerid + subscriptionid = + getSubscriptionExpandable + customerid subscriptionid [] + +------------------------------------------------------------------------------ +-- | Retrieve a `Subscription` by `CustomerId` and `SubscriptionId` with `ExpandParams` +getSubscriptionExpandable + :: CustomerId -- ^ The `CustomerId` of the `Subscription` to retrieve + -> SubscriptionId -- ^ The `SubscriptionId` of the `Subscription` to retrieve + -> ExpandParams -- ^ The `ExpandParams` of the object to expand + -> Stripe Subscription +getSubscriptionExpandable + customerid + (SubscriptionId subscriptionid) + expandParams = callAPI request + where request = StripeRequest GET url params + url = "customers" getCustomerId customerid "subscriptions" subscriptionid + params = toExpandable expandParams + +------------------------------------------------------------------------------ +-- | Retrieve active `Subscription`s +getSubscriptions + :: CustomerId -- ^ The `CustomerId` of the `Subscription`s to retrieve + -> Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter SubscriptionId -- ^ Paginate starting after the following `CustomerId` + -> EndingBefore SubscriptionId -- ^ Paginate ending before the following `CustomerId` + -> Stripe (StripeList Subscription) +getSubscriptions + customerid + limit + startingAfter + endingBefore = + getSubscriptionsExpandable customerid limit + startingAfter endingBefore [] + +------------------------------------------------------------------------------ +-- | Retrieve active `Subscription`s +getSubscriptionsExpandable + :: CustomerId -- ^ The `CustomerId` of the `Subscription`s to retrieve + -> Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter SubscriptionId -- ^ Paginate starting after the following `CustomerId` + -> EndingBefore SubscriptionId -- ^ Paginate ending before the following `CustomerId` + -> ExpandParams -- ^ The `ExpandParams` of the object to expand + -> Stripe (StripeList Subscription) +getSubscriptionsExpandable + customerid + limit + startingAfter + endingBefore + expandParams = callAPI request + where request = StripeRequest GET url params + url = "customers" getCustomerId customerid "subscriptions" + params = getParams [ + ("limit", toText `fmap` limit ) + , ("starting_after", (\(SubscriptionId x) -> x) `fmap` startingAfter) + , ("ending_before", (\(SubscriptionId x) -> x) `fmap` endingBefore) + ] ++ toExpandable expandParams + +------------------------------------------------------------------------------ +-- | Update a `Subscription` by `CustomerId` and `SubscriptionId` +updateSubscription + :: CustomerId -- ^ The `CustomerId` of the `Subscription` to update + -> SubscriptionId -- ^ The `SubscriptionId` of the `Subscription` to update + -> Maybe CouponId -- ^ Optional: The `Coupon` of the `Subscription` to update + -> MetaData + -> Stripe Subscription +updateSubscription + customerid + (SubscriptionId subscriptionid) + couponid + metadata = callAPI request + where request = StripeRequest POST url params + url = "customers" getCustomerId customerid "subscriptions" subscriptionid + params = toMetaData metadata ++ getParams [ + ("coupon", (\(CouponId x) -> x) `fmap` couponid) + ] + +------------------------------------------------------------------------------ +-- | Delete a `Subscription` by `CustomerId` and `SubscriptionId` +cancelSubscription + :: CustomerId -- ^ The `CustomerId` of the `Subscription` to cancel + -> SubscriptionId -- ^ The `SubscriptionId` of the `Subscription` to cancel + -> Bool -- ^ Flag set to true will delay cancellation until end of current period, default `False` + -> Stripe Subscription +cancelSubscription + customerid + (SubscriptionId subscriptionid) + atPeriodEnd + = callAPI request + where request = StripeRequest DELETE url params + url = "customers" getCustomerId customerid "subscriptions" subscriptionid + params = getParams [ ("at_period_end", Just $ toText atPeriodEnd) ] + diff --git a/src/Web/Stripe/Token.hs b/src/Web/Stripe/Token.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/Token.hs @@ -0,0 +1,126 @@ +{-# LANGUAGE OverloadedStrings #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Token +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#tokens > +-- +-- @ +-- import Web.Stripe +-- import Web.Stripe.Token +-- +-- main :: IO () +-- main = do +-- let config = SecretKey "secret_key" +-- credit = CardNumber "4242424242424242" +-- em = ExpMonth 12 +-- ey = ExpYear 2015 +-- cvc = CVC "123" +-- result <- stripe config $ createCardToken cn em ey cvc +-- case result of +-- Right token -> print token +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.Token + ( -- * API + createCardToken + , createBankAccountToken + , getCardToken + , getBankAccountToken + -- * Types + , CardNumber (..) + , ExpMonth (..) + , ExpYear (..) + , CVC (..) + , Token (..) + , TokenId (..) + , TokenType (..) + , Country (..) + , RoutingNumber (..) + , AccountNumber (..) + , Account (..) + ) where + +import Web.Stripe.Client.Internal (Method (GET, POST), Stripe, + StripeRequest (..), callAPI, + getParams, toText, ()) +import Web.Stripe.Types (Account(..), AccountNumber (..), + CVC (..), CardNumber (..), + Country (..), ExpMonth (..), BankAccount(..), + ExpYear (..), RoutingNumber (..), Card(..), + Token (..), TokenId (..), TokenType(..)) + +------------------------------------------------------------------------------ +-- | Create a `Token` by specifiying Credit `Card` information +createCardToken + :: CardNumber -- ^ Card Number + -> ExpMonth -- ^ Card Expiration Month + -> ExpYear -- ^ Card Expiration Year + -> CVC -- ^ Card CVC + -> Stripe (Token Card) +createCardToken + (CardNumber number) + (ExpMonth month) + (ExpYear year) + (CVC cvc) + = callAPI request + where request = StripeRequest POST url params + url = "tokens" + params = getParams [ + ("card[number]", Just number) + , ("card[exp_month]", toText `fmap` Just month) + , ("card[exp_year]", toText `fmap` Just year) + , ("card[cvc]", Just cvc) + ] + +------------------------------------------------------------------------------ +-- | Create a `Token` for a specific `BankAccount` +createBankAccountToken + :: Country -- ^ Country of the `BankAccount` `Token` to retrieve + -> RoutingNumber -- ^ Routing Number + -> AccountNumber -- ^ Account Number + -> Stripe (Token BankAccount) +createBankAccountToken + (Country country) + (RoutingNumber routingNumber) + (AccountNumber accountNumber) + = callAPI request + where request = StripeRequest POST url params + url = "tokens" + params = getParams [ + ("bank_account[country]", Just country) + , ("bank_account[routing_number]", Just routingNumber) + , ("bank_account[account_number]", Just accountNumber) + ] + +------------------------------------------------------------------------------ +-- | Retrieve a `Token` by `TokenId` +getCardToken + :: TokenId -- ^ The `TokenId` of the `Card` `Token` to retrieve + -> Stripe (Token Card) +getCardToken (TokenId token) = callAPI request + where request = StripeRequest GET url params + url = "tokens" token + params = [] + +------------------------------------------------------------------------------ +-- | Retrieve a `Token` by `TokenId` +getBankAccountToken + :: TokenId -- ^ The `TokenId` of the `BankAccount` `Token` to retrieve + -> Stripe (Token BankAccount) +getBankAccountToken (TokenId token) = callAPI request + where request = StripeRequest GET url params + url = "tokens" token + params = [] + + + + + + + + diff --git a/src/Web/Stripe/Transfer.hs b/src/Web/Stripe/Transfer.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/Transfer.hs @@ -0,0 +1,163 @@ +{-# LANGUAGE OverloadedStrings #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Transfer +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#transfers > +-- +-- @ +-- import Web.Stripe +-- import Web.Stripe.Transfer +-- import Web.Stripe.Recipient +-- +-- main :: IO () +-- main = do +-- let config = SecretKey "secret_key" +-- result <- stripe config $ do +-- Recipient { recipientId = recipientid } <- getRecipient (RecipientId "recipient_id") +-- createTransfer recipientid (100 :: Amount) USD ([] :: MetaData) +-- case result of +-- Right transfer -> print transfer +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.Transfer + ( -- * API + createTransfer + , getTransfer + , getTransferExpandable + , getTransfers + , getTransfersExpandable + , updateTransfer + , cancelTransfer + -- * Types + , Transfer (..) + , TransferId (..) + , TransferStatus (..) + , TransferType (..) + , RecipientId (..) + , Recipient (..) + , StripeList (..) + , Currency (..) + , Amount + , Limit + ) where + +import Web.Stripe.Client.Internal (Method (GET, POST), Stripe, + StripeRequest (..), callAPI, + getParams, toExpandable, toTextLower, + toMetaData, toText, ()) +import Web.Stripe.Types (Amount, Currency (..), + EndingBefore, ExpandParams, Limit, + MetaData, RecipientId (..), Recipient(..), + StartingAfter, StripeList (..), + Transfer (..), TransferId (..), + TransferStatus (..),Description, + TransferType (..)) +import Web.Stripe.Types.Util (getRecipientId) + +------------------------------------------------------------------------------ +-- | Create a `Transfer` +createTransfer + :: RecipientId -- ^ The `RecipientId` of the `Recipient` who will receive the `Transfer` + -> Amount -- ^ The `Amount` of money to transfer to the `Recipient` + -> Currency -- ^ The `Currency` in which to perform the `Transfer` + -> MetaData -- ^ The `MetaData` associated with the Transfer + -> Stripe Transfer +createTransfer + recipientid + amount + currency + metadata = callAPI request + where request = StripeRequest POST url params + url = "transfers" + params = toMetaData metadata ++ getParams [ + ("amount", toText `fmap` Just amount) + , ("currency", toTextLower `fmap` Just currency) + , ("recipient", getRecipientId `fmap` Just recipientid) + ] + +------------------------------------------------------------------------------ +-- | Retrieve a `Transfer` +getTransfer + :: TransferId -- ^ `TransferId` associated with the `Transfer` to retrieve + -> Stripe Transfer +getTransfer transferid = + getTransferExpandable transferid [] + +------------------------------------------------------------------------------ +-- | Retrieve a `Transfer` with `ExpandParams` +getTransferExpandable + :: TransferId -- ^ `TransferId` associated with the `Transfer` to retrieve + -> ExpandParams -- ^ The `ExpandParams` of the object to be expanded + -> Stripe Transfer +getTransferExpandable + (TransferId transferid) + expandParams = callAPI request + where request = StripeRequest GET url params + url = "transfers" transferid + params = toExpandable expandParams + +------------------------------------------------------------------------------ +-- | Retrieve StripeList of `Transfers` +getTransfers + :: Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter TransferId -- ^ Paginate starting after the following `TransferId` + -> EndingBefore TransferId -- ^ Paginate ending before the following `TransferId` + -> Stripe (StripeList Transfer) +getTransfers + limit + startingAfter + endingBefore = + getTransfersExpandable limit startingAfter endingBefore [] + +------------------------------------------------------------------------------ +-- | Retrieve StripeList of `Transfers` with `ExpandParams` +getTransfersExpandable + :: Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter TransferId -- ^ Paginate starting after the following `TransferId` + -> EndingBefore TransferId -- ^ Paginate ending before the following `TransferId` + -> ExpandParams -- ^ The `ExpandParams` of the object to be expanded + -> Stripe (StripeList Transfer) +getTransfersExpandable + limit + startingAfter + endingBefore + expandParams = callAPI request + where request = StripeRequest GET url params + url = "transfers" + params = getParams [ + ("limit", toText `fmap` limit ) + , ("starting_after", (\(TransferId x) -> x) `fmap` startingAfter) + , ("ending_before", (\(TransferId x) -> x) `fmap` endingBefore) + ] ++ toExpandable expandParams + +------------------------------------------------------------------------------ +-- | Update a `Transfer` +updateTransfer + :: TransferId -- ^ The `TransferId` of the `Transfer` to update + -> Maybe Description -- ^ The `Description` of the `Transfer` to update + -> MetaData -- ^ The `MetaData` of the `Transfer` to update + -> Stripe Transfer +updateTransfer + (TransferId transferid) + description + metadata = callAPI request + where request = StripeRequest POST url params + url = "transfers" transferid + params = toMetaData metadata ++ getParams [ + ("description", description) + ] + +------------------------------------------------------------------------------ +-- | Cancel a `Transfer` +cancelTransfer + :: TransferId -- ^ The `TransferId` of the `Transfer` to cancel + -> Stripe Transfer +cancelTransfer (TransferId transferid) = callAPI request + where request = StripeRequest POST url params + url = "transfers" transferid "cancel" + params = [] diff --git a/src/Web/Stripe/Types.hs b/src/Web/Stripe/Types.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/Types.hs @@ -0,0 +1,2072 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +-- | +-- Module : Web.Stripe.Types +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +module Web.Stripe.Types where + +import Control.Applicative (pure, (<$>), (<*>), (<|>)) +import Control.Monad (mzero) +import Data.Aeson (FromJSON (parseJSON), + Value (String, Object, Bool), (.:), + (.:?)) +import qualified Data.HashMap.Strict as H +import Data.Text (Text) +import Data.Time (UTCTime) +import Web.Stripe.Client.Internal (fromSeconds) + +------------------------------------------------------------------------------ +-- | `ChargeId` associated with a `Charge` +data ChargeId + = ChargeId Text + | ExpandedCharge Charge + deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `ChargeId` +instance FromJSON ChargeId where + parseJSON (String x) = pure $ ChargeId x + parseJSON o@(Object _) = ExpandedCharge <$> parseJSON o + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `StatementDescription` to be added to a `Charge` +newtype StatementDescription = + StatementDescription Text deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | `Charge` object in `Stripe` API +data Charge = Charge { + chargeId :: ChargeId + , chargeObject :: Text + , chargeCreated :: UTCTime + , chargeLiveMode :: Bool + , chargePaid :: Bool + , chargeAmount :: Int + , chargeCurrency :: Currency + , chargeRefunded :: Bool + , chargeCreditCard :: Card + , chargeCaptured :: Bool + , chargeRefunds :: StripeList Refund + , chargeBalanceTransaction :: Maybe TransactionId + , chargeFailureMessage :: Maybe Text + , chargeFailureCode :: Maybe Text + , chargeAmountRefunded :: Int + , chargeCustomerId :: Maybe CustomerId + , chargeInvoice :: Maybe InvoiceId + , chargeDescription :: Maybe Description + , chargeDispute :: Maybe Dispute + , chargeMetaData :: MetaData + , chargeStatementDescription :: Maybe Description + , chargeReceiptEmail :: Maybe Text + , chargeReceiptNumber :: Maybe Text + } deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `Charge` +instance FromJSON Charge where + parseJSON (Object o) = + Charge <$> (ChargeId <$> o .: "id") + <*> o .: "object" + <*> (fromSeconds <$> o .: "created") + <*> o .: "livemode" + <*> o .: "paid" + <*> o .: "amount" + <*> o .: "currency" + <*> o .: "refunded" + <*> o .: "card" + <*> o .: "captured" + <*> o .: "refunds" + <*> ((fmap TransactionId <$> o .:? "balance_transaction") + <|> (fmap ExpandedTransaction <$> o .:? "balance_transaction")) + <*> o .:? "failure_message" + <*> o .:? "failure_code" + <*> o .: "amount_refunded" + <*> ((fmap CustomerId <$> o .:? "customer") + <|> (fmap ExpandedCustomer <$> o .:? "customer")) + <*> ((fmap InvoiceId <$> o .:? "invoice") + <|> (fmap ExpandedInvoice <$> o .:? "invoice")) + <*> o .:? "description" + <*> o .:? "dispute" + <*> (H.toList <$> o .: "metadata") + <*> o .:? "statement_description" + <*> o .:? "receipt_email" + <*> o .:? "receipt_number" + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | Capture for `Charge` +type Capture = Bool + +------------------------------------------------------------------------------ +-- | `RefundId` for `Refund` +newtype RefundId = + RefundId Text deriving (Eq, Show) + +------------------------------------------------------------------------------ +-- | `Refund` Object +data Refund = Refund { + refundId :: RefundId + , refundAmount :: Int + , refundCurrency :: Currency + , refundCreated :: UTCTime + , refundObject :: Text + , refundCharge :: ChargeId + , refundBalanceTransaction :: TransactionId + , refundMetaData :: MetaData + } deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `Refund` +instance FromJSON Refund where + parseJSON (Object o) = + Refund <$> (RefundId <$> o .: "id") + <*> o .: "amount" + <*> o .: "currency" + <*> (fromSeconds <$> o .: "created") + <*> o .: "object" + <*> (ChargeId <$> o .: "charge") + <*> ((TransactionId <$> o .: "balance_transaction") + <|> (ExpandedTransaction <$> o .: "balance_transaction")) + <*> (H.toList <$> o .: "metadata") + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `CustomerId` for a `Customer` +data CustomerId = + CustomerId Text | + ExpandedCustomer Customer + deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `CustomerId` +instance FromJSON CustomerId where + parseJSON (String x) = pure (CustomerId x) + parseJSON v@(Object _) = ExpandedCustomer <$> parseJSON v + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `Customer` object +data Customer = Customer { + customerObject :: Text + , customerCreated :: UTCTime + , customerId :: CustomerId + , customerLiveMode :: Bool + , customerDescription :: Maybe Description + , customerEmail :: Maybe Email + , customerDelinquent :: Bool + , customerSubscriptions :: StripeList Subscription + , customerDiscount :: Maybe Discount + , customerAccountBalance :: Int + , customerCards :: StripeList Card + , customerCurrency :: Maybe Currency + , customerDefaultCard :: Maybe CardId + , customerMetaData :: MetaData + } | DeletedCustomer { + deletedCustomer :: Maybe Bool + , deletedCustomerId :: CustomerId + } deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `Customer` +instance FromJSON Customer where + parseJSON (Object o) + = (Customer + <$> o .: "object" + <*> (fromSeconds <$> o .: "created") + <*> (CustomerId <$> o .: "id") + <*> o .: "livemode" + <*> o .:? "description" + <*> (fmap Email <$> o .:? "email") + <*> o .: "delinquent" + <*> o .: "subscriptions" + <*> o .:? "discount" + <*> o .: "account_balance" + <*> o .: "cards" + <*> o .:? "currency" + <*> ((fmap CardId <$> o .:? "default_card") + <|> (fmap ExpandedCard <$> o .:? "default_card")) + <*> (H.toList <$> o .: "metadata") + <|> DeletedCustomer + <$> o .: "deleted" + <*> (CustomerId <$> o .: "id")) + <|> DeletedCustomer + <$> o .:? "deleted" + <*> (CustomerId <$> o .: "id") + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | AccountBalance for a `Customer` +type AccountBalance = Int + +------------------------------------------------------------------------------ +-- | CardId for a `Customer` +data CardId = CardId Text + | ExpandedCard Card + deriving (Eq, Show) + +------------------------------------------------------------------------------ +-- | CardId for a `Recipient` +data RecipientCardId = RecipientCardId Text + | ExpandedRecipientCard RecipientCard + deriving (Eq, Show) + +------------------------------------------------------------------------------ +-- | JSON Instance for `CardId` +instance FromJSON CardId where + parseJSON o@(Object _) = ExpandedCard <$> parseJSON o + parseJSON (String x) = pure $ CardId x + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | Number associated with a `Card` +newtype CardNumber = CardNumber Text deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Expiration Month for a `Card` +newtype ExpMonth = ExpMonth Int deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Expiration Year for a `Card` +newtype ExpYear = ExpYear Int deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | CVC for a `Card` +newtype CVC = CVC Text deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | City address for a `Card` +newtype AddressCity = AddressCity Text deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Country address for a `Card` +newtype AddressCountry = AddressCountry Text deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Address Line One for a `Card` +newtype AddressLine1 = AddressLine1 Text deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Address Line Two for a `Card` +newtype AddressLine2 = AddressLine2 Text deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Address State for a `Card` +newtype AddressState = AddressState Text deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Address Zip Code for a `Card` +newtype AddressZip = AddressZip Text deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Credit / Debit Card Brand +data Brand = Visa + | AMEX + | MasterCard + | Discover + | JCB + | DinersClub + | Unknown + deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `Brand` +instance FromJSON Brand where + parseJSON (String "American Express") = pure AMEX + parseJSON (String "MasterCard") = pure MasterCard + parseJSON (String "Discover") = pure Discover + parseJSON (String "JCB") = pure JCB + parseJSON (String "Visa") = pure Visa + parseJSON (String "DinersClub") = pure DinersClub + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `Card` Object +data Card = Card { + cardId :: CardId + , cardObject :: Text + , cardLastFour :: Text + , cardBrand :: Brand + , cardFunding :: Text + , cardExpMonth :: ExpMonth + , cardExpYear :: ExpYear + , cardFingerprint :: Text + , cardCountry :: 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 CustomerId + } deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | `RecipientCard` object +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 RecipientId +} deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `Card` +instance FromJSON Card where + parseJSON (Object o) = + Card <$> (CardId <$> o .: "id") + <*> o .: "object" + <*> o .: "last4" + <*> o .: "brand" + <*> o .: "funding" + <*> (ExpMonth <$> o .: "exp_month") + <*> (ExpYear <$> o .: "exp_year") + <*> o .: "fingerprint" + <*> o .: "country" + <*> o .:? "name" + <*> (fmap AddressLine1 <$> o .:? "address_line1") + <*> (fmap AddressLine2 <$> o .:? "address_line2") + <*> (fmap AddressCity <$> o .:? "address_city") + <*> (fmap AddressState <$> o .:? "address_state") + <*> (fmap AddressZip <$> o .:? "address_zip") + <*> (fmap AddressCountry <$> o .:? "address_country") + <*> o .:? "cvc_check" + <*> o .:? "address_line1_check" + <*> o .:? "address_zip_check" + <*> ((fmap CustomerId <$> o .:? "customer") + <|> (fmap ExpandedCustomer <$> o .:? "customer")) + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | JSON Instance for `RecipientCard` +instance FromJSON RecipientCard where + parseJSON (Object o) = + RecipientCard + <$> (RecipientCardId <$> o .: "id") + <*> o .: "last4" + <*> o .: "brand" + <*> o .: "funding" + <*> (ExpMonth <$> o .: "exp_month") + <*> (ExpYear <$> o .: "exp_year") + <*> o .: "fingerprint" + <*> (Country <$> o .: "country") + <*> o .:? "name" + <*> (fmap AddressLine1 <$> o .:? "address_line1") + <*> (fmap AddressLine2 <$> o .:? "address_line2") + <*> (fmap AddressCity <$> o .:? "address_city") + <*> (fmap AddressState <$> o .:? "address_state") + <*> (fmap AddressZip <$> o .:? "address_zip") + <*> (fmap AddressCountry <$> o .:? "address_country") + <*> o .:? "cvc_check" + <*> o .:? "address_line1_check" + <*> o .:? "address_zip_check" + <*> ((fmap RecipientId <$> o .:? "recipient") + <|> (fmap ExpandedRecipient <$> o .:? "recipient")) + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `SubscriptionId` for a `Subscription` +newtype SubscriptionId = + SubscriptionId Text + deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Subscription Object +data Subscription = Subscription { + subscriptionId :: SubscriptionId + , subscriptionPlan :: Plan + , subscriptionObject :: Text + , subscriptionStart :: UTCTime + , subscriptionStatus :: SubscriptionStatus + , subscriptionCustomerId :: CustomerId + , subscriptionCancelAtPeriodEnd :: Bool + , subscriptionCurrentPeriodStart :: UTCTime + , subscriptionCurrentPeriodEnd :: UTCTime + , subscriptionEndedAt :: Maybe UTCTime + , subscriptionTrialStart :: Maybe UTCTime + , subscriptionTrialEnd :: Maybe UTCTime + , subscriptionCanceledAt :: Maybe UTCTime + , subscriptionQuantity :: Quantity + , subscriptionApplicationFeePercent :: Maybe Double + , subscriptionDiscount :: Maybe Discount + , subscriptionMetaData :: MetaData +} deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `Subscription` +instance FromJSON Subscription where + parseJSON (Object o) = + Subscription <$> (SubscriptionId <$> o .: "id") + <*> o .: "plan" + <*> o .: "object" + <*> (fromSeconds <$> o .: "start") + <*> o .: "status" + <*> ((CustomerId <$> o .: "customer") + <|> (ExpandedCustomer <$> o .: "customer")) + <*> o .: "cancel_at_period_end" + <*> (fromSeconds <$> o .: "current_period_start") + <*> (fromSeconds <$> o .: "current_period_end") + <*> (fmap fromSeconds <$> o .:? "ended_at") + <*> (fmap fromSeconds <$> o .:? "trial_start") + <*> (fmap fromSeconds <$> o .:? "trial_end") + <*> (fmap fromSeconds <$> o .:? "canceled_at") + <*> (Quantity <$> o .: "quantity") + <*> o .:? "application_fee_percent" + <*> o .:? "discount" + <*> (H.toList <$> o .: "metadata") + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | Status of a `Subscription` +data SubscriptionStatus = + Trialing + | Active + | PastDue + | Canceled + | UnPaid + deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `SubscriptionStatus` +instance FromJSON SubscriptionStatus where + parseJSON (String "trialing") = pure Trialing + parseJSON (String "active") = pure Active + parseJSON (String "past_due") = pure PastDue + parseJSON (String "canceled") = pure Canceled + parseJSON (String "unpaid") = pure UnPaid + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `PlanId` for a `Plan` +newtype PlanId = PlanId Text deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Plan object +data Plan = Plan { + planInterval :: Interval + , planName :: Text + , planCreated :: UTCTime + , planAmount :: Int + , planCurrency :: Currency + , planId :: PlanId + , planObject :: Text + , planLiveMode :: Bool + , planIntervalCount :: Maybe Int -- optional, max of 1 year intervals allowed, default 1 + , planTrialPeriodDays :: Maybe Int + , planMetaData :: MetaData + , planDescription :: Maybe Description +} deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `Plan` +instance FromJSON Plan where + parseJSON (Object o) = + Plan <$> o .: "interval" + <*> o .: "name" + <*> (fromSeconds <$> o .: "created") + <*> o .: "amount" + <*> o .: "currency" + <*> (PlanId <$> o .: "id") + <*> o .: "object" + <*> o .: "livemode" + <*> o .:? "interval_count" + <*> o .:? "trial_period_days" + <*> (H.toList <$> o .: "metadata") + <*> o .:? "statement_description" + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `TrialPeriod` for a Plan +type TrialPeriod = UTCTime + +------------------------------------------------------------------------------ +-- | Interval for `Plan`s +data Interval = Day | Week | Month | Year deriving Eq + +------------------------------------------------------------------------------ +-- | JSON Instance for `Interval` +instance FromJSON Interval where + parseJSON (String "day") = pure Day + parseJSON (String "week") = pure Week + parseJSON (String "month") = pure Month + parseJSON (String "year") = pure Year + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `Show` instance for `Interval` +instance Show Interval where + show Day = "day" + show Week = "week" + show Month = "month" + show Year = "year" + +------------------------------------------------------------------------------ +-- | `Coupon` Duration +data Duration = Forever | Once | Repeating deriving Eq + +------------------------------------------------------------------------------ +-- | `Show` instance for `Duration` +instance Show Duration where + show Forever = "forever" + show Once = "once" + show Repeating = "repeating" + +------------------------------------------------------------------------------ +-- | JSON Instance for `Duration` +instance FromJSON Duration where + parseJSON (String x) + | x == "forever" = pure Forever + | x == "once" = pure Once + | x == "repeating" = pure Repeating + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `Coupon` Object +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 + } deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `Coupon` +instance FromJSON Coupon where + parseJSON (Object o) = + Coupon <$> (CouponId <$> o .: "id") + <*> (fromSeconds <$> o .: "created") + <*> o .: "percent_off" + <*> o .:? "amount_off" + <*> o .:? "currency" + <*> o .: "livemode" + <*> o .: "duration" + <*> (fmap fromSeconds <$> o .:? "redeem_by") + <*> o .:? "max_redemptions" + <*> o .:? "times_redeemed" + <*> o .:? "duration_in_months" + <*> o .: "valid" + <*> (H.toList <$> o .: "metadata") + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `CouponId` for a `Coupon` +newtype CouponId = CouponId Text deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | `AmountOff` for a `Coupon` +newtype AmountOff = AmountOff Int deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | `MaxRedemptions` for a `Coupon` +newtype MaxRedemptions = MaxRedemptions Int deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | `PercentOff` for a `Coupon` +newtype PercentOff = PercentOff Int deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | `RedeemBy` date for a `Coupon` +newtype RedeemBy = RedeemBy UTCTime deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | `DurationInMonths` for a `Coupon` +newtype DurationInMonths = DurationInMonths Int deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | `IntervalCount` for a `Coupon` +newtype IntervalCount = IntervalCount Int deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | `TrialPeriodDays` for a `Coupon` +newtype TrialPeriodDays = TrialPeriodDays Int deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Amount representing a monetary value. +-- Stripe represents pennies as whole numbers +-- i.e. 100 = $1 +type Amount = Int + +------------------------------------------------------------------------------ +-- | `Discount` for `Coupon` +data Discount = Discount { + discountCoupon :: Coupon + , discountStart :: UTCTime + , discountEnd :: Maybe UTCTime + , discountCustomer :: CustomerId + , discountObject :: Text + , discountSubscription :: Maybe SubscriptionId +} deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `Discount` +instance FromJSON Discount where + parseJSON (Object o) = + Discount <$> o .: "coupon" + <*> (fromSeconds <$> o .: "start") + <*> (fmap fromSeconds <$> o .:? "end") + <*> ((CustomerId <$> o .: "customer") + <|> (ExpandedCustomer <$> o .: "customer")) + <*> o .: "object" + <*> (fmap SubscriptionId <$> o .:? "subscription") + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `Invoice` for a `Coupon` +data InvoiceId = + InvoiceId Text + | ExpandedInvoice Invoice + deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `InvoiceId` +instance FromJSON InvoiceId where + parseJSON (String x) = pure $ InvoiceId x + parseJSON o@(Object _) = ExpandedInvoice <$> parseJSON o + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `Invoice` Object +data Invoice = Invoice { + invoiceDate :: UTCTime + , invoiceId :: Maybe InvoiceId -- ^ If upcoming no ID will exist + , invoicePeriodStart :: UTCTime + , invoicePeriodEnd :: UTCTime + , invoiceLineItems :: StripeList InvoiceLineItem + , invoiceSubTotal :: Int + , invoiceTotal :: Int + , invoiceCustomer :: 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 ChargeId + , invoiceDiscount :: Maybe Discount + , invoiceApplicateFee :: Maybe FeeId + , invoiceSubscription :: Maybe SubscriptionId + , invoiceStatementDescription :: Maybe Description + , invoiceDescription :: Maybe Description + , invoiceMetaData :: MetaData +} deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `Invoice` +instance FromJSON Invoice where + parseJSON (Object o) = + Invoice <$> (fromSeconds <$> o .: "date") + <*> (fmap InvoiceId <$> o .:? "id") + <*> (fromSeconds <$> o .: "period_start") + <*> (fromSeconds <$> o .: "period_end") + <*> o .: "lines" + <*> o .: "subtotal" + <*> o .: "total" + <*> ((CustomerId <$> o .: "customer") + <|> (ExpandedCustomer <$> o .: "customer")) + <*> o .: "object" + <*> o .: "attempted" + <*> o .: "closed" + <*> o .: "forgiven" + <*> o .: "paid" + <*> o .: "livemode" + <*> o .: "attempt_count" + <*> o .: "amount_due" + <*> o .: "currency" + <*> o .: "starting_balance" + <*> o .:? "ending_balance" + <*> (fmap fromSeconds <$> o .:? "next_payment_attempt") + <*> (fmap fromSeconds <$> o .: "webhooks_delivered_at") + <*> ((fmap ChargeId <$> o .:? "charge") + <|> (fmap ExpandedCharge <$> o .:? "charge")) + <*> o .:? "discount" + <*> (fmap FeeId <$> o .:? "application_fee") + <*> (fmap SubscriptionId <$> o .: "subscription") + <*> o .:? "statement_description" + <*> o .:? "description" + <*> (H.toList <$> o .: "metadata") + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `InvoiceItemId` for `InvoiceItem` +data InvoiceItemId + = InvoiceItemId Text + | ExpandedInvoiceItem InvoiceItem + deriving (Eq, Show) + +------------------------------------------------------------------------------ +-- | `InvoiceItem` object +data InvoiceItem = InvoiceItem { + invoiceItemObject :: Text + , invoiceItemId :: InvoiceItemId + , invoiceItemDate :: UTCTime + , invoiceItemAmount :: Int + , invoiceItemLiveMode :: Bool + , invoiceItemProration :: Bool + , invoiceItemCurrency :: Currency + , invoiceItemCustomer :: CustomerId + , invoiceItemDescription :: Maybe Description + , invoiceItemInvoice :: Maybe InvoiceId + , invoiceItemQuantity :: Maybe Quantity + , invoiceItemSubscription :: Maybe Subscription + , invoiceItemMetaData :: MetaData + } deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `InvoiceItem` +instance FromJSON InvoiceItem where + parseJSON (Object o) = + InvoiceItem <$> o .: "object" + <*> (InvoiceItemId <$> o .: "id") + <*> (fromSeconds <$> o .: "date") + <*> o .: "amount" + <*> o .: "livemode" + <*> o .: "proration" + <*> o .: "currency" + <*> ((CustomerId <$> o .: "customer") + <|> (ExpandedCustomer <$> o .: "customer")) + <*> o .:? "description" + <*> ((fmap InvoiceId <$> o .:? "invoice") + <|> (fmap ExpandedInvoice <$> o .:? "invoice")) + <*> (fmap Quantity <$> o .:? "quantity") + <*> o .:? "subscription" + <*> (H.toList <$> o .: "metadata") + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `InvoiceLineItemId` for an `InvoiceLineItem` +newtype InvoiceLineItemId = + InvoiceLineItemId Text deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Type of `InvoiceItem` +data InvoiceLineItemType + = InvoiceItemType | + SubscriptionItemType + deriving (Show,Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `InvoiceLineItemType` +instance FromJSON InvoiceLineItemType where + parseJSON (String "invoiceitem") = pure InvoiceItemType + parseJSON (String "subscription") = pure SubscriptionItemType + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `InvoiceLineItem` Object +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 + } deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Period for an `InvoiceLineItem` +data Period = Period { + start :: UTCTime + , end :: UTCTime + } deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `Period` +instance FromJSON Period where + parseJSON (Object o) = + Period <$> (fromSeconds <$> o .: "start") + <*> (fromSeconds <$> o .: "end") + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | JSON Instance for `InvoiceLineItem` +instance FromJSON InvoiceLineItem where + parseJSON (Object o) = + InvoiceLineItem <$> (InvoiceLineItemId <$> o .: "id") + <*> o .: "object" + <*> o .: "type" + <*> o .: "livemode" + <*> o .: "amount" + <*> o .: "currency" + <*> o .: "proration" + <*> o .: "period" + <*> (fmap Quantity <$> o .:? "quantity") + <*> o .:? "plan" + <*> o .:? "description" + <*> (H.toList <$> o .: "metadata") + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | Status of a `Dispute` +data DisputeStatus + = WarningNeedsResponse + | WarningUnderReview + | NeedsResponse + | UnderReview + | ChargeRefunded + | Won + | Lost + deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `DisputeReason` +instance FromJSON DisputeReason where + parseJSON (String "duplicate") = pure Duplicate + parseJSON (String "fraudulent") = pure Fraudulent + parseJSON (String "subscription_canceled") = pure SubscriptionCanceled + parseJSON (String "product_unacceptable") = pure ProductUnacceptable + parseJSON (String "product_not_received") = pure ProductNotReceived + parseJSON (String "credit_not_processed") = pure CreditNotProcessed + parseJSON (String "general") = pure General + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | Reason of a `Dispute` +data DisputeReason + = Duplicate + | Fraudulent + | SubscriptionCanceled + | ProductUnacceptable + | ProductNotReceived + | Unrecognized + | CreditNotProcessed + | General + deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `DisputeStatus` +instance FromJSON DisputeStatus where + parseJSON (String "needs_response") = pure NeedsResponse + parseJSON (String "warning_needs_response") = pure WarningNeedsResponse + parseJSON (String "warning_under_review") = pure WarningUnderReview + parseJSON (String "under_review") = pure UnderReview + parseJSON (String "charge_refunded") = pure ChargeRefunded + parseJSON (String "won") = pure Won + parseJSON (String "lost") = pure Lost + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `Dispute` Object +data Dispute = Dispute { + disputeChargeId :: ChargeId + , disputeAmount :: Int + , disputeCreated :: UTCTime + , disputeStatus :: DisputeStatus + , disputeLiveMode :: Bool + , disputeCurrency :: Currency + , disputeObject :: Text + , disputeReason :: DisputeReason + , disputeIsChargeRefundable :: Bool + , disputeBalanceTransactions :: [BalanceTransaction] + , disputeEvidenceDueBy :: UTCTime + , disputeEvidence :: Maybe Evidence + , disputeMetaData :: MetaData + } deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | `Evidence` associated with a `Dispute` +newtype Evidence = Evidence Text deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `Dispute` +instance FromJSON Dispute where + parseJSON (Object o) = + Dispute <$> ((ChargeId <$> o .: "charge") + <|> (ExpandedCharge <$> o .: "charge")) + <*> o .: "amount" + <*> (fromSeconds <$> o .: "created") + <*> o .: "status" + <*> o .: "livemode" + <*> o .: "currency" + <*> o .: "object" + <*> o .: "reason" + <*> o .: "is_charge_refundable" + <*> o .: "balance_transactions" + <*> (fromSeconds <$> o .: "evidence_due_by") + <*> (fmap Evidence <$> o .:? "evidence") + <*> (H.toList <$> o .: "metadata") + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `TransferId` +newtype TransferId = + TransferId Text deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Status of a `Transfer` +data TransferStatus = + TransferPaid + | TransferPending + | TransferCanceled + | TransferFailed + deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Type of a `Transfer` +data TransferType = + CardTransfer + | BankAccountTransfer + deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `TransferType` +instance FromJSON TransferType where + parseJSON (String "card") = pure CardTransfer + parseJSON (String "bank_account") = pure BankAccountTransfer + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | JSON Instance for `TransferStatus` +instance FromJSON TransferStatus where + parseJSON (String "paid") = pure TransferPaid + parseJSON (String "pending") = pure TransferPending + parseJSON (String "canceled") = pure TransferCanceled + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `Transfer` Object +data Transfer = Transfer { + transferId :: TransferId + , transferObject :: Text + , transferCreated :: UTCTime + , transferDate :: UTCTime + , transferLiveMode :: Bool + , transferAmount :: Int + , transferCurrency :: Currency + , transferStatus :: TransferStatus + , transferType :: TransferType + , transferBalanceTransaction :: TransactionId + , transferDescription :: Maybe Description + , transferBankAccount :: Maybe BankAccount + , transferFailureMessage :: Maybe Text + , transferFailureCode :: Maybe Text + , transferStatementDescription :: Maybe Description + , transferRecipient :: Maybe RecipientId + , transferMetaData :: MetaData +} deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `Transfer` +instance FromJSON Transfer where + parseJSON (Object o) = + Transfer <$> (TransferId <$> o .: "id") + <*> o .: "object" + <*> (fromSeconds <$> o .: "created") + <*> (fromSeconds <$> o .: "date") + <*> o .: "livemode" + <*> o .: "amount" + <*> o .: "currency" + <*> o .: "status" + <*> o .: "type" + <*> ((TransactionId <$> o .: "balance_transaction") + <|> (ExpandedTransaction <$> o .: "balance_transaction")) + <*> o .:? "description" + <*> o .:? "bank_account" + <*> o .:? "failure_message" + <*> o .:? "failure_code" + <*> o .:? "statement_description" + <*> ((fmap RecipientId <$> o .:? "recipient") + <|> (fmap ExpandedRecipient <$> o .:? "recipient")) + <*> (H.toList <$> o .: "metadata") + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `BankAccount` Object +data BankAccount = BankAccount { + bankAccountId :: BankAccountId + , bankAccountObject :: Text + , bankAccountLast4 :: Text + , bankAccountCountry :: Country + , bankAccountCurrency :: Currency + , bankAccountStatus :: Maybe BankAccountStatus + , bankAccountFingerprint :: Maybe Text + , bankAccountName :: Text +} deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | `BankAccount` JSON Instance +instance FromJSON BankAccount where + parseJSON (Object o) = + BankAccount <$> (BankAccountId <$> o .: "id") + <*> o .: "object" + <*> o .: "last4" + <*> (Country <$> o .: "country") + <*> o .: "currency" + <*> o .:? "status" + <*> o .:? "fingerprint" + <*> o .: "bank_name" + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `BankAccountId` for `BankAccount` +newtype BankAccountId = BankAccountId Text + deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | `BankAccountStatus` Object +data BankAccountStatus = + New | Validated | Verified | Errored + deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | `BankAccountStatus` JSON instance +instance FromJSON BankAccountStatus where + parseJSON (String "new") = pure $ New + parseJSON (String "validated") = pure Validated + parseJSON (String "verified") = pure Verified + parseJSON (String "errored") = pure Errored + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | Routing Number for Bank Account +newtype RoutingNumber = + RoutingNumber Text deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Country +newtype Country = + Country Text deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Account Number of a Bank Account +newtype AccountNumber = + AccountNumber Text deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Recipients + +------------------------------------------------------------------------------ +-- | `FirstName` of a `Recipient` +newtype FirstName = FirstName Text deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | `LastName` of a `Recipient` +newtype LastName = LastName Text deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Middle Initial of a `Recipient` +type MiddleInitial = Char + +------------------------------------------------------------------------------ +-- | `RecipientId` for a `Recipient` +data RecipientId = + RecipientId Text + | ExpandedRecipient Recipient + deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `RecipientId` +instance FromJSON RecipientId where + parseJSON (String x) = pure $ RecipientId x + parseJSON o@(Object _) = ExpandedRecipient <$> parseJSON o + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `TaxID` of `Recipient` +type TaxID = Text + +------------------------------------------------------------------------------ +-- | Type of `Recipient` +data RecipientType = + Individual + | Corporation deriving Eq + +------------------------------------------------------------------------------ +-- | `Show` instance for `RecipientType` +instance Show RecipientType where + show Individual = "individual" + show Corporation = "corporation" + +------------------------------------------------------------------------------ +-- | JSON Instance for `RecipientType` +instance FromJSON RecipientType where + parseJSON (String "individual") = pure Individual + parseJSON (String "corporation") = pure Corporation + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | Recipient Object +data Recipient = Recipient { + recipientId :: RecipientId + , recipientObject :: Text + , recipientCreated :: UTCTime + , recipientLiveMode :: Bool + , recipientType :: RecipientType + , recipientDescription :: Maybe Description + , recipientEmail :: Maybe Email + , recipientName :: Name + , recipientVerified :: Bool + , recipientActiveAccount :: Maybe BankAccount + , recipientCards :: StripeList RecipientCard + , recipientDefaultCard :: Maybe RecipientCardId + } | DeletedRecipient { + deletedRecipient :: Maybe Bool + , deletedRecipientId :: RecipientId + } deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `Recipient` +instance FromJSON Recipient where + parseJSON (Object o) = + (Recipient <$> (RecipientId <$> o .: "id") + <*> o .: "object" + <*> (fromSeconds <$> o .: "created") + <*> o .: "livemode" + <*> o .: "type" + <*> o .:? "description" + <*> (fmap Email <$> o .:? "email") + <*> o .: "name" + <*> o .: "verified" + <*> o .:? "active_account" + <*> o .: "cards" + <*> ((fmap RecipientCardId <$> o .:? "default_card") + <|> (fmap ExpandedRecipientCard <$> o .:? "default_card"))) + <|> DeletedRecipient + <$> o .:? "deleted" + <*> (RecipientId <$> o .: "id") + + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | ApplicationFee Object +data ApplicationFee = ApplicationFee { + applicationFeeId :: Text + , applicationFeeObjecet :: Text + , applicationFeeCreated :: UTCTime + , applicationFeeLiveMode :: Bool + , applicationFeeAmount :: Int + , applicationFeeCurrency :: Currency + , applicationFeeRefunded :: Bool + , applicationFeeAmountRefunded :: Int + , applicationFeeRefunds :: StripeList Refund + , applicationFeeBalanceTransaction :: TransactionId + , applicationFeeAccountId :: AccountId + , applicationFeeApplicationId :: ApplicationId + , applicationFeeChargeId :: ChargeId + , applicationFeeMetaData :: MetaData +} deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | `ApplicationId` object +newtype ApplicationId = + ApplicationId Text deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `ApplicationFee` +instance FromJSON ApplicationFee where + parseJSON (Object o) = + ApplicationFee <$> o .: "id" + <*> o .: "object" + <*> (fromSeconds <$> o .: "created") + <*> o .: "livemode" + <*> o .: "amount" + <*> o .: "currency" + <*> o .: "refunded" + <*> o .: "amount_refunded" + <*> o .: "refunds" + <*> ((TransactionId <$> o .: "balance_transaction") + <|> (ExpandedTransaction <$> o .: "balance_transaction")) + <*> ((AccountId <$> o .: "account") + <|> (ExpandedAccount <$> o .: "account")) + <*> (ApplicationId <$> o .: "application") + <*> ((ChargeId <$> o .: "charge") + <|> (ExpandedCharge <$> o .: "charge")) + <*> (H.toList <$> o .: "metadata") + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `FeeId` for objects with Fees +newtype FeeId = + FeeId Text + deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Application Fee Refunds +data ApplicationFeeRefund = ApplicationFeeRefund { + applicationFeeRefundId :: RefundId + , applicationFeeRefundAmount :: Int + , applicationFeeRefundCurrency :: Currency + , applicationFeeRefundCreated :: UTCTime + , applicationFeeRefundObject :: Text + , applicationFeeRefundBalanceTransaction :: Maybe TransactionId + , applicationFeeRefundFee :: FeeId + , applicationFeeRefundMetaData :: MetaData + } deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `ApplicationFeeRefund` +instance FromJSON ApplicationFeeRefund where + parseJSON (Object o) = ApplicationFeeRefund + <$> (RefundId <$> o .: "id") + <*> o .: "amount" + <*> o .: "currency" + <*> (fromSeconds <$> o .: "created") + <*> o .: "object" + <*> ((fmap TransactionId <$> o .:? "balance_transaction") + <|> (fmap ExpandedTransaction <$> o .:? "balance_transaction")) + <*> (FeeId <$> o .: "fee") + <*> (H.toList <$> o .: "metadata") + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `AccountId` of an `Account` +data AccountId + = AccountId Text + | ExpandedAccount Account + deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `AccountId` +instance FromJSON AccountId where + parseJSON o@(Object _) = ExpandedAccount <$> parseJSON o + parseJSON (String aid) = pure $ AccountId aid + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `Account` Object +data Account = Account { + accountId :: AccountId + , accountEmail :: Email + , accountStatementDescriptor :: Maybe Description + , accountDisplayName :: Maybe Text + , accountTimeZone :: Text + , accountDetailsSubmitted :: Bool + , accountChargeEnabled :: Bool + , accountTransferEnabled :: Bool + , accountCurrenciesSupported :: [Currency] + , accountDefaultCurrency :: Currency + , accountCountry :: Text + , accountObject :: Text + , accountBusinessName :: Maybe Text + , accountBusinessURL :: Maybe Text + , accountBusinessLogo :: Maybe Text + , accountSupportPhone :: Maybe Text +} deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `Account` +instance FromJSON Account where + parseJSON (Object o) = + Account <$> (AccountId <$> o .: "id") + <*> (Email <$> o .: "email") + <*> o .:? "statement_descriptor" + <*> o .: "display_name" + <*> o .: "timezone" + <*> o .: "details_submitted" + <*> o .: "charge_enabled" + <*> o .: "transfer_enabled" + <*> o .: "currencies_supported" + <*> o .: "default_currency" + <*> o .: "country" + <*> o .: "object" + <*> o .:? "business_name" + <*> o .:? "business_url" + <*> o .:? "business_logo" + <*> o .:? "support_phone" + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `Balance` Object +data Balance = Balance { + balancePending :: [BalanceAmount] + , balanceAvailable :: [BalanceAmount] + , balanceLiveMode :: Bool + , balanceObject :: Text + } deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `Balance` +instance FromJSON Balance where + parseJSON (Object o) = + Balance <$> o .: "pending" + <*> o .: "available" + <*> o .: "livemode" + <*> o .: "object" + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `BalanceAmount` Object +data BalanceAmount = BalanceAmount { + balanceAmount :: Int + , balanceCurrency :: Currency + } deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `BalanceAmount` +instance FromJSON BalanceAmount where + parseJSON (Object o) = + BalanceAmount <$> o .: "amount" + <*> o .: "currency" + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `BalanceTransaction` Object +data BalanceTransaction = BalanceTransaction { + balanceTransactionId :: TransactionId + , balanceTransactionObject :: Text + , balanceTransactionAmount :: Amount + , balanceTransactionCurrency :: Currency + , balanceTransactionNet :: Int + , balanceTransactionType :: Text + , balanceTransactionCreated :: UTCTime + , balanceTransactionAvailableOn :: UTCTime + , balanceTransactionStatus :: Text + , balanceTransactionFee :: Int + , balanceTransactionFeeDetails :: [FeeDetails] + , balanceTransactionFeeSource :: ChargeId + , balanceTransactionFeeDescription :: Maybe Description + } deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `BalanceTransaction` +instance FromJSON BalanceTransaction where + parseJSON (Object o) = + BalanceTransaction <$> (TransactionId <$> o .: "id") + <*> o .: "object" + <*> o .: "amount" + <*> o .: "currency" + <*> o .: "net" + <*> o .: "type" + <*> (fromSeconds <$> o .: "created") + <*> (fromSeconds <$> o .: "available_on") + <*> o .: "status" + <*> o .: "fee" + <*> o .: "fee_details" + <*> ((ChargeId <$> o .: "source") + <|> (ExpandedCharge <$> o .: "source")) + <*> o .:? "description" + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `TransactionId` of a `Transaction` +data TransactionId = TransactionId Text + | ExpandedTransaction BalanceTransaction + deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `TransactionId` +instance FromJSON TransactionId where + parseJSON (String x) = pure (TransactionId x) + parseJSON v@(Object _) = ExpandedTransaction <$> parseJSON v + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `FeeDetails` Object +data FeeDetails = FeeDetails { + feeDetailsAmount :: Int + , feeDetailsCurrency :: Currency + , feeType :: Text + , feeDescription :: Maybe Description + , feeApplication :: Maybe Text +} deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `FeeDetails` +instance FromJSON FeeDetails where + parseJSON (Object o) = + FeeDetails <$> o .: "amount" + <*> o .: "currency" + <*> o .: "type" + <*> o .: "description" + <*> o .:? "application" + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `Event` Types +data EventType = + AccountUpdatedEvent + | AccountApplicationDeauthorizedEvent + | ApplicationFeeCreatedEvent + | ApplicationFeeRefundedEvent + | BalanceAvailableEvent + | ChargeSucceededEvent + | ChargeFailedEvent + | ChargeRefundedEvent + | ChargeCapturedEvent + | ChargeUpdatedEvent + | ChargeDisputeCreatedEvent + | ChargeDisputeUpdatedEvent + | ChargeDisputeClosedEvent + | ChargeDisputeFundsWithdrawnEvent + | ChargeDisputeFundsReinstatedEvent + | CustomerCreatedEvent + | CustomerUpdatedEvent + | CustomerDeletedEvent + | CustomerCardCreatedEvent + | CustomerCardUpdatedEvent + | CustomerCardDeletedEvent + | CustomerSubscriptionCreatedEvent + | CustomerSubscriptionUpdatedEvent + | CustomerSubscriptionDeletedEvent + | CustomerSubscriptionTrialWillEndEvent + | CustomerDiscountCreatedEvent + | CustomerDiscountUpdatedEvent + | CustomerDiscountDeletedEvent + | InvoiceCreatedEvent + | InvoiceUpdatedEvent + | InvoicePaymentSucceededEvent + | InvoicePaymentFailedEvent + | InvoiceItemCreatedEvent + | InvoiceItemUpdatedEvent + | InvoiceItemDeletedEvent + | PlanCreatedEvent + | PlanUpdatedEvent + | PlanDeletedEvent + | CouponCreatedEvent + | CouponUpdatedEvent + | CouponDeletedEvent + | RecipientCreatedEvent + | RecipientUpdatedEvent + | RecipientDeletedEvent + | TransferCreatedEvent + | TransferUpdatedEvent + | TransferCanceledEvent + | TransferPaidEvent + | TransferFailedEvent + | PingEvent + | UnknownEvent + deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Event Types JSON Instance +instance FromJSON EventType where + parseJSON (String "account.updated") = pure AccountUpdatedEvent + parseJSON (String "account.application.deauthorized") = pure AccountApplicationDeauthorizedEvent + parseJSON (String "application_fee.created") = pure ApplicationFeeCreatedEvent + parseJSON (String "application_fee.refunded") = pure ApplicationFeeRefundedEvent + parseJSON (String "balance.available") = pure BalanceAvailableEvent + parseJSON (String "charge.succeeded") = pure ChargeSucceededEvent + parseJSON (String "chage.failed") = pure ChargeFailedEvent + parseJSON (String "charge.refunded") = pure ChargeRefundedEvent + parseJSON (String "charge.captured") = pure ChargeCapturedEvent + parseJSON (String "charge.updated") = pure ChargeUpdatedEvent + parseJSON (String "charge.dispute.created") = pure ChargeDisputeCreatedEvent + parseJSON (String "charge.dispute.updated") = pure ChargeDisputeUpdatedEvent + parseJSON (String "charge.dispute.closed") = pure ChargeDisputeClosedEvent + parseJSON (String "charge.dispute.funds_withdrawn") = pure ChargeDisputeFundsWithdrawnEvent + parseJSON (String "charge.dispute.funds_reinstated") = pure ChargeDisputeFundsReinstatedEvent + parseJSON (String "customer.created") = pure CustomerCreatedEvent + parseJSON (String "customer.updated") = pure CustomerUpdatedEvent + parseJSON (String "customer.deleted") = pure CustomerDeletedEvent + parseJSON (String "customer.card.created") = pure CustomerCardCreatedEvent + parseJSON (String "customer.card.updated") = pure CustomerCardUpdatedEvent + parseJSON (String "customer.card.deleted") = pure CustomerCardDeletedEvent + parseJSON (String "customer.subscription.created") = pure CustomerSubscriptionCreatedEvent + parseJSON (String "customer.subscription.updated") = pure CustomerSubscriptionUpdatedEvent + parseJSON (String "customer.subscription.deleted") = pure CustomerSubscriptionDeletedEvent + parseJSON (String "customer.subscription.trial_will_end") = pure CustomerSubscriptionTrialWillEndEvent + parseJSON (String "customer.discount.created") = pure CustomerDiscountCreatedEvent + parseJSON (String "customer.discount.updated") = pure CustomerDiscountUpdatedEvent + parseJSON (String "invoice.created") = pure InvoiceCreatedEvent + parseJSON (String "invoice.updated") = pure InvoiceUpdatedEvent + parseJSON (String "invoice.payment_succeeded") = pure InvoicePaymentSucceededEvent + parseJSON (String "invoice.payment_failed") = pure InvoicePaymentFailedEvent + parseJSON (String "invoiceitem.created") = pure InvoiceItemCreatedEvent + parseJSON (String "invoiceitem.updated") = pure InvoiceItemUpdatedEvent + parseJSON (String "invoiceitem.deleted") = pure InvoiceItemDeletedEvent + parseJSON (String "plan.created") = pure PlanCreatedEvent + parseJSON (String "plan.updated") = pure PlanUpdatedEvent + parseJSON (String "plan.deleted") = pure PlanDeletedEvent + parseJSON (String "coupon.created") = pure CouponCreatedEvent + parseJSON (String "coupon.updated") = pure CouponUpdatedEvent + parseJSON (String "coupon.deleted") = pure CouponDeletedEvent + parseJSON (String "recipient.created") = pure RecipientCreatedEvent + parseJSON (String "recipient.updated") = pure RecipientUpdatedEvent + parseJSON (String "recipient.deleted") = pure RecipientDeletedEvent + parseJSON (String "transfer.created") = pure TransferCreatedEvent + parseJSON (String "transfer.updated") = pure TransferUpdatedEvent + parseJSON (String "transfer.canceled") = pure TransferCanceledEvent + parseJSON (String "transfer.paid") = pure TransferPaidEvent + parseJSON (String "transfer.failed") = pure TransferFailedEvent + parseJSON (String "ping") = pure PingEvent + parseJSON _ = pure UnknownEvent + +------------------------------------------------------------------------------ +-- | `EventId` of an `Event` +newtype EventId = EventId Text deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | EventData +data EventData = + TransferEvent Transfer + | AccountEvent Account + | AccountApplicationEvent ConnectApp + | ApplicationFeeEvent ApplicationFee + | InvoiceEvent Invoice + | PlanEvent Plan + | RecipientEvent Recipient + | CouponEvent Coupon + | BalanceEvent Balance + | ChargeEvent Charge + | DisputeEvent Dispute + | CustomerEvent Customer + | CardEvent Card + | SubscriptionEvent Subscription + | DiscountEvent Discount + | InvoiceItemEvent InvoiceItem + | UnknownEventData + | Ping + deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | `Event` Object +data Event = Event { + eventId :: Maybe EventId + , eventCreated :: UTCTime + , eventLiveMode :: Bool + , eventType :: EventType + , eventData :: EventData + , eventObject :: Text + , eventPendingWebHooks :: Int + , eventRequest :: Maybe Text +} deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `Event` +instance FromJSON Event where + parseJSON (Object o) = do + eventId <- fmap EventId <$> o .:? "id" + eventCreated <- fromSeconds <$> o .: "created" + eventLiveMode <- o .: "livemode" + eventType <- o .: "type" + String etype <- o .: "type" + obj <- o .: "data" + eventData <- + case etype of + "account.updated" -> AccountEvent <$> obj .: "object" + "account.application.deauthorized" -> AccountApplicationEvent <$> obj .: "object" + "application_fee.created" -> ApplicationFeeEvent <$> obj .: "object" + "application_fee.refunded" -> ApplicationFeeEvent <$> obj .: "object" + "balance.available" -> BalanceEvent <$> obj .: "object" + "charge.succeeded" -> ChargeEvent <$> obj .: "object" + "charge.failed" -> ChargeEvent <$> obj .: "object" + "charge.refunded" -> ChargeEvent <$> obj .: "object" + "charge.captured" -> ChargeEvent <$> obj .: "object" + "charge.updated" -> ChargeEvent <$> obj .: "object" + "charge.dispute.created" -> DisputeEvent <$> obj .: "object" + "charge.dispute.updated" -> DisputeEvent <$> obj .: "object" + "charge.dispute.closed" -> DisputeEvent <$> obj .: "object" + "charge.dispute.funds_withdrawn" -> DisputeEvent <$> obj .: "object" + "charge.dispute.funds_reinstated" -> DisputeEvent <$> obj .: "object" + "customer.created" -> CustomerEvent <$> obj .: "object" + "customer.updated" -> CustomerEvent <$> obj .: "object" + "customer.deleted" -> CustomerEvent <$> obj .: "object" + "customer.card.created" -> CardEvent <$> obj .: "object" + "customer.card.updated" -> CardEvent <$> obj .: "object" + "customer.card.deleted" -> CardEvent <$> obj .: "object" + "customer.subscription.created" -> SubscriptionEvent <$> obj .: "object" + "customer.subscription.updated" -> SubscriptionEvent <$> obj .: "object" + "customer.subscription.deleted" -> SubscriptionEvent <$> obj .: "object" + "customer.subscription.trial_will_end" -> SubscriptionEvent <$> obj .: "object" + "customer.discount.created" -> DiscountEvent <$> obj .: "object" + "customer.discount.updated" -> DiscountEvent <$> obj .: "object" + "customer.discount.deleted" -> DiscountEvent <$> obj .: "object" + "invoice.created" -> InvoiceEvent <$> obj .: "object" + "invoice.updated" -> InvoiceEvent <$> obj .: "object" + "invoice.payment_succeeded" -> InvoiceEvent <$> obj .: "object" + "invoice.payment_failed" -> InvoiceEvent <$> obj .: "object" + "invoiceitem.created" -> InvoiceItemEvent <$> obj .: "object" + "invoiceitem.updated" -> InvoiceItemEvent <$> obj .: "object" + "invoiceitem.deleted" -> InvoiceItemEvent <$> obj .: "object" + "plan.created" -> PlanEvent <$> obj .: "object" + "plan.updated" -> PlanEvent <$> obj .: "object" + "plan.deleted" -> PlanEvent <$> obj .: "object" + "coupon.created" -> CouponEvent <$> obj .: "object" + "coupon.updated" -> CouponEvent <$> obj .: "object" + "coupon.deleted" -> CouponEvent <$> obj .: "object" + "recipient.created" -> RecipientEvent <$> obj .: "object" + "recipient.updated" -> RecipientEvent <$> obj .: "object" + "recipient.deleted" -> RecipientEvent <$> obj .: "object" + "transfer.created" -> TransferEvent <$> obj .: "object" + "transfer.updated" -> TransferEvent <$> obj .: "object" + "transfer.canceled" -> TransferEvent <$> obj .: "object" + "transfer.paid" -> TransferEvent <$> obj .: "object" + "transfer.failed" -> TransferEvent <$> obj .: "object" + "ping" -> pure Ping + _ -> pure UnknownEventData + eventObject <- o .: "object" + eventPendingWebHooks <- o .: "pending_webhooks" + eventRequest <- o .:? "request" + return Event {..} + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | Connect Application +data ConnectApp = ConnectApp { + connectAppId :: Maybe Text + , connectAppObject :: Text + , connectAppName :: Text + } deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Connect Application JSON instance +instance FromJSON ConnectApp where + parseJSON (Object o) = + ConnectApp <$> o .:? "id" + <*> o .: "object" + <*> o .: "name" + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `TokenId` of a `Token` +newtype TokenId = + TokenId Text + deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Type of `Token` +data TokenType = TokenCard + | TokenBankAccount + deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `TokenType` +instance FromJSON TokenType where + parseJSON (String "bank_account") = pure TokenBankAccount + parseJSON (String "card") = pure TokenCard + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `Token` Object +data Token a = Token { + tokenId :: TokenId + , tokenLiveMode :: Bool + , tokenCreated :: UTCTime + , tokenUsed :: Bool + , tokenObject :: Text + , tokenType :: TokenType + , tokenData :: a +} deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `Token` +instance FromJSON a => FromJSON (Token a) where + parseJSON (Object o) = do + tokenId <- TokenId <$> o .: "id" + Bool tokenLiveMode <- o .: "livemode" + tokenCreated <- fromSeconds <$> o .: "created" + Bool tokenUsed <- o .: "used" + String tokenObject <- o .: "object" + String typ <- o .: "type" + tokenType <- pure $ case typ of + "card" -> TokenCard + "bank_account" -> TokenBankAccount + _ -> error "unspecified type" + tokenData <- + case typ of + "bank_account" -> o .: "bank_account" + "card" -> o .: "card" + _ -> mzero + return Token {..} + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | Generic handling of Stripe JSON arrays +data StripeList a = StripeList { + list :: [a] + , stripeUrl :: Text + , object :: Text + , totalCount :: Maybe Int + , hasMore :: Bool + } deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `StripeList` +instance FromJSON a => FromJSON (StripeList a) where + parseJSON (Object o) = + StripeList <$> o .: "data" + <*> o .: "url" + <*> o .: "object" + <*> o .:? "total_count" + <*> o .: "has_more" + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | Pagination Option for `StripeList` +type Limit = Maybe Int + +------------------------------------------------------------------------------ +-- | Pagination Option for `StripeList` +type StartingAfter a = Maybe a + +------------------------------------------------------------------------------ +-- | Pagination Option for `StripeList` +type EndingBefore a = Maybe a + +------------------------------------------------------------------------------ +-- | JSON returned from a `Stripe` deletion request +data StripeDeleteResult = StripeDeleteResult { + deleted :: Bool + , deletedId :: Maybe Text + } deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | JSON Instance for `StripeDeleteResult` +instance FromJSON StripeDeleteResult where + parseJSON (Object o) = + StripeDeleteResult <$> o .: "deleted" + <*> o .:? "id" + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | Type of MetaData for use on `Stripe` objects +type MetaData = [ (Text,Text) ] + +------------------------------------------------------------------------------ +-- | Type of Expansion Parameters for use on `Stripe` objects +type ExpandParams = [Text] + +------------------------------------------------------------------------------ +-- | Generic ID for use in constructing API Calls +type ID = Text + +------------------------------------------------------------------------------ +-- | Generic URL for use in constructing API Calls +type URL = Text + +------------------------------------------------------------------------------ +-- | Generic URL for use in constructing API Calls +type Name = Text + +------------------------------------------------------------------------------ +-- | Generic Description for use in constructing API Calls +type Description = Text + +------------------------------------------------------------------------------ +-- | Generic `Quantity` type to be used with `Customer`, +-- `Subscription` and `InvoiceLineItem` API requests +newtype Quantity = Quantity Int deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | `Email` associated with a `Customer`, `Recipient` or `Charge` +newtype Email = Email Text deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Stripe supports 138 currencies +data Currency = + 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 + deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | `Currency` JSON instances +instance FromJSON Currency where + parseJSON (String "aed") = pure AED + parseJSON (String "afn") = pure AFN + parseJSON (String "all") = pure ALL + parseJSON (String "amd") = pure AMD + parseJSON (String "ang") = pure ANG + parseJSON (String "aoa") = pure AOA + parseJSON (String "ars") = pure ARS + parseJSON (String "aud") = pure AUD + parseJSON (String "awg") = pure AWG + parseJSON (String "azn") = pure AZN + parseJSON (String "bam") = pure BAM + parseJSON (String "bbd") = pure BBD + parseJSON (String "bdt") = pure BDT + parseJSON (String "bgn") = pure BGN + parseJSON (String "bif") = pure BIF + parseJSON (String "bmd") = pure BMD + parseJSON (String "bnd") = pure BND + parseJSON (String "bob") = pure BOB + parseJSON (String "brl") = pure BRL + parseJSON (String "bsd") = pure BSD + parseJSON (String "bwp") = pure BWP + parseJSON (String "bzd") = pure BZD + parseJSON (String "cad") = pure CAD + parseJSON (String "cdf") = pure CDF + parseJSON (String "chf") = pure CHF + parseJSON (String "clp") = pure CLP + parseJSON (String "cny") = pure CNY + parseJSON (String "cop") = pure COP + parseJSON (String "crc") = pure CRC + parseJSON (String "cve") = pure CVE + parseJSON (String "czk") = pure CZK + parseJSON (String "djf") = pure DJF + parseJSON (String "dkk") = pure DKK + parseJSON (String "dop") = pure DOP + parseJSON (String "dzd") = pure DZD + parseJSON (String "eek") = pure EEK + parseJSON (String "egp") = pure EGP + parseJSON (String "etb") = pure ETB + parseJSON (String "eur") = pure EUR + parseJSON (String "fjd") = pure FJD + parseJSON (String "fkp") = pure FKP + parseJSON (String "gbp") = pure GBP + parseJSON (String "gel") = pure GEL + parseJSON (String "gip") = pure GIP + parseJSON (String "gmd") = pure GMD + parseJSON (String "gnf") = pure GNF + parseJSON (String "gtq") = pure GTQ + parseJSON (String "gyd") = pure GYD + parseJSON (String "hkd") = pure HKD + parseJSON (String "hnl") = pure HNL + parseJSON (String "hrk") = pure HRK + parseJSON (String "htg") = pure HTG + parseJSON (String "huf") = pure HUF + parseJSON (String "idr") = pure IDR + parseJSON (String "ils") = pure ILS + parseJSON (String "inr") = pure INR + parseJSON (String "isk") = pure ISK + parseJSON (String "jmd") = pure JMD + parseJSON (String "jpy") = pure JPY + parseJSON (String "kes") = pure KES + parseJSON (String "kgs") = pure KGS + parseJSON (String "khr") = pure KHR + parseJSON (String "kmf") = pure KMF + parseJSON (String "krw") = pure KRW + parseJSON (String "kyd") = pure KYD + parseJSON (String "kzt") = pure KZT + parseJSON (String "lak") = pure LAK + parseJSON (String "lbp") = pure LBP + parseJSON (String "lkr") = pure LKR + parseJSON (String "lrd") = pure LRD + parseJSON (String "lsl") = pure LSL + parseJSON (String "ltl") = pure LTL + parseJSON (String "lvl") = pure LVL + parseJSON (String "mad") = pure MAD + parseJSON (String "mdl") = pure MDL + parseJSON (String "mga") = pure MGA + parseJSON (String "mkd") = pure MKD + parseJSON (String "mnt") = pure MNT + parseJSON (String "mop") = pure MOP + parseJSON (String "mro") = pure MRO + parseJSON (String "mur") = pure MUR + parseJSON (String "mvr") = pure MVR + parseJSON (String "mwk") = pure MWK + parseJSON (String "mxn") = pure MXN + parseJSON (String "myr") = pure MYR + parseJSON (String "mzn") = pure MZN + parseJSON (String "nad") = pure NAD + parseJSON (String "ngn") = pure NGN + parseJSON (String "nio") = pure NIO + parseJSON (String "nok") = pure NOK + parseJSON (String "npr") = pure NPR + parseJSON (String "nzd") = pure NZD + parseJSON (String "pab") = pure PAB + parseJSON (String "pen") = pure PEN + parseJSON (String "pgk") = pure PGK + parseJSON (String "php") = pure PHP + parseJSON (String "pkr") = pure PKR + parseJSON (String "pln") = pure PLN + parseJSON (String "pyg") = pure PYG + parseJSON (String "qar") = pure QAR + parseJSON (String "ron") = pure RON + parseJSON (String "rsd") = pure RSD + parseJSON (String "rub") = pure RUB + parseJSON (String "rwf") = pure RWF + parseJSON (String "sar") = pure SAR + parseJSON (String "sbd") = pure SBD + parseJSON (String "scr") = pure SCR + parseJSON (String "sek") = pure SEK + parseJSON (String "sgd") = pure SGD + parseJSON (String "shp") = pure SHP + parseJSON (String "sll") = pure SLL + parseJSON (String "sos") = pure SOS + parseJSON (String "srd") = pure SRD + parseJSON (String "std") = pure STD + parseJSON (String "svc") = pure SVC + parseJSON (String "szl") = pure SZL + parseJSON (String "thb") = pure THB + parseJSON (String "tjs") = pure TJS + parseJSON (String "top") = pure TOP + parseJSON (String "try") = pure TRY + parseJSON (String "ttd") = pure TTD + parseJSON (String "twd") = pure TWD + parseJSON (String "tzs") = pure TZS + parseJSON (String "uah") = pure UAH + parseJSON (String "ugx") = pure UGX + parseJSON (String "usd") = pure USD + parseJSON (String "uyu") = pure UYU + parseJSON (String "uzs") = pure UZS + parseJSON (String "vnd") = pure VND + parseJSON (String "vuv") = pure VUV + parseJSON (String "wst") = pure WST + parseJSON (String "xaf") = pure XAF + parseJSON (String "xcd") = pure XCD + parseJSON (String "xof") = pure XOF + parseJSON (String "xpf") = pure XPF + parseJSON (String "yer") = pure YER + parseJSON (String "zar") = pure ZAR + parseJSON (String "zmw") = pure ZMW + parseJSON _ = pure UnknownCurrency diff --git a/src/Web/Stripe/Types/Util.hs b/src/Web/Stripe/Types/Util.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/Types/Util.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Web.Stripe.Types.Util +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +module Web.Stripe.Types.Util + ( -- * Getters + getTransactionId + , getCustomerId + , getCardId + , getRecipientCardId + , getRecipientId + , getAccountId + , getChargeId + , getInvoiceId + , getInvoiceItemId + ) where + +import Data.Text (Text) +import Web.Stripe.Types +------------------------------------------------------------------------------ +-- | Helper for retrieving `TransactionId` +getTransactionId :: TransactionId -> Text +getTransactionId (TransactionId x) = x +getTransactionId (ExpandedTransaction BalanceTransaction { balanceTransactionId = TransactionId x }) = x +getTransactionId _ = "" + +------------------------------------------------------------------------------ +-- | Helper for retrieving `CustomerId` +getCustomerId :: CustomerId -> Text +getCustomerId (CustomerId x) = x +getCustomerId (ExpandedCustomer Customer { customerId = CustomerId x }) = x +getCustomerId _ = "" + +------------------------------------------------------------------------------ +-- | Helper for retrieving `CardId` +getCardId :: CardId -> Text +getCardId (CardId x) = x +getCardId (ExpandedCard Card { cardId = CardId x }) = x +getCardId _ = "" + +------------------------------------------------------------------------------ +-- | Helper for retrieving `RecipientCardId` +getRecipientCardId :: RecipientCardId -> Text +getRecipientCardId (RecipientCardId x) = x +getRecipientCardId (ExpandedRecipientCard RecipientCard { recipientCardId = RecipientCardId x }) = x +getRecipientCardId _ = "" + +------------------------------------------------------------------------------ +-- | Helper for retrieiving `RecipientId` +getRecipientId :: RecipientId -> Text +getRecipientId (RecipientId x) = x +getRecipientId (ExpandedRecipient Recipient { recipientId = RecipientId x }) = x +getRecipientId _ = "" + +------------------------------------------------------------------------------ +-- | Helper for retrieving `AccountId` +getAccountId :: AccountId -> Text +getAccountId (AccountId x) = x +getAccountId (ExpandedAccount Account { accountId = AccountId x }) = x +getAccountId _ = "" + +------------------------------------------------------------------------------ +-- | Helper for retrieving `CardId` +getChargeId :: ChargeId -> Text +getChargeId (ChargeId x) = x +getChargeId (ExpandedCharge Charge { chargeId = ChargeId x }) = x +getChargeId _ = "" + +------------------------------------------------------------------------------ +-- | Helper for retrieving `InvoiceId` +getInvoiceId :: InvoiceId -> Text +getInvoiceId (InvoiceId x) = x +getInvoiceId (ExpandedInvoice Invoice { invoiceId = Nothing }) = "" +getInvoiceId (ExpandedInvoice Invoice { invoiceId = Just (InvoiceId x) }) = x +getInvoiceId _ = "" + +------------------------------------------------------------------------------ +-- | Helper for retrieving `InvoiceItemId` +getInvoiceItemId :: InvoiceItemId -> Text +getInvoiceItemId (InvoiceItemId x) = x +getInvoiceItemId (ExpandedInvoiceItem InvoiceItem { invoiceItemId = InvoiceItemId x }) = x +getInvoiceItemId _ = "" diff --git a/stripe-haskell.cabal b/stripe-haskell.cabal new file mode 100644 --- /dev/null +++ b/stripe-haskell.cabal @@ -0,0 +1,175 @@ +name: stripe-haskell +version: 0.1.0.0 +synopsis: Stripe API for Haskell +license: MIT +license-file: LICENSE +author: David Johnson +maintainer: djohnson.m@gmail.com +copyright: Copyright (c) 2014 David M. Johnson +homepage: https://github.com/dmjio/stripe-haskell +bug-reports: https://github.com/dmjio/stripe-haskell/issues +category: Web +build-type: Simple +cabal-version: >=1.10 +Description: + [100% Stripe API Coverage:] + () All Stripe commands are supported, + including but not limited to Charges, Refunds, Customers, Cards, + Subscriptions, Plans, Coupons, Discounts, Invoices, Invoice Items, + Disputes, Transfers, Recipients, Application Fees, Application Fees Refunds, + Account, Balance, Events and Tokens + . + . + [100+ Hspec Tests:] Thoroughly unit-tested with hspec. + All API commands are unit tested before inclusion into the API (see the tests directory). + To run the tests, perform the following: + . + > cabal clean && cabal configure --enable-tests && cabal build tests && dist/build/tests/tests + . + + [Pagination:] Pagination is possible on all API calls that return a JSON array. + () + Any API call that returns a `StripeList` is eligible for pagination. + To use in practice do the following. + . + > import Web.Stripe + > import Web.Stripe.Customer + > + > main :: IO () + > main = do + > let config = StripeConfig "secret key" + > result <- stripe config $ getCustomers + > (Just 30 :: Maybe Limit) -- Defaults to 10 if Nothing, 100 is Max + > (StartingAfter $ CustomerId "customer_id0") + > (EndingBefore $ CustomerId "customer_id30") + > case result of + > Right (StripeList stripelist) -> print (list stripelist :: [Customer]) + > Left stripeError -> print stripeError + > + . + [Versioning:] All versioning is hard-coded (for safety) + () + Stripe API versions specified in the HTTP headers of Stripe requests take precendence + over the API version specified in your Stripe Admin Panel. In an attempt to ensure + API consistency and correct parsing of returned JSON, all Stripe versions are hard-coded, and + not accessible to the end users of this library. When a new Stripe API version is released + this library will increment the hard-coded API version. + . + + [Expansion:] Object expansion is supported on Stripe objects eligible for expansion though the `ExpandParams` type + () + Object expansion allows normal Stripe API calls to return expanded objects inside of other objects. + For example, a `Customer` object contains a card id hash on the default_card field. + This default_card hash can be expanded into a full `Card` object inside a `Customer` object. + As an example: + . + > import Web.Stripe + > import Web.Stripe.Customer + > + > main :: IO () + > main = do + > let config = StripeConfig "secret key" + > result <- stripe config $ getCustomerExpandable + > (CustomerId "customerid") + > (["default_card"] :: ExpandParams) + > case result of + > Right (Customer customer) -> print (defaultCard customer) -- Will be an `ExpandedCard` + > Left stripeError -> print stripeError + > + . + + [MetaData:] Stripe objects allow the embedding of arbitrary metadata + () + Any Stripe object that supports the embedding of metadata is available via this API. + As an example: + . + > import Web.Stripe + > import Web.Stripe.Coupon + > + > main :: IO () + > main = do + > let config = StripeConfig "secret key" + > result <- stripe config $ updateCoupon (CouponId "couponid") [("key1", value2"), ("key2", "value2")] + > case result of + > Right (Coupon coupon) -> print (couponMetaData coupon) + > Left stripeError -> print stripeError + . + [Issues:] Any API recommendations or bugs can be reported here: () + Pull requests welcome! + . + +Test-Suite tests + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: tests + build-depends: HsOpenSSL + , aeson + , base >=4.7 && <4.8 + , bytestring + , either + , hspec + , http-streams + , io-streams + , mtl >= 2.1.3.1 + , random >= 1.1 + , stripe-haskell + , text + , time + , transformers + , unordered-containers + , vector + default-language: Haskell2010 + ghc-options: -Wall -threaded -rtsopts + +library + hs-source-dirs: src + build-depends: HsOpenSSL + , aeson + , base >=4.7 && <4.8 + , bytestring + , either + , hspec + , http-streams + , io-streams + , mtl >= 2.1.3.1 + , random >= 1.1 + , text + , time + , transformers + , unordered-containers + , vector + + default-language: Haskell2010 + other-modules: Web.Stripe.Client + Web.Stripe.Client.Internal + Web.Stripe.Client.Error + Web.Stripe.Client.Types + Web.Stripe.Client.Util + Web.Stripe.Types + Web.Stripe.Types.Util + exposed-modules: + Web.Stripe + Web.Stripe.Account + Web.Stripe.ApplicationFee + Web.Stripe.ApplicationFeeRefund + Web.Stripe.Balance + Web.Stripe.Card + Web.Stripe.Charge + Web.Stripe.Coupon + Web.Stripe.Customer + Web.Stripe.Discount + Web.Stripe.Dispute + Web.Stripe.Event + Web.Stripe.Invoice + Web.Stripe.InvoiceItem + Web.Stripe.Plan + Web.Stripe.Recipient + Web.Stripe.Refund + Web.Stripe.Subscription + Web.Stripe.Token + Web.Stripe.Transfer + ghc-options: -Wall -rtsopts + +source-repository head + type: git + location: git://github.com/dmjio/stripe-haskell.git diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +module Main where + +import Test.Hspec + +import Test.Account (accountTests) +import Test.ApplicationFee (applicationFeeTests) +import Test.ApplicationFeeRefund (applicationFeeRefundTests) +import Test.Balance (balanceTests) +import Test.Charge (chargeTests) +import Test.Card (cardTests) +import Test.Coupon (couponTests) +import Test.Customer (customerTests) +import Test.Discount (discountTests) +import Test.Dispute (disputeTests) +import Test.Invoice (invoiceTests) +import Test.InvoiceItem (invoiceItemTests) +import Test.Plan (planTests) +import Test.Recipient (recipientTests) +import Test.Refund (refundTests) +import Test.Subscription (subscriptionTests) +import Test.Token (tokenTests) +import Test.Transfer (transferTests) +import Test.Event (eventTests) + + +------------------------------------------------------------------------------ +-- | Main test function entry point +main :: IO () +main = hspec $ do + chargeTests + refundTests + customerTests + cardTests + subscriptionTests + planTests + couponTests + discountTests + invoiceTests + invoiceItemTests + disputeTests + transferTests + recipientTests + applicationFeeTests + applicationFeeRefundTests + accountTests + balanceTests + tokenTests + eventTests + +