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.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain 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,51 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Account +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#account > +-- +-- @ +-- {-\# LANGUAGE OverloadedStrings \#-} +-- import Web.Stripe +-- import Web.Stripe.Account +-- +-- main :: IO () +-- main = do +-- let config = StripeConfig (StripeKey "secret_key") +-- result <- stripe config getAccountDetails +-- case result of +-- Right account -> print account +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.Account + ( -- * API + GetAccountDetails + , getAccountDetails + -- * Types + , Account (..) + , AccountId (..) + ) where + +import Web.Stripe.StripeRequest (Method (GET), + StripeRequest (..), + StripeReturn, mkStripeRequest) +import Web.Stripe.Types ( Account (..) + , AccountId (..) ) + +------------------------------------------------------------------------------ +-- | Retrieve the object that represents your Stripe account +data GetAccountDetails +type instance StripeReturn GetAccountDetails = Account +getAccountDetails :: StripeRequest GetAccountDetails +getAccountDetails = request + where request = mkStripeRequest 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,93 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +------------------------------------------- +-- | +-- 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 > +-- +-- @ +-- {-\# LANGUAGE OverloadedStrings \#-} +-- import Web.Stripe +-- import Web.Stripe.ApplicationFee +-- +-- main :: IO () +-- main = do +-- let config = StripeConfig (StripeKey "secret_key") +-- result <- stripe config $ getApplicationFee (FeeId "fee_4xtEGZhPNDEt3w") +-- case result of +-- Right applicationFee -> print applicationFee +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.ApplicationFee + ( -- * API + GetApplicationFee + , getApplicationFee + , GetApplicationFees + , getApplicationFees + -- * Types + , ApplicationId (..) + , ApplicationFee (..) + , ApplicationFeeId (..) + , ChargeId (..) + , ConnectApp (..) + , Created (..) + , EndingBefore (..) + , FeeId (..) + , Limit (..) + , StartingAfter (..) + , StripeList (..) + , ExpandParams (..) + ) where +import Web.Stripe.StripeRequest (Method (GET), StripeHasParam, + StripeRequest (..), StripeReturn, + mkStripeRequest) +import Web.Stripe.Util (()) +import Web.Stripe.Types (ApplicationFee (..), + ApplicationFeeId (..), + ApplicationId (..), ChargeId(..), + ConnectApp (..), Created(..), + EndingBefore(..), ExpandParams(..), + FeeId (..), Limit(..), + StartingAfter(..), ExpandParams(..), + StripeList (..)) + +------------------------------------------------------------------------------ +-- | 'ApplicationFee' retrieval +getApplicationFee + :: FeeId -- ^ The `FeeId` associated with the Application + -> StripeRequest GetApplicationFee +getApplicationFee + (FeeId feeid) = request + where request = mkStripeRequest GET url params + url = "application_fees" feeid + params = [] + +data GetApplicationFee +type instance StripeReturn GetApplicationFee = ApplicationFee +instance StripeHasParam GetApplicationFee ExpandParams + +------------------------------------------------------------------------------ +-- | 'ApplicationFee's retrieval +getApplicationFees + :: StripeRequest GetApplicationFees +getApplicationFees + = request + where request = mkStripeRequest GET url params + url = "application_fees" + params = [] + +data GetApplicationFees +type instance StripeReturn GetApplicationFees = (StripeList ApplicationFee) +instance StripeHasParam GetApplicationFees ExpandParams +instance StripeHasParam GetApplicationFees ChargeId +instance StripeHasParam GetApplicationFees Created +instance StripeHasParam GetApplicationFees (EndingBefore ApplicationFeeId) +instance StripeHasParam GetApplicationFees Limit +instance StripeHasParam GetApplicationFees (StartingAfter ApplicationFeeId) 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,134 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +------------------------------------------- +-- | +-- 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 > +-- +-- @ +-- {-\# LANGUAGE OverloadedStrings \#-} +-- import Web.Stripe +-- import Web.Stripe.ApplicationFeeRefund +-- +-- main :: IO () +-- main = do +-- let config = StripeConfig (StripeKey "secret_key") +-- result <- stripe config $ getApplicationFeeRefund (FeeId "fee_id") (RefundId "refund_id") +-- case result of +-- Right applicationFeeRefund -> print applicationFeeRefund +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.ApplicationFeeRefund + ( -- * API + CreateApplicationFeeRefund + , createApplicationFeeRefund + , GetApplicationFeeRefund + , getApplicationFeeRefund + , UpdateApplicationFeeRefund + , updateApplicationFeeRefund + , GetApplicationFeeRefunds + , getApplicationFeeRefunds + -- * Types + , FeeId (..) + , RefundId (..) + , ApplicationFee (..) + , ApplicationFeeRefund (..) + , StripeList (..) + , EndingBefore (..) + , StartingAfter (..) + , Limit (..) + , ExpandParams (..) + , MetaData (..) + , Amount (..) + ) where + +import Web.Stripe.StripeRequest (Method (GET, POST), StripeHasParam, + StripeRequest (..), StripeReturn, + mkStripeRequest) +import Web.Stripe.Util (()) +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` + -> StripeRequest CreateApplicationFeeRefund +createApplicationFeeRefund + (FeeId feeid) + = request + where request = mkStripeRequest POST url params + url = "application_fees" feeid "refunds" + params = [] + +data CreateApplicationFeeRefund +type instance StripeReturn CreateApplicationFeeRefund = ApplicationFeeRefund +instance StripeHasParam CreateApplicationFeeRefund Amount +instance StripeHasParam CreateApplicationFeeRefund MetaData + +------------------------------------------------------------------------------ +-- | Retrieve an existing 'ApplicationFeeRefund' +getApplicationFeeRefund + :: FeeId -- ^ The `FeeID` associated with the `ApplicationFee` + -> RefundId -- ^ The `ReufndId` associated with the `ApplicationFeeRefund` + -> StripeRequest GetApplicationFeeRefund +getApplicationFeeRefund + (FeeId feeid) + (RefundId refundid) + = request + where request = mkStripeRequest GET url params + url = "application_fees" feeid "refunds" refundid + params = [] + +data GetApplicationFeeRefund +type instance StripeReturn GetApplicationFeeRefund = ApplicationFeeRefund +instance StripeHasParam GetApplicationFeeRefund 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 + -> StripeRequest UpdateApplicationFeeRefund +updateApplicationFeeRefund + (FeeId feeid) + (RefundId refundid) + = request + where + request = mkStripeRequest GET url params + url = "application_fees" feeid "refunds" refundid + params = [] + +data UpdateApplicationFeeRefund +type instance StripeReturn UpdateApplicationFeeRefund = ApplicationFeeRefund +instance StripeHasParam UpdateApplicationFeeRefund MetaData + +------------------------------------------------------------------------------ +-- | Retrieve a list of all 'ApplicationFeeRefund's for a given Application 'FeeId' +getApplicationFeeRefunds + :: FeeId -- ^ The `FeeID` associated with the application + -> StripeRequest GetApplicationFeeRefunds +getApplicationFeeRefunds + (FeeId feeid) = request + where + request = mkStripeRequest GET url params + url = "application_fees" feeid "refunds" + params = [] + +data GetApplicationFeeRefunds +type instance StripeReturn GetApplicationFeeRefunds = (StripeList ApplicationFeeRefund) +instance StripeHasParam GetApplicationFeeRefunds ExpandParams +instance StripeHasParam GetApplicationFeeRefunds (EndingBefore RefundId) +instance StripeHasParam GetApplicationFeeRefunds Limit +instance StripeHasParam GetApplicationFeeRefunds (StartingAfter RefundId) 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,117 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Balance +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#balance > +-- +-- @ +-- {-\# LANGUAGE OverloadedStrings \#-} +-- import Web.Stripe +-- import Web.Stripe.Balance (getBalance) +-- +-- main :: IO () +-- main = do +-- let config = StripeConfig (StripeKey "secret_key") +-- result <- stripe config getBalance +-- case result of +-- Right balance -> print balance +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.Balance + ( -- * API + GetBalance + , getBalance + , GetBalanceTransaction + , getBalanceTransaction + , GetBalanceTransactionHistory + , getBalanceTransactionHistory + -- * Types + , AvailableOn (..) + , Balance (..) + , BalanceAmount (..) + , BalanceTransaction (..) + , Created (..) + , Currency (..) + , EndingBefore (..) + , ExpandParams (..) + , Limit (..) + , Source (..) + , StartingAfter (..) + , StripeList (..) + , TimeRange (..) + , TransactionId (..) + , TransactionType (..) + ) where + +import Web.Stripe.StripeRequest (Method (GET), StripeHasParam, + StripeRequest (..), + StripeReturn, ToStripeParam(..), + mkStripeRequest) +import Web.Stripe.Util (()) +import Web.Stripe.Types (AvailableOn(..), Balance (..), + BalanceAmount(..), BalanceTransaction(..), + Created(..), Currency(..), + EndingBefore(..), ExpandParams(..), + Limit(..), Source(..), StartingAfter(..), + StripeList (..), TimeRange(..), + TransferId(..), TransactionId (..), + TransactionType(..)) +import Web.Stripe.Types.Util (getTransactionId) + +------------------------------------------------------------------------------ +-- | Retrieve the current `Balance` for your Stripe account +getBalance :: StripeRequest GetBalance +getBalance = request + where request = mkStripeRequest GET url params + url = "balance" + params = [] + +data GetBalance +type instance StripeReturn GetBalance = Balance + +------------------------------------------------------------------------------ +-- | Retrieve a 'BalanceTransaction' by 'TransactionId' +getBalanceTransaction + :: TransactionId -- ^ The `TransactionId` of the `Transaction` to retrieve + -> StripeRequest GetBalanceTransaction +getBalanceTransaction + transactionid = request + where request = mkStripeRequest GET url params + url = "balance" "history" getTransactionId transactionid + params = [] + +data GetBalanceTransaction +type instance StripeReturn GetBalanceTransaction = BalanceTransaction +instance StripeHasParam GetBalanceTransaction ExpandParams + +------------------------------------------------------------------------------ +-- | Retrieve the history of `BalanceTransaction`s +getBalanceTransactionHistory + :: StripeRequest GetBalanceTransactionHistory +getBalanceTransactionHistory + = request + where request = mkStripeRequest GET url params + url = "balance" "history" + params = [] + +data GetBalanceTransactionHistory +type instance StripeReturn GetBalanceTransactionHistory = (StripeList BalanceTransaction) +instance StripeHasParam GetBalanceTransactionHistory AvailableOn +instance StripeHasParam GetBalanceTransactionHistory (TimeRange AvailableOn) +instance StripeHasParam GetBalanceTransactionHistory Created +instance StripeHasParam GetBalanceTransactionHistory (TimeRange Created) +instance StripeHasParam GetBalanceTransactionHistory Currency +instance StripeHasParam GetBalanceTransactionHistory (EndingBefore TransactionId) +instance StripeHasParam GetBalanceTransactionHistory Limit +instance StripeHasParam GetBalanceTransactionHistory (StartingAfter TransactionId) +instance (ToStripeParam a) => StripeHasParam GetBalanceTransactionHistory (Source a) +instance StripeHasParam GetBalanceTransactionHistory TransferId +instance StripeHasParam GetBalanceTransactionHistory TransactionType 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,394 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Card +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#cards > +-- +-- @ +-- {-\# LANGUAGE OverloadedStrings \#-} +-- import Web.Stripe +-- import Web.Stripe.Customer +-- import Web.Stripe.Card +-- +-- main :: IO () +-- main = do +-- let config = StripeConfig (StripeKey "secret_key") +-- credit = CardNumber "4242424242424242" +-- em = ExpMonth 12 +-- ey = ExpYear 2015 +-- cvc = CVC "123" +-- cardinfo = (mkNewCard credit em ey) { newCardCVC = Just cvc } +-- result <- stripe config $ createCustomer +-- case result of +-- (Left stripeError) -> print stripeError +-- (Right (Customer { customerId = cid })) -> do +-- result <- stripe config $ createCustomerCard cid cardinfo +-- case result of +-- Right card -> print card +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.Card + ( -- * API + -- ** Customers + -- *** Create Card + CreateCustomerCardByToken + , createCustomerCardByToken + , CreateRecipientCardByToken + , createRecipientCardByToken + , CreateCustomerCard + , createCustomerCard + , CreateRecipientCard + , createRecipientCard + -- *** Get Card(s) + , GetCustomerCard + , getCustomerCard + , GetRecipientCard + , getRecipientCard + , GetCustomerCards + , getCustomerCards + , GetRecipientCards + , getRecipientCards + -- *** Update Card + , UpdateCustomerCard + , updateCustomerCard + , UpdateRecipientCard + , updateRecipientCard + -- *** Delete Card + , DeleteCustomerCard + , deleteCustomerCard + , DeleteRecipientCard + , deleteRecipientCard + -- * Types + , AddressLine1 (..) + , AddressLine2 (..) + , AddressCity (..) + , AddressCountry (..) + , AddressState (..) + , AddressZip (..) + , Brand (..) + , Card (..) + , CardId (..) + , CardNumber (..) + , CVC (..) + , EndingBefore (..) + , ExpandParams (..) + , ExpMonth (..) + , ExpYear (..) + , Limit (..) + , Name (..) + , RecipientCard (..) + , RecipientCardId (..) + , RecipientId (..) + , StartingAfter (..) + ) where + +import Data.Text (Text) +import Web.Stripe.StripeRequest (Method (GET, POST, DELETE), + StripeHasParam, StripeRequest (..), + StripeReturn, ToStripeParam(..), + mkStripeRequest) +import Web.Stripe.Util (()) +import Web.Stripe.Types (AddressLine1(..), AddressLine2(..) + , AddressCity(..), AddressCountry(..) + , AddressState(..), AddressZip(..) + , Brand(..), Card(..), CardId(..) + , CardNumber(..), CustomerId(..) + , CVC(..), EndingBefore(..) + , ExpandParams(..) + , ExpMonth(..), ExpYear(..), ID + , Limit(..), Name(..), NewCard(..) + , RecipientCard(..) + , RecipientId(..), RecipientCardId(..) + , StartingAfter(..) + , StripeDeleteResult(..) + , StripeList(..), TokenId(..), URL) +import Web.Stripe.Types.Util (getCustomerId, getRecipientId) + +------------------------------------------------------------------------------ +-- | INTERNAL: generalized `Card` creation from a `TokenId` +createCardByToken + :: URL -- ^ "customer" or "recepient" + -> ID -- ^ id of customer or recipient + -> TokenId -- ^ `TokenId` of card to add + -> StripeRequest a +createCardByToken + prefix + id_ + tokenid = request + where request = mkStripeRequest POST url params + url = prefix id_ "cards" + params = toStripeParam tokenid [] + +------------------------------------------------------------------------------ +-- | `Customer` `Card` creation from a `TokenId` +createCustomerCardByToken + :: CustomerId -- ^ `CustomerId` of card holder + -> TokenId -- ^ `TokenId` of card to add + -> StripeRequest CreateCustomerCardByToken +createCustomerCardByToken + customerid + tokenid = + createCardByToken "customers" (getCustomerId customerid) tokenid + +data CreateCustomerCardByToken +type instance StripeReturn CreateCustomerCardByToken = Card + +------------------------------------------------------------------------------ +-- | `Recipient` `Card` creation from a `TokenId` +createRecipientCardByToken + :: RecipientId -- ^ `RecipientId` of card holder + -> TokenId -- ^ `TokenId` of card to add + -> StripeRequest CreateRecipientCardByToken +createRecipientCardByToken + recipientid + tokenid = + createCardByToken "recipients" (getRecipientId recipientid) tokenid + +data CreateRecipientCardByToken +type instance StripeReturn CreateRecipientCardByToken = RecipientCard + +------------------------------------------------------------------------------ +-- | INTERNAL: generalized `Card` creation from card info +createCard + :: URL + -> ID + -> NewCard + -> StripeRequest a +createCard + prefix + id_ + newCard = request + where request = mkStripeRequest POST url params + url = prefix id_ "cards" + params = toStripeParam newCard [] + +------------------------------------------------------------------------------ +-- | `Customer` `Card` creation from card info +createCustomerCard + :: CustomerId -- ^ `RecipientId` of card holder + -> NewCard -- ^ `NewCard` data for the card + -> StripeRequest CreateCustomerCard +createCustomerCard + customerid + newCard = createCard "customers" (getCustomerId customerid) newCard + +data CreateCustomerCard +type instance StripeReturn CreateCustomerCard = Card + +------------------------------------------------------------------------------ +-- | `Recipient` `Card` creation from card info +createRecipientCard + :: RecipientId -- ^ `RecipientId` of card holder + -> NewCard -- ^ `NewCard` data for the card + -> StripeRequest CreateRecipientCard +createRecipientCard + recipientid + newCard = createCard "recipients" (getRecipientId recipientid) newCard + +data CreateRecipientCard +type instance StripeReturn CreateRecipientCard = RecipientCard + +------------------------------------------------------------------------------ +-- | INTERNAL: generalized Get card by `CustomerId` and `CardId` +getCard + :: URL + -> ID + -> Text -- card id + -> StripeRequest a +getCard + prefix + id_ + cardid_ = request + where request = mkStripeRequest GET url params + url = prefix id_ + "cards" cardid_ + params = [] + +------------------------------------------------------------------------------ +-- | Get card by `CustomerId` and `CardId` +getCustomerCard + :: CustomerId -- ^ `CustomerId` of the `Card` to retrieve + -> CardId -- ^ `CardId` of the card to retrieve + -> StripeRequest GetCustomerCard +getCustomerCard + customerid + (CardId cardid) = getCard "customers" (getCustomerId customerid) cardid + +data GetCustomerCard +type instance StripeReturn GetCustomerCard = Card +instance StripeHasParam GetCustomerCard ExpandParams + +------------------------------------------------------------------------------ +-- | Get card by `RecipientId` and `RecipientCardId` +getRecipientCard + :: RecipientId -- ^ `RecipientId` of the `Card` to retrieve + -> RecipientCardId -- ^ `CardId` of the card to retrieve + -> StripeRequest GetRecipientCard +getRecipientCard + recipientid + (RecipientCardId cardid) + = getCard "recipients" (getRecipientId recipientid) cardid + +data GetRecipientCard +type instance StripeReturn GetRecipientCard = RecipientCard +instance StripeHasParam GetRecipientCard ExpandParams + +------------------------------------------------------------------------------ +-- | INTERNAL: Generalized update a `Card` +updateCard + :: URL + -> ID + -> Text -- ^ cardid + -> StripeRequest a +updateCard + prefix + id_ + cardid_ = request + where request = mkStripeRequest POST url params + url = prefix id_ + "cards" cardid_ + params = [] + +------------------------------------------------------------------------------ +-- | Update a `Customer` `Card` +updateCustomerCard + :: CustomerId -- ^ `CustomerId` of the card holder + -> CardId -- ^ `CardId` of card to update + -> StripeRequest UpdateCustomerCard +updateCustomerCard + customerid + (CardId cardid) + = updateCard "customers" (getCustomerId customerid) cardid + +data UpdateCustomerCard +type instance StripeReturn UpdateCustomerCard = Card +instance StripeHasParam UpdateCustomerCard AddressLine1 +instance StripeHasParam UpdateCustomerCard AddressLine2 +instance StripeHasParam UpdateCustomerCard AddressCity +instance StripeHasParam UpdateCustomerCard AddressZip +instance StripeHasParam UpdateCustomerCard AddressState +instance StripeHasParam UpdateCustomerCard AddressCountry +instance StripeHasParam UpdateCustomerCard ExpMonth +instance StripeHasParam UpdateCustomerCard ExpYear +instance StripeHasParam UpdateCustomerCard Name + + +------------------------------------------------------------------------------ +-- | Update a `Recipient` `Card` +updateRecipientCard + :: RecipientId -- ^ `RecipientId` of the card holder + -> RecipientCardId -- ^ `RecipientCardId` of the card to update + -> StripeRequest UpdateRecipientCard +updateRecipientCard + recipientid + (RecipientCardId cardid) + = updateCard "recipients" (getRecipientId recipientid) cardid + +data UpdateRecipientCard +type instance StripeReturn UpdateRecipientCard = RecipientCard +instance StripeHasParam UpdateRecipientCard AddressLine1 +instance StripeHasParam UpdateRecipientCard AddressLine2 +instance StripeHasParam UpdateRecipientCard AddressCity +instance StripeHasParam UpdateRecipientCard AddressZip +instance StripeHasParam UpdateRecipientCard AddressState +instance StripeHasParam UpdateRecipientCard AddressCountry +instance StripeHasParam UpdateRecipientCard ExpMonth +instance StripeHasParam UpdateRecipientCard ExpYear +instance StripeHasParam UpdateRecipientCard Name + +------------------------------------------------------------------------------ +-- | INTERNAL: Generalized remove a card from a `Customer` +deleteCard + :: URL + -> ID + -> Text -- ^ `CardId` associated with `Card` to be deleted + -> StripeRequest a +deleteCard + prefix + id_ + cardid_ = request + where request = mkStripeRequest DELETE url params + url = prefix id_ "cards" cardid_ + params = [] + +------------------------------------------------------------------------------ +-- | Removes a `Card` with from a `Customer` +deleteCustomerCard + :: CustomerId -- ^ `CustomerId` of the `Card` to be deleted + -> CardId -- ^ `CardId` associated with `Card` to be deleted + -> StripeRequest DeleteCustomerCard +deleteCustomerCard + customerid + (CardId cardid) = deleteCard "customers" (getCustomerId customerid) cardid + +data DeleteCustomerCard +type instance StripeReturn DeleteCustomerCard = StripeDeleteResult + +------------------------------------------------------------------------------ +-- | Removes a `RecipientCard` with from a `Recipient` +deleteRecipientCard + :: RecipientId -- ^ `RecipientId` of the `Card` to retrieve + -> RecipientCardId -- ^ `CardId` associated with `Card` to be deleted + -> StripeRequest DeleteRecipientCard +deleteRecipientCard + recipientid + (RecipientCardId cardid) + = deleteCard "recipients" (getRecipientId recipientid) cardid + +data DeleteRecipientCard +type instance StripeReturn DeleteRecipientCard = StripeDeleteResult + +------------------------------------------------------------------------------ +-- | INTERNAL: Generalized retrieve all cards for `ID` +getCards + :: URL + -> ID + -> StripeRequest a +getCards + prefix + id_ + = request + where request = mkStripeRequest GET url params + url = prefix id_ "cards" + params = [] + +------------------------------------------------------------------------------ +-- | Retrieve all cards associated with a `Customer` +getCustomerCards + :: CustomerId -- ^ The `CustomerId` associated with the cards + -> StripeRequest GetCustomerCards +getCustomerCards + customerid + = getCards "customers" (getCustomerId customerid) + +data GetCustomerCards +type instance StripeReturn GetCustomerCards = (StripeList Card) +instance StripeHasParam GetCustomerCards ExpandParams +instance StripeHasParam GetCustomerCards (EndingBefore CardId) +instance StripeHasParam GetCustomerCards Limit +instance StripeHasParam GetCustomerCards (StartingAfter CardId) + +------------------------------------------------------------------------------ +-- | Retrieve all cards associated with a `Recipient` +getRecipientCards + :: RecipientId -- ^ The `RecipientId` associated with the cards + -> StripeRequest GetRecipientCards +getRecipientCards + recipientid + = getCards "recipients" (getRecipientId recipientid) + +data GetRecipientCards +type instance StripeReturn GetRecipientCards = (StripeList RecipientCard) +instance StripeHasParam GetRecipientCards ExpandParams +instance StripeHasParam GetRecipientCards (EndingBefore CardId) +instance StripeHasParam GetRecipientCards Limit +instance StripeHasParam GetRecipientCards (StartingAfter CardId) 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,196 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Charge +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#charges > +-- +-- @ +-- {-\# LANGUAGE OverloadedStrings \#-} +-- import Web.Stripe +-- import Web.Stripe.Customer +-- import Web.Stripe.Charge +-- +-- main :: IO () +-- main = do +-- let config = StripeConfig (StripeKey "secret_key") +-- credit = CardNumber "4242424242424242" +-- em = ExpMonth 12 +-- ey = ExpYear 2015 +-- cvc = CVC "123" +-- cardinfo = (newCard credit em ey) { newCardCVC = Just cvc } +-- result <- stripe config createCustomer +-- -&- cardinfo +-- case result of +-- (Left stripeError) -> print stripeError +-- (Customer { customerId = cid }) -> +-- do result <- stripe config $ createCharge (Amount 100) USD +-- -&- cid +-- case result of +-- Left stripeError -> print stripeError +-- Right charge -> print charge +-- @ +module Web.Stripe.Charge + ( -- * API + ---- * Create Charges + CreateCharge + , createCharge + ---- * Get Charge(s) + , GetCharge + , getCharge + , GetCharges + , getCharges + ---- * Update Charge + , UpdateCharge + , updateCharge + ---- * Capture Charge + , CaptureCharge + , captureCharge + -- * Types + , Amount (..) + , ApplicationFeeAmount(..) + , CardNumber (..) + , Capture (..) + , Charge (..) + , ChargeId (..) + , Created (..) + , Currency (..) + , CustomerId (..) + , Customer (..) + , CVC (..) + , Description (..) + , Email (..) + , EndingBefore (..) + , ExpandParams (..) + , ExpMonth (..) + , ExpYear (..) + , Limit (..) + , MetaData (..) + , NewCard (..) + , ReceiptEmail (..) + , StartingAfter (..) + , StatementDescription (..) + , StripeList (..) + , TokenId (..) + ) where + +import Web.Stripe.StripeRequest (Method (GET, POST), + StripeHasParam, ToStripeParam(..), + StripeRequest (..), StripeReturn, + mkStripeRequest) +import Web.Stripe.Util (()) +import Web.Stripe.Types (Amount(..), ApplicationFeeAmount(..), + CVC (..), + Capture(..), + CardNumber (..), Charge (..), + ChargeId (..), Created(..), + Currency (..), Customer(..), + CustomerId (..), Description(..), + EndingBefore(..), ExpMonth (..), + ExpYear (..), Limit(..), MetaData(..), + NewCard(..), Email (..), + StartingAfter(..), + ReceiptEmail(..), + StatementDescription(..), + ExpandParams(..), + StripeList (..), TokenId (..)) +import Web.Stripe.Types.Util (getChargeId) + +------------------------------------------------------------------------------ +-- | Create a `Charge` +createCharge + :: Amount -- ^ `Amount` to charge + -> Currency -- ^ `Currency` for charge + -> StripeRequest CreateCharge +createCharge + amount + currency = request + where request = mkStripeRequest POST url params + url = "charges" + params = toStripeParam amount $ + toStripeParam currency $ + [] + +data CreateCharge +type instance StripeReturn CreateCharge = Charge +instance StripeHasParam CreateCharge CustomerId +instance StripeHasParam CreateCharge NewCard +instance StripeHasParam CreateCharge TokenId +instance StripeHasParam CreateCharge Description +instance StripeHasParam CreateCharge MetaData +instance StripeHasParam CreateCharge Capture +instance StripeHasParam CreateCharge StatementDescription +instance StripeHasParam CreateCharge ReceiptEmail +instance StripeHasParam CreateCharge ApplicationFeeAmount + +------------------------------------------------------------------------------ +-- | Retrieve a `Charge` by `ChargeId` +getCharge + :: ChargeId -- ^ The `Charge` to retrive + -> StripeRequest GetCharge +getCharge + chargeid = request + where request = mkStripeRequest GET url params + url = "charges" getChargeId chargeid + params = [] + +data GetCharge +type instance StripeReturn GetCharge = Charge +instance StripeHasParam GetCharge ExpandParams + +------------------------------------------------------------------------------ +-- | A `Charge` to be updated +updateCharge + :: ChargeId -- ^ The `Charge` to update + -> StripeRequest UpdateCharge +updateCharge + chargeid = request + where request = mkStripeRequest POST url params + url = "charges" getChargeId chargeid + params = [] + +data UpdateCharge +type instance StripeReturn UpdateCharge = Charge +instance StripeHasParam UpdateCharge Description +instance StripeHasParam UpdateCharge MetaData + +------------------------------------------------------------------------------ +-- | a `Charge` to be captured +captureCharge + :: ChargeId -- ^ The `ChargeId` of the `Charge` to capture + -> StripeRequest CaptureCharge +captureCharge + chargeid = request + where request = mkStripeRequest POST url params + url = "charges" getChargeId chargeid "capture" + params = [] + +data CaptureCharge +type instance StripeReturn CaptureCharge = Charge +instance StripeHasParam CaptureCharge Amount +instance StripeHasParam CaptureCharge ReceiptEmail + +------------------------------------------------------------------------------ +-- | Retrieve all `Charge`s +getCharges + :: StripeRequest GetCharges +getCharges = request + where request = mkStripeRequest GET url params + url = "charges" + params = [] + +data GetCharges +type instance StripeReturn GetCharges = StripeList Charge +instance StripeHasParam GetCharges ExpandParams +instance StripeHasParam GetCharges Created +instance StripeHasParam GetCharges CustomerId +instance StripeHasParam GetCharges (EndingBefore ChargeId) +instance StripeHasParam GetCharges Limit +instance StripeHasParam GetCharges (StartingAfter ChargeId) 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,128 @@ +{-# LANGUAGE DeriveDataTypeable #-} +-- | +-- Module : Web.Stripe.Client +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +module Web.Stripe.Client + ( module Web.Stripe.StripeRequest + , module Web.Stripe.Error + , module Web.Stripe.Util + , handleStream + , parseFail + , attemptDecode + , unknownCode + , StripeConfig (..) + , StripeKey (..) + , APIVersion (..) + ) where + +import Data.Aeson (Value, Result(..), fromJSON) +import Data.ByteString (ByteString) +import Data.Data (Data, Typeable) +import Data.Monoid (mempty) +import Data.Text as T +import Text.Read (lexP, pfail) +import qualified Text.Read as R +import Web.Stripe.StripeRequest +import Web.Stripe.Error +import Web.Stripe.Util + + +------------------------------------------------------------------------------ +-- | Stripe secret key +newtype StripeKey = StripeKey + { getStripeKey :: ByteString + } deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Stripe config +data StripeConfig = StripeConfig + { secretKey :: StripeKey + } deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | API Version +data APIVersion = + V20141007 -- ^ Stripe API Version for this package release + deriving (Eq, Ord, Data, Typeable) + +instance Show APIVersion where + show V20141007 = "2014-10-07" + +instance Read APIVersion where + readPrec = + do (R.String s) <- lexP + case s of + "2014-10-07" -> return V20141007 + _ -> pfail + +------------------------------------------------------------------------------ +-- | handleStream +-- +-- This function is used by the backends such as @stripe-http-client@ to +-- decode the results of an API request. +handleStream + :: (Value -> Result a) -- ^ function to decode JSON value + -> Int -- ^ HTTP response code + -> Result Value -- ^ result of attempting to decode body + -> Either StripeError a +handleStream decodeValue statusCode r = + case statusCode of + 200 -> case r of + Error message -> parseFail message + (Success value) -> + case decodeValue value of + (Error message) -> parseFail message + (Success a) -> (Right a) + code | code >= 400 -> + case r of + Error message -> parseFail message + (Success value) -> + case fromJSON value of + (Error message) -> parseFail message + (Success stripeError) -> + Left $ setErrorHTTP code stripeError + _ -> unknownCode + +------------------------------------------------------------------------------ +-- | check the HTTP status code and see if it is one we can deal with or not +attemptDecode + :: Int -- ^ HTTP status code + -> Bool +attemptDecode code = code == 200 || code >= 400 + +------------------------------------------------------------------------------ +-- | lift a parser error to be a StripeError +parseFail + :: String -- ^ error message + -> Either StripeError a +parseFail errorMessage = + Left $ StripeError ParseFailure (T.pack errorMessage) Nothing Nothing Nothing + +------------------------------------------------------------------------------ +-- | `StripeError` to return when we don't know what to do with the +-- received HTTP status code. +unknownCode :: Either StripeError a +unknownCode = + Left $ StripeError UnknownErrorType mempty Nothing Nothing Nothing + +------------------------------------------------------------------------------ +-- | set the `errorHTTP` field of the `StripeError` based on the HTTP +-- response code. +setErrorHTTP + :: Int -- ^ HTTP Status code + -> StripeError -- ^ `StripeError` + -> StripeError +setErrorHTTP statusCode stripeError = + case statusCode of + 400 -> stripeError { errorHTTP = Just BadRequest } + 401 -> stripeError { errorHTTP = Just UnAuthorized } + 402 -> stripeError { errorHTTP = Just RequestFailed } + 404 -> stripeError { errorHTTP = Just NotFound } + 500 -> stripeError { errorHTTP = Just StripeServerError } + 502 -> stripeError { errorHTTP = Just StripeServerError } + 503 -> stripeError { errorHTTP = Just StripeServerError } + 504 -> stripeError { errorHTTP = Just StripeServerError } + _ -> stripeError { errorHTTP = Just UnknownHTTPCode } 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,163 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Coupon +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#coupons > +-- +-- @ +-- {-\# LANGUAGE OverloadedStrings \#-} +-- import Web.Stripe +-- import Web.Stripe.Coupon +-- +-- main :: IO () +-- main = do +-- let config = StripeConfig (StripeKey "secret_key") +-- result <- stripe config $ +-- createCoupon (Just $ CouponId "$1 Off!") Once +-- -&- (AmountOff 1) +-- -&- USD +-- case result of +-- Right coupon -> print coupon +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.Coupon + ( -- * API + CreateCoupon + , createCoupon + , GetCoupon + , getCoupon + , UpdateCoupon + , updateCoupon + , DeleteCoupon + , deleteCoupon + , GetCoupons + , getCoupons + -- * Types + , AmountOff (..) + , Coupon (..) + , CouponId (..) + , Currency (..) + , Duration (..) + , DurationInMonths (..) + , EndingBefore (..) + , Limit (..) + , MaxRedemptions (..) + , MetaData (..) + , PercentOff (..) + , RedeemBy (..) + , StartingAfter (..) + , StripeDeleteResult (..) + , StripeList (..) + ) where + +import Data.Text (Text) +import Web.Stripe.StripeRequest (Method (GET, POST, DELETE), Param(..), + StripeHasParam, StripeRequest (..), + StripeReturn, ToStripeParam(..), + mkStripeRequest) +import Web.Stripe.Util (()) +import Web.Stripe.Types (AmountOff (..), Coupon (..), + CouponId (..), Currency (..), + Duration(..), DurationInMonths (..), + EndingBefore(..), Limit(..), + MaxRedemptions (..), MetaData(..), + PercentOff (..), RedeemBy (..), + StartingAfter(..), + StripeDeleteResult (..), + StripeList (..)) + +------------------------------------------------------------------------------ +-- | Create `Coupon` +createCoupon + :: Maybe CouponId -- ^ Name of the `Coupon` + -> Duration -- ^ `Duration` of the `Coupon` + -> StripeRequest CreateCoupon +createCoupon + mcouponid + duration = request + where request = mkStripeRequest POST url params + url = "coupons" + params = case mcouponid of + Just (CouponId name) -> + toStripeParam (Param ("id"::Text, name)) $ + toStripeParam duration $ + [] + Nothing -> [] + +data CreateCoupon +type instance StripeReturn CreateCoupon = Coupon +instance StripeHasParam CreateCoupon AmountOff +instance StripeHasParam CreateCoupon Currency +instance StripeHasParam CreateCoupon DurationInMonths +instance StripeHasParam CreateCoupon MaxRedemptions +instance StripeHasParam CreateCoupon MetaData +instance StripeHasParam CreateCoupon PercentOff +instance StripeHasParam CreateCoupon RedeemBy + +------------------------------------------------------------------------------ +-- | Retrieve `Coupon` +getCoupon + :: CouponId -- ^ `CouponId` of the `Coupon` to retrieve + -> StripeRequest GetCoupon +getCoupon + (CouponId couponid) = request + where request = mkStripeRequest GET url params + url = "coupons" couponid + params = [] + +data GetCoupon +type instance StripeReturn GetCoupon = Coupon + +------------------------------------------------------------------------------ +-- | Update `Coupon` +updateCoupon + :: CouponId -- ^ The `CoupondId` of the `Coupon` to update + -> StripeRequest UpdateCoupon +updateCoupon + (CouponId couponid) + = request + where request = mkStripeRequest POST url params + url = "coupons" couponid + params = [] + +data UpdateCoupon +type instance StripeReturn UpdateCoupon = Coupon +instance StripeHasParam UpdateCoupon MetaData + +------------------------------------------------------------------------------ +-- | Delete `Coupon` +deleteCoupon + :: CouponId -- ^ The `CoupondId` of the `Coupon` to delete + -> StripeRequest DeleteCoupon +deleteCoupon + (CouponId couponid) = request + where request = mkStripeRequest DELETE url params + url = "coupons" couponid + params = [] + +data DeleteCoupon +type instance StripeReturn DeleteCoupon = StripeDeleteResult + +------------------------------------------------------------------------------ +-- | Retrieve a list of `Coupon`s +getCoupons + :: StripeRequest GetCoupons +getCoupons + = request + where request = mkStripeRequest GET url params + url = "coupons" + params = [] + +data GetCoupons +type instance StripeReturn GetCoupons = (StripeList Coupon) +instance StripeHasParam GetCoupons (EndingBefore CouponId) +instance StripeHasParam GetCoupons Limit +instance StripeHasParam GetCoupons (StartingAfter CouponId) 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,178 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Customer +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#customers > +-- +-- @ +-- {-\# LANGUAGE OverloadedStrings \#-} +-- import Web.Stripe +-- import Web.Stripe.Customer +-- +-- main :: IO () +-- main = do +-- let config = StripeConfig (StripeKey "secret_key") +-- result <- stripe config createCustomer +-- case result of +-- Right customer -> print customer +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.Customer + ( -- * API + ---- * Create customer + CreateCustomer + , createCustomer + ---- * Retrieve customer + , GetCustomer + , getCustomer + ---- * Update customer + , UpdateCustomer + , updateCustomer + ---- * Delete customer + , DeleteCustomer + , deleteCustomer + ---- * List customers + , GetCustomers + , getCustomers + -- * Types + , AccountBalance (..) + , CardId (..) + , CardNumber (..) + , CouponId (..) + , Created (..) + , Customer (..) + , CustomerId (..) + , CVC (..) + , Description (..) + , Email (..) + , EndingBefore (..) + , ExpandParams (..) + , ExpMonth (..) + , ExpYear (..) + , Limit (..) + , MetaData (..) + , mkNewCard + , NewCard (..) + , PlanId (..) + , Quantity (..) + , StartingAfter (..) + , StripeDeleteResult (..) + , StripeList (..) + , TokenId (..) + , TrialEnd (..) + ) where + +import Web.Stripe.StripeRequest (Method (GET, POST, DELETE), + StripeHasParam, StripeRequest (..), + StripeReturn, mkStripeRequest) +import Web.Stripe.Util (()) +import Web.Stripe.Types (AccountBalance(..), CVC (..), + CardId (..), CardNumber (..), + CouponId (..), Created(..), Customer (..), + CustomerId (..), DefaultCard(..), + Description(..), Email (..), + EndingBefore(..), ExpMonth (..), + ExpYear (..), Limit(..), PlanId (..), + Quantity (..), MetaData(..), + mkNewCard, NewCard(..), StartingAfter(..), + StripeDeleteResult (..), + StripeList (..), TokenId (..), + TrialEnd(..), ExpandParams(..)) +import Web.Stripe.Types.Util + +------------------------------------------------------------------------------ +-- | Create a customer +createCustomer :: StripeRequest CreateCustomer +createCustomer = request + where request = mkStripeRequest POST url params + url = "customers" + params = [] + +data CreateCustomer +type instance StripeReturn CreateCustomer = Customer +instance StripeHasParam CreateCustomer AccountBalance +instance StripeHasParam CreateCustomer NewCard +instance StripeHasParam CreateCustomer TokenId +instance StripeHasParam CreateCustomer CouponId +instance StripeHasParam CreateCustomer Description +instance StripeHasParam CreateCustomer Email +instance StripeHasParam CreateCustomer MetaData +instance StripeHasParam CreateCustomer PlanId +instance StripeHasParam CreateCustomer Quantity +instance StripeHasParam CreateCustomer TrialEnd + +------------------------------------------------------------------------------ +-- | Retrieve a customer +getCustomer + :: CustomerId -- ^ `CustomerId` of `Customer` to retrieve + -> StripeRequest GetCustomer +getCustomer + customerid = request + where request = mkStripeRequest GET url params + url = "customers" getCustomerId customerid + params = [] + +data GetCustomer +type instance StripeReturn GetCustomer = Customer +instance StripeHasParam GetCustomer ExpandParams + +------------------------------------------------------------------------------ +-- | Update a `Customer` +updateCustomer + :: CustomerId -- ^ `CustomerId` of `Customer` to update + -> StripeRequest UpdateCustomer +updateCustomer customerid = request + where request = mkStripeRequest POST url params + url = "customers" getCustomerId customerid + params = [] + +data UpdateCustomer +type instance StripeReturn UpdateCustomer = Customer +instance StripeHasParam UpdateCustomer AccountBalance +instance StripeHasParam UpdateCustomer TokenId +instance StripeHasParam UpdateCustomer NewCard +instance StripeHasParam UpdateCustomer CouponId +instance StripeHasParam UpdateCustomer DefaultCard +instance StripeHasParam UpdateCustomer Description +instance StripeHasParam UpdateCustomer Email +instance StripeHasParam UpdateCustomer MetaData + +------------------------------------------------------------------------------ +-- | Deletes the specified `Customer` +data DeleteCustomer +type instance StripeReturn DeleteCustomer = StripeDeleteResult +deleteCustomer + :: CustomerId -- ^ The `CustomerId` of the `Customer` to delete + -> StripeRequest DeleteCustomer +deleteCustomer customerid = request + where request = mkStripeRequest DELETE url params + url = "customers" getCustomerId customerid + params = [] + + +------------------------------------------------------------------------------ +-- | Retrieve up to 100 customers at a time +getCustomers + :: StripeRequest GetCustomers +getCustomers = + request + where request = mkStripeRequest GET url params + url = "customers" + params = [] + +data GetCustomers +type instance StripeReturn GetCustomers = (StripeList Customer) +instance StripeHasParam GetCustomers ExpandParams +instance StripeHasParam GetCustomers Created +instance StripeHasParam GetCustomers (EndingBefore CustomerId) +instance StripeHasParam GetCustomers Limit +instance StripeHasParam GetCustomers (StartingAfter CustomerId) + 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,78 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Discount +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#discounts > +-- +-- @ +-- {-\# LANGUAGE OverloadedStrings \#-} +-- import Web.Stripe +-- import Web.Stripe.Discount +-- import Web.Stripe.Customer +-- +-- main :: IO () +-- main = do +-- let config = StripeConfig (StripeKey "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 + , deleteCustomerDiscount + , DeleteSubscriptionDiscount + , deleteSubscriptionDiscount + -- * Types + , StripeDeleteResult (..) + , CustomerId (..) + , SubscriptionId (..) + , Discount (..) + ) where + +import Web.Stripe.StripeRequest (Method (DELETE), StripeReturn, + StripeRequest (..), mkStripeRequest) +import Web.Stripe.Util (()) +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` + -> StripeRequest DeleteCustomerDiscount +deleteCustomerDiscount + customerId = request + where request = mkStripeRequest DELETE url params + url = "customers" getCustomerId customerId "discount" + params = [] + +data DeleteCustomerDiscount +type instance StripeReturn DeleteCustomerDiscount = StripeDeleteResult + +------------------------------------------------------------------------------ +-- | Delete `Subscription` `Discount` by `CustomerId` and `SubscriptionId` +deleteSubscriptionDiscount + :: CustomerId -- ^ The `Customer` to remove the `Discount` from + -> SubscriptionId -- ^ The `Subscription` to remove the `Discount` from + -> StripeRequest DeleteSubscriptionDiscount +deleteSubscriptionDiscount + customerId + (SubscriptionId subId) = request + where request = mkStripeRequest DELETE url params + url = "customers" getCustomerId customerId "subscriptions" subId "discount" + params = [] + +data DeleteSubscriptionDiscount +type instance StripeReturn DeleteSubscriptionDiscount = StripeDeleteResult 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,86 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Dispute +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#diputes > +-- +-- @ +-- {-\# LANGUAGE OverloadedStrings \#-} +-- import Web.Stripe +-- import Web.Stripe.Charge +-- import Web.Stripe.Dispute +-- +-- main :: IO () +-- main = do +-- let config = StripeConfig (StripeKey "secret_key") +-- result <- stripe config $ getCharge (ChargeId "charge_id") +-- case result of +-- (Left stripeError) -> print stripeError +-- (Right (Charge { chargeDispute = dispute })) -> +-- case dispute of +-- (Just dispute) -> print dispute +-- Nothing -> print "no dispute on this charge" +-- @ +module Web.Stripe.Dispute + ( -- * API + UpdateDispute + , updateDispute + , CloseDispute + , closeDispute + -- * Types + , ChargeId (..) + , Dispute (..) + , DisputeReason (..) + , DisputeStatus (..) + , Evidence (..) + , MetaData (..) + ) where + +import Web.Stripe.StripeRequest (Method (POST), + StripeHasParam, StripeRequest (..), + StripeReturn, + mkStripeRequest) +import Web.Stripe.Util (()) +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 + -> StripeRequest UpdateDispute +updateDispute + chargeId = request + where request = mkStripeRequest POST url params + url = "charges" getChargeId chargeId "dispute" + params = [] + +data UpdateDispute +type instance StripeReturn UpdateDispute = Dispute +instance StripeHasParam UpdateDispute Evidence +instance StripeHasParam UpdateDispute MetaData + +------------------------------------------------------------------------------ +-- | `Dispute` to be closed +closeDispute + :: ChargeId -- ^ The ID of the Charge being disputed + -> StripeRequest CloseDispute +closeDispute + chargeId = request + where request = mkStripeRequest POST url params + url = "charges" getChargeId chargeId "dispute" "close" + params = [] + +data CloseDispute +type instance StripeReturn CloseDispute = Dispute diff --git a/src/Web/Stripe/Error.hs b/src/Web/Stripe/Error.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/Error.hs @@ -0,0 +1,108 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Web.Stripe.Error +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +module Web.Stripe.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/Event.hs b/src/Web/Stripe/Event.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/Event.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Event +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#events > +-- +-- @ +-- {-\# LANGUAGE OverloadedStrings \#-} +-- import Web.Stripe +-- import Web.Stripe.Event +-- +-- main :: IO () +-- main = do +-- let config = StripeConfig (StripeKey "secret_key") +-- result <- stripe config $ getEvents +-- case result of +-- Right events -> print events +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.Event + ( -- * API + GetEvent + , getEvent + , GetEvents + , getEvents + -- * Types + , Created (..) + , EndingBefore (..) + , EventId (..) + , Event (..) + , EventData (..) + , EventType (..) + , StripeList (..) + , Limit (..) + , StartingAfter (..) + ) where + +import Web.Stripe.StripeRequest (Method (GET), + StripeHasParam, StripeRequest (..), + StripeReturn, + mkStripeRequest) +import Web.Stripe.Util (()) +import Web.Stripe.Types (Created(..), Event (..), + EventId (..), Limit, + EventData(..), + EventType(..), StripeList (..), + Limit(..), StartingAfter(..), + EndingBefore(..)) + +------------------------------------------------------------------------------ +-- | `Event` to retrieve by `EventId` +getEvent + :: EventId -- ^ The ID of the Event to retrieve + -> StripeRequest GetEvent +getEvent (EventId eventid) = request + where request = mkStripeRequest GET url params + url = "events" eventid + params = [] + +data GetEvent +type instance StripeReturn GetEvent = Event + +------------------------------------------------------------------------------ +-- | `StripeList` of `Event`s to retrieve +getEvents + :: StripeRequest GetEvents +getEvents + = request + where request = mkStripeRequest GET url params + url = "events" + params = [] + +data GetEvents +type instance StripeReturn GetEvents = (StripeList Event) +instance StripeHasParam GetEvents Created +instance StripeHasParam GetEvents (EndingBefore EventId) +instance StripeHasParam GetEvents Limit +instance StripeHasParam GetEvents (StartingAfter EventId) +-- instance StripeHasParam GetEvents EventType -- FIXME 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,220 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Invoice +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#invoices > +-- +-- @ +-- {-\# LANGUAGE OverloadedStrings \#-} +-- import Web.Stripe +-- import Web.Stripe.Customer +-- import Web.Stripe.Invoice +-- import Web.Stripe.InvoiceItem +-- import Web.Stripe.Plan +-- +-- main :: IO () +-- main = do +-- let config = StripeConfig (SecretKey "secret_key") +-- result <- stripe config createCustomer +-- case result of +-- (Left stripeError) -> print stripeError +-- (Right (Customer { customerId = cid })) -> +-- do result <- stripe config $ +-- createPlan (PlanId "planid") (Amount 20) USD Day (PlanName "testplan") +-- case result of +-- (Left stripeError) -> print stripeError +-- (Right (Plan {})) -> +-- do result <- stripe config $ +-- createInvoiceItem cid (Amount 100) USD +-- case result of +-- (Left stripeError) -> print stripeError +-- (Right invoiceItem) -> +-- do result <- stripe config $ createInvoice cid +-- case result of +-- (Left stripeError) -> print stripeError +-- (Right invoice) -> print invoice +-- @ +module Web.Stripe.Invoice + ( -- * API + CreateInvoice + , createInvoice + , GetInvoice + , getInvoice + , GetInvoiceLineItems + , getInvoiceLineItems + , GetUpcomingInvoice + , getUpcomingInvoice + , UpdateInvoice + , updateInvoice + , PayInvoice + , payInvoice + , GetInvoices + , getInvoices + -- * Types + , ApplicationFeeId (..) + , Closed (..) + , CustomerId (..) + , Description (..) + , Discount (..) + , EndingBefore (..) + , ExpandParams (..) + , Forgiven (..) + , Invoice (..) + , InvoiceId (..) + , InvoiceLineItem (..) + , InvoiceLineItemId (..) + , InvoiceLineItemType (..) + , Limit (..) + , MetaData (..) + , Period (..) + , StatementDescription(..) + , StartingAfter (..) + , StripeList (..) + , SubscriptionId (..) + ) where + +import Web.Stripe.StripeRequest (Method(GET, POST), StripeRequest(..), + StripeReturn, StripeHasParam, + toStripeParam, mkStripeRequest) +import Web.Stripe.Util (()) +import Web.Stripe.Types (ApplicationFeeId(..), Closed(..), + CustomerId(..), Description(..), + Discount(..), EndingBefore(..), + ExpandParams(..), Forgiven(..), + Invoice(..),InvoiceId(..), + InvoiceLineItem(..), + InvoiceLineItemId(..), + InvoiceLineItemType(..), + Limit(..), MetaData(..), Period(..), + SubscriptionId(..), StartingAfter(..), + StatementDescription(..), + StripeList(..)) +import Web.Stripe.Types.Util (getInvoiceId) + +------------------------------------------------------------------------------ +-- | The `Invoice` to be created for a `Customer` +createInvoice + :: CustomerId -- ^ `CustomerId` of `Customer` to `Invoice` + -> StripeRequest CreateInvoice +createInvoice + customerid + = request + where request = mkStripeRequest POST url params + url = "invoices" + params = toStripeParam customerid $ + [] + +data CreateInvoice +type instance StripeReturn CreateInvoice = Invoice +instance StripeHasParam CreateInvoice ApplicationFeeId +instance StripeHasParam CreateInvoice Description +instance StripeHasParam CreateInvoice MetaData +instance StripeHasParam CreateInvoice StatementDescription +instance StripeHasParam CreateInvoice SubscriptionId + +------------------------------------------------------------------------------ +-- | Retrieve an `Invoice` by `InvoiceId` +getInvoice + :: InvoiceId -- ^ Get an `Invoice` by `InvoiceId` + -> StripeRequest GetInvoice +getInvoice + invoiceid = request + where request = mkStripeRequest GET url params + url = "invoices" getInvoiceId invoiceid + params = [] + +data GetInvoice +type instance StripeReturn GetInvoice = Invoice +instance StripeHasParam GetInvoice ExpandParams + +------------------------------------------------------------------------------ +-- | Retrieve a `StripeList` of `Invoice`s +getInvoices + :: StripeRequest GetInvoices +getInvoices = request + where request = mkStripeRequest GET url params + url = "invoices" + params = [] + +data GetInvoices +type instance StripeReturn GetInvoices = StripeList Invoice +instance StripeHasParam GetInvoices ExpandParams +instance StripeHasParam GetInvoices (EndingBefore InvoiceId) +instance StripeHasParam GetInvoices Limit +instance StripeHasParam GetInvoices (StartingAfter InvoiceId) + +------------------------------------------------------------------------------ +-- | Retrieve an `InvoiceLineItem`s by `InvoiceId` +getInvoiceLineItems + :: InvoiceId -- ^ Get an `Invoice` by `InvoiceId` + -> StripeRequest GetInvoiceLineItems +getInvoiceLineItems + invoiceid = request + where request = mkStripeRequest GET url params + url = "invoices" getInvoiceId invoiceid "lines" + params = [] + +data GetInvoiceLineItems +type instance StripeReturn GetInvoiceLineItems = StripeList InvoiceLineItem +instance StripeHasParam GetInvoiceLineItems CustomerId +instance StripeHasParam GetInvoiceLineItems (EndingBefore InvoiceLineItemId) +instance StripeHasParam GetInvoiceLineItems Limit +instance StripeHasParam GetInvoiceLineItems (StartingAfter InvoiceLineItemId) +instance StripeHasParam GetInvoiceLineItems SubscriptionId + +------------------------------------------------------------------------------ +-- | Retrieve an upcoming `Invoice` for a `Customer` by `CustomerId` +getUpcomingInvoice + :: CustomerId -- ^ The `InvoiceId` of the `Invoice` to retrieve + -> StripeRequest GetUpcomingInvoice +getUpcomingInvoice + customerid = request + where request = mkStripeRequest GET url params + url = "invoices" "upcoming" + params = toStripeParam customerid [] + +data GetUpcomingInvoice +type instance StripeReturn GetUpcomingInvoice = Invoice +instance StripeHasParam GetUpcomingInvoice SubscriptionId + +------------------------------------------------------------------------------ +-- | Update `Invoice` by `InvoiceId` +updateInvoice + :: InvoiceId -- ^ The `InvoiceId` of the `Invoice` to update + -> StripeRequest UpdateInvoice +updateInvoice + invoiceid = request + where request = mkStripeRequest POST url params + url = "invoices" getInvoiceId invoiceid + params = [] + +data UpdateInvoice +type instance StripeReturn UpdateInvoice = Invoice +instance StripeHasParam UpdateInvoice ApplicationFeeId +instance StripeHasParam UpdateInvoice Closed +instance StripeHasParam UpdateInvoice Description +instance StripeHasParam UpdateInvoice Forgiven +instance StripeHasParam UpdateInvoice MetaData +instance StripeHasParam UpdateInvoice StatementDescription + +------------------------------------------------------------------------------ +-- | Pay `Invoice` by `InvoiceId` +payInvoice + :: InvoiceId -- ^ The `InvoiceId` of the `Invoice` to pay + -> StripeRequest PayInvoice +payInvoice + invoiceid = request + where request = mkStripeRequest POST url params + url = "invoices" getInvoiceId invoiceid "pay" + params = [] + +data PayInvoice +type instance StripeReturn PayInvoice = Invoice 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,166 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.InvoiceItem +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#invoiceitems > +-- +-- @ +-- {-\# LANGUAGE OverloadedStrings \#-} +-- import Web.Stripe +-- import Web.Stripe.Customer +-- import Web.Stripe.InvoiceItem +-- +-- main :: IO () +-- main = do +-- let config = StripeConfig (StripeKey "secret_key") +-- result <- stripe config $ createCustomer +-- case result of +-- (Left stripeError) -> print stripeError +-- (Right (Customer { customerId = cid })) -> +-- do result <- stripe config $ +-- createInvoiceItem cid (Amount 100) USD +-- -&- (Description "description") +-- case result of +-- Left stripeError -> print stripeError +-- Right invoiceitem -> print invoiceitem +-- @ +module Web.Stripe.InvoiceItem + ( -- * API + CreateInvoiceItem + , createInvoiceItem + , GetInvoiceItem + , getInvoiceItem + , UpdateInvoiceItem + , updateInvoiceItem + , DeleteInvoiceItem + , deleteInvoiceItem + , GetInvoiceItems + , getInvoiceItems + -- * Types + , InvoiceItemId (..) + , InvoiceItem (..) + , Created (..) + , CustomerId (..) + , Currency (..) + , EndingBefore (..) + , ExpandParams (..) + , InvoiceId (..) + , Invoice (..) + , Limit (..) + , SubscriptionId (..) + , StartingAfter (..) + , StripeDeleteResult (..) + , StripeList (..) + , Description (..) + , Amount (..) + ) where +import Web.Stripe.StripeRequest (Method (GET, POST, DELETE), + StripeHasParam, StripeRequest (..), + StripeReturn, ToStripeParam(..), + mkStripeRequest) +import Web.Stripe.Util (()) +import Web.Stripe.Types (Amount(..), Created(..), Currency (..), + CustomerId (..), Description(..), + InvoiceId (..), InvoiceItem (..), Invoice(..), + InvoiceItemId (..), Limit(..), StartingAfter(..), EndingBefore(..), + StripeDeleteResult (..), ExpandParams(..), + SubscriptionId (..), StripeList(..), MetaData(..)) +import Web.Stripe.Types.Util (getInvoiceItemId) + +------------------------------------------------------------------------------ +-- | 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` + -> StripeRequest CreateInvoiceItem +createInvoiceItem + customerid + amount + currency = request + where request = mkStripeRequest POST url params + url = "invoiceitems" + params = toStripeParam customerid $ + toStripeParam amount $ + toStripeParam currency $ + [] + +data CreateInvoiceItem +type instance StripeReturn CreateInvoiceItem = InvoiceItem +instance StripeHasParam CreateInvoiceItem InvoiceId +instance StripeHasParam CreateInvoiceItem SubscriptionId +instance StripeHasParam CreateInvoiceItem Description +instance StripeHasParam CreateInvoiceItem MetaData + +------------------------------------------------------------------------------ +-- | Retrieve an `InvoiceItem` by `InvoiceItemId` +getInvoiceItem + :: InvoiceItemId -- ^ `InvoiceItemId` of `InvoiceItem` to retrieve + -> StripeRequest GetInvoiceItem +getInvoiceItem + invoiceitemid = request + where request = mkStripeRequest GET url params + url = "invoiceitems" getInvoiceItemId invoiceitemid + params = [] + +data GetInvoiceItem +type instance StripeReturn GetInvoiceItem = InvoiceItem +instance StripeHasParam GetInvoiceItem ExpandParams + +------------------------------------------------------------------------------ +-- | Update an `InvoiceItem` by `InvoiceItemId` +updateInvoiceItem + :: InvoiceItemId -- ^ `InvoiceItemId` of to update + -> StripeRequest UpdateInvoiceItem +updateInvoiceItem + invoiceitemid + = request + where request = mkStripeRequest POST url params + url = "invoiceitems" getInvoiceItemId invoiceitemid + params = [] + +data UpdateInvoiceItem +type instance StripeReturn UpdateInvoiceItem = InvoiceItem +instance StripeHasParam UpdateInvoiceItem Amount +instance StripeHasParam UpdateInvoiceItem Description +instance StripeHasParam UpdateInvoiceItem MetaData + +------------------------------------------------------------------------------ +-- | Delete an `InvoiceItem` by `InvoiceItemId` +deleteInvoiceItem + :: InvoiceItemId -- ^ `InvoiceItemdId` of `InvoiceItem` to be deleted + -> StripeRequest DeleteInvoiceItem +deleteInvoiceItem + invoiceitemid = request + where request = mkStripeRequest DELETE url params + url = "invoiceitems" getInvoiceItemId invoiceitemid + params = [] + +data DeleteInvoiceItem +type instance StripeReturn DeleteInvoiceItem = StripeDeleteResult + +------------------------------------------------------------------------------ +-- | List `InvoiceItem`s +getInvoiceItems + :: StripeRequest GetInvoiceItems +getInvoiceItems = request + where request = mkStripeRequest GET url params + url = "invoiceitems" + params = [] + +data GetInvoiceItems +type instance StripeReturn GetInvoiceItems = (StripeList InvoiceItem) +instance StripeHasParam GetInvoiceItems ExpandParams +instance StripeHasParam GetInvoiceItems Created +instance StripeHasParam GetInvoiceItems CustomerId +instance StripeHasParam GetInvoiceItems (EndingBefore InvoiceItemId) +instance StripeHasParam GetInvoiceItems Limit +instance StripeHasParam GetInvoiceItems (StartingAfter InvoiceItemId) 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,166 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Plan +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#plans > +-- +-- @ +-- {-\# LANGUAGE OverloadedStrings \#-} +-- import Web.Stripe +-- import Web.Stripe.Plan +-- +-- main :: IO () +-- main = do +-- let config = StripeConfig (StripeKey "secret_key") +-- result <- stripe config $ do +-- createPlan (PlanId "free plan") +-- (Amount 0) +-- USD +-- Month +-- (PlanName "a sample free plan") +-- case result of +-- Right plan -> print plan +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.Plan + ( -- * API + CreatePlan + , createPlan + , GetPlan + , getPlan + , UpdatePlan + , updatePlan + , DeletePlan + , deletePlan + , GetPlans + , getPlans + -- * Types + , Amount (..) + , Currency (..) + , EndingBefore (..) + , Interval (..) + , IntervalCount (..) + , Limit (..) + , MetaData (..) + , Plan (..) + , PlanId (..) + , PlanName (..) + , StartingAfter (..) + , StatementDescription(..) + , StripeDeleteResult (..) + , StripeList (..) + , TrialPeriodDays (..) + ) where + +import Data.Text (Text) +import Web.Stripe.StripeRequest (Method (GET, POST, DELETE), Param(..), + StripeHasParam, StripeRequest (..), + StripeReturn, ToStripeParam(..), + mkStripeRequest) +import Web.Stripe.Types (PlanId (..) , Plan (..), PlanName(..), + Interval (..), StripeList(..), + IntervalCount (..), TrialPeriodDays (..), + Limit(..), StartingAfter(..), + EndingBefore(..), StripeDeleteResult(..), + Currency (..), Amount(..), + StatementDescription(..), MetaData(..)) +import Web.Stripe.Util (()) + +------------------------------------------------------------------------------ +-- | Create a `Plan` +createPlan + :: 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`) + -> PlanName -- ^ Name of `Plan` to be displayed on `Invoice`s + -> StripeRequest CreatePlan +createPlan + (PlanId planid) + amount + currency + interval + name = request + where request = mkStripeRequest POST url params + url = "plans" + params = toStripeParam (Param ("id" :: Text, planid)) $ + toStripeParam amount $ + toStripeParam currency $ + toStripeParam interval $ + toStripeParam name $ + [] + +data CreatePlan +type instance StripeReturn CreatePlan = Plan +instance StripeHasParam CreatePlan IntervalCount +instance StripeHasParam CreatePlan TrialPeriodDays +instance StripeHasParam CreatePlan MetaData +instance StripeHasParam CreatePlan StatementDescription + +------------------------------------------------------------------------------ +-- | Retrieve a `Plan` +getPlan + :: PlanId -- ^ The ID of the plan to retrieve + -> StripeRequest GetPlan +getPlan + (PlanId planid) = request + where request = mkStripeRequest GET url params + url = "plans" planid + params = [] + +data GetPlan +type instance StripeReturn GetPlan = Plan + +------------------------------------------------------------------------------ +-- | Update a `Plan` +updatePlan + :: PlanId -- ^ The ID of the `Plan` to update + -> StripeRequest UpdatePlan +updatePlan + (PlanId planid) + = request + where request = mkStripeRequest POST url params + url = "plans" planid + params = [] + +data UpdatePlan +type instance StripeReturn UpdatePlan = Plan +instance StripeHasParam UpdatePlan PlanName +instance StripeHasParam UpdatePlan MetaData +instance StripeHasParam UpdatePlan StatementDescription + +------------------------------------------------------------------------------ +-- | Delete a `Plan` +deletePlan + :: PlanId -- ^ The ID of the `Plan` to delete + -> StripeRequest DeletePlan +deletePlan + (PlanId planid) = request + where request = mkStripeRequest DELETE url params + url = "plans" planid + params = [] + +data DeletePlan +type instance StripeReturn DeletePlan = StripeDeleteResult + +------------------------------------------------------------------------------ +-- | Retrieve all `Plan`s +getPlans :: StripeRequest GetPlans +getPlans = request + where request = mkStripeRequest GET url params + url = "plans" + params = [] + +data GetPlans +type instance StripeReturn GetPlans = (StripeList Plan) +instance StripeHasParam GetPlans (EndingBefore PlanId) +instance StripeHasParam GetPlans Limit +instance StripeHasParam GetPlans (StartingAfter PlanId) 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,199 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Recipient +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#recipients > +-- +-- @ +-- {-\# LANGUAGE OverloadedStrings \#-} +-- import Web.Stripe +-- import Web.Stripe.Recipient +-- +-- main :: IO () +-- main = do +-- let config = StripeConfig (StripeKey "secret_key") +-- result <- stripe config $ +-- createRecipient (Name "simon marlow") +-- Individual +-- case result of +-- Right recipient -> print recipient +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.Recipient + ( -- * API + CreateRecipient + , createRecipient + , GetRecipient + , getRecipient + , UpdateRecipient + , updateRecipient + , DeleteRecipient + , deleteRecipient + , GetRecipients + , getRecipients + -- * Types + , AccountNumber (..) + , AddressCity (..) + , AddressCountry (..) + , AddressLine1 (..) + , AddressLine2 (..) + , AddressState (..) + , AddressZip (..) + , BankAccount (..) + , BankAccountId (..) + , BankAccountStatus (..) + , CardNumber (..) + , Country (..) + , CVC (..) + , DefaultCard (..) + , Description (..) + , ExpandParams (..) + , ExpMonth (..) + , ExpYear (..) + , Email (..) + , IsVerified (..) + , Limit (..) + , MetaData (..) + , Name (..) + , NewBankAccount (..) + , NewCard (..) + , Recipient (..) + , RecipientId (..) + , RecipientType (..) + , RoutingNumber (..) + , StripeDeleteResult (..) + , TaxID (..) + , TokenId (..) + ) where + +import Web.Stripe.StripeRequest (Method (GET, POST, DELETE), + StripeHasParam, StripeRequest (..), + ToStripeParam(..), StripeReturn, + mkStripeRequest) +import Web.Stripe.Util (()) +import Web.Stripe.Types (AccountNumber (..), + BankAccount (..), CVC (..), + CardId (..), CardNumber, BankAccountId (..), + BankAccountStatus(..), + CardNumber (..), Country (..), + DefaultCard(..), Description(..), Email(..), + ExpMonth (..), ExpYear(..), IsVerified(..), + RoutingNumber (..), AccountNumber (..), + Country (..), AddressCity (..), + AddressCountry (..), AddressLine1 (..), + AddressLine2 (..), AddressState (..), + AddressZip (..), Country(..), ExpYear (..), + Limit(..), Name(..), NewBankAccount(..), NewCard(..), 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 +createRecipient + :: Name -- ^ `Recipient` `Name` + -> RecipientType -- ^ `Individual` or `Corporation` + -> StripeRequest CreateRecipient +createRecipient + name + recipienttype + = request + where request = mkStripeRequest POST url params + url = "recipients" + params = toStripeParam name $ + toStripeParam recipienttype $ + [] + +data CreateRecipient +type instance StripeReturn CreateRecipient = Recipient +instance StripeHasParam CreateRecipient TaxID +instance StripeHasParam CreateRecipient NewBankAccount +instance StripeHasParam CreateRecipient TokenId +instance StripeHasParam CreateRecipient NewCard +instance StripeHasParam CreateRecipient CardId +instance StripeHasParam CreateRecipient Email +instance StripeHasParam CreateRecipient Description +instance StripeHasParam CreateRecipient MetaData + +------------------------------------------------------------------------------ +-- | Retrieve a 'Recipient' +getRecipient + :: RecipientId -- ^ The `RecipientId` of the `Recipient` to be retrieved + -> StripeRequest GetRecipient +getRecipient + recipientid = request + where request = mkStripeRequest GET url params + url = "recipients" getRecipientId recipientid + params = [] + +data GetRecipient +type instance StripeReturn GetRecipient = Recipient +instance StripeHasParam GetRecipient ExpandParams + +------------------------------------------------------------------------------ +-- | Update `Recipient` +updateRecipient + :: RecipientId -- ^ `RecipientId` of `Recipient` to update + -> StripeRequest UpdateRecipient +updateRecipient + recipientid = request + where request = mkStripeRequest POST url params + url = "recipients" getRecipientId recipientid + params = [] + +data UpdateRecipient +type instance StripeReturn UpdateRecipient = Recipient +instance StripeHasParam UpdateRecipient Name +instance StripeHasParam UpdateRecipient TaxID +instance StripeHasParam UpdateRecipient NewBankAccount +instance StripeHasParam UpdateRecipient TokenId +instance StripeHasParam UpdateRecipient NewCard +instance StripeHasParam UpdateRecipient DefaultCard +instance StripeHasParam UpdateRecipient CardId +instance StripeHasParam UpdateRecipient Email +instance StripeHasParam UpdateRecipient Description +instance StripeHasParam UpdateRecipient MetaData + +------------------------------------------------------------------------------ +-- | Delete a `Recipient` +deleteRecipient + :: RecipientId -- ^ `RecipiendId` of `Recipient` to delete + -> StripeRequest DeleteRecipient +deleteRecipient + recipientid = request + where request = mkStripeRequest DELETE url params + url = "recipients" getRecipientId recipientid + params = [] + +data DeleteRecipient +type instance StripeReturn DeleteRecipient = StripeDeleteResult + +------------------------------------------------------------------------------ +-- | Retrieve multiple 'Recipient's +getRecipients + :: StripeRequest GetRecipients +getRecipients + = request + where request = mkStripeRequest GET url params + url = "recipients" + params = [] + +data GetRecipients +type instance StripeReturn GetRecipients = StripeList Recipient +instance StripeHasParam GetRecipients ExpandParams +instance StripeHasParam GetRecipients (EndingBefore RecipientId) +instance StripeHasParam GetRecipients Limit +instance StripeHasParam GetRecipients (StartingAfter RecipientId) +instance StripeHasParam GetRecipients IsVerified 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,148 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Refund +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#refunds > +-- +-- @ +-- {-\# LANGUAGE OverloadedStrings \#-} +-- import Web.Stripe +-- import Web.Stripe.Customer +-- import Web.Stripe.Charge +-- import Web.Stripe.Refund +-- +-- main :: IO () +-- main = do +-- let config = StripeConfig (StripeKey "secret_key") +-- credit = CardNumber "4242424242424242" +-- em = ExpMonth 12 +-- ey = ExpYear 2015 +-- cvc = CVC "123" +-- cardinfo = (mkNewCard credit em ey) { newCardCVC = Just cvc } +-- result <- stripe config $ createCustomer -&- cardinfo +-- case result of +-- (Left stripeError) -> print stripeError +-- (Right (Customer { customerId = cid })) -> do +-- result <- stripe config $ createCharge (Amount 100) USD -&- cid +-- case result of +-- (Left stripeError) -> print stripeError +-- (Right (Charge { chargeId = chid })) -> do +-- result <- stripe config $ createRefund chid +-- case result of +-- (Left stripeError) -> print stripeError +-- (Right refund) -> print refund +-- @ +module Web.Stripe.Refund + ( -- * API + CreateRefund + , createRefund + , GetRefund + , getRefund + , GetRefunds + , getRefunds + , UpdateRefund + , updateRefund + -- * Types + , Amount (..) + , Charge (..) + , ChargeId (..) + , EndingBefore (..) + , ExpandParams (..) + , Refund (..) + , RefundApplicationFee(..) + , RefundReason (..) + , RefundId (..) + , StripeList (..) + ) where + +import Web.Stripe.StripeRequest (Method (GET, POST), + StripeHasParam, StripeReturn, + StripeRequest (..), mkStripeRequest) +import Web.Stripe.Util (()) +import Web.Stripe.Types (Amount(..), Charge (..), ChargeId (..), + EndingBefore(..), Limit(..), + MetaData(..), Refund (..), + RefundApplicationFee(..), + RefundId (..), RefundReason(..), + StartingAfter(..), ExpandParams(..), + StripeList (..)) +import Web.Stripe.Types.Util (getChargeId) + +------------------------------------------------------------------------------ +-- | create a `Refund` +createRefund + :: ChargeId -- ^ `ChargeId` associated with the `Charge` to be refunded + -> StripeRequest CreateRefund +createRefund + chargeid = request + where request = mkStripeRequest POST url params + url = "charges" getChargeId chargeid "refunds" + params = [] + +data CreateRefund +type instance StripeReturn CreateRefund = Refund +instance StripeHasParam CreateRefund Amount +instance StripeHasParam CreateRefund RefundApplicationFee +instance StripeHasParam CreateRefund RefundReason +instance StripeHasParam CreateRefund 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 + -> StripeRequest GetRefund +getRefund + chargeid + (RefundId refundid) = request + where request = mkStripeRequest GET url params + url = "charges" getChargeId chargeid "refunds" refundid + params = [] + +data GetRefund +type instance StripeReturn GetRefund = Refund +instance StripeHasParam GetRefund 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 + -> StripeRequest UpdateRefund +updateRefund + chargeid + (RefundId refid) + = request + where request = mkStripeRequest POST url params + url = "charges" getChargeId chargeid "refunds" refid + params = [] + +data UpdateRefund +type instance StripeReturn UpdateRefund = Refund +instance StripeHasParam UpdateRefund MetaData + +------------------------------------------------------------------------------ +-- | Retrieve a lot of Refunds by `ChargeId` +getRefunds + :: ChargeId -- ^ `ChargeId` associated with the `Refunds` to get + -> StripeRequest GetRefunds +getRefunds + chargeid = request + where request = mkStripeRequest GET url params + url = "charges" getChargeId chargeid "refunds" + params = [] + +data GetRefunds +type instance StripeReturn GetRefunds = StripeList Refund +instance StripeHasParam GetRefunds ExpandParams +instance StripeHasParam GetRefunds (EndingBefore RefundId) +instance StripeHasParam GetRefunds Limit +instance StripeHasParam GetRefunds (StartingAfter RefundId) diff --git a/src/Web/Stripe/StripeRequest.hs b/src/Web/Stripe/StripeRequest.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/StripeRequest.hs @@ -0,0 +1,498 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +-- | +-- Module : Web.Stripe.StripeRequest +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +module Web.Stripe.StripeRequest + ( -- * Types + Method(..) + , Expandable(..) + , ExpandParams(..) + , Param(..) + , Params + , StripeRequest (..) + , StripeReturn + , StripeHasParam + , ToStripeParam(..) + , (-&-) + , mkStripeRequest + ) where + +import Control.Applicative ((<$>)) +import Data.ByteString (ByteString) +import Data.Monoid ((<>)) +import Data.String (fromString) +import Data.Text (Text) +import qualified Data.Text.Encoding as Text +import Numeric (showFFloat) +import Web.Stripe.Types (AccountBalance(..), AccountNumber(..), + AddressCity(..), AddressCountry(..), + ApplicationFeeId(..), AddressLine1(..), + AddressLine2(..), AddressState(..), + AddressZip(..), Amount(..), AmountOff(..), + ApplicationFeeAmount(..), + ApplicationFeePercent(..), + AtPeriodEnd(..), + AvailableOn(..), BankAccountId(..), + CardId(..), CardNumber(..), + Capture(..), ChargeId(..), Closed(..), + CouponId(..), + Country(..), Created(..), Currency(..), + CustomerId(..), CVC(..), Date(..), + DefaultCard(..), Description(..), + Duration(..), DurationInMonths(..), + Email(..), EndingBefore(..), EventId(..), + Evidence(..), Expandable(..), + ExpandParams(..), ExpMonth(..), + ExpYear(..), Forgiven(..), Interval(..), + IntervalCount(..), + InvoiceId(..), InvoiceItemId(..), + InvoiceLineItemId(..), + IsVerified(..), MetaData(..), PlanId(..), + PlanName(..), Prorate(..), Limit(..), + MaxRedemptions(..), Name(..), + NewBankAccount(..), NewCard(..), + PercentOff(..), Quantity(..), ReceiptEmail(..), + RecipientId(..), RecipientType(..), RedeemBy(..), + RefundId(..), + RefundApplicationFee(..), RefundReason(..), + RoutingNumber(..), StartingAfter(..), + StatementDescription(..), Source(..), + SubscriptionId(..), TaxID(..), TimeRange(..), + TokenId(..), TransactionId(..), + TransactionType(..), TransferId(..), + TransferStatus(..), TrialEnd(..), + TrialPeriodDays(..)) +import Web.Stripe.Util (toBytestring, toExpandable,toMetaData, + toSeconds, getParams, toText) + +------------------------------------------------------------------------------ +-- | HTTP Method +-- +-- The other methods are not required by the Stripe API +data Method + = DELETE + | GET + | POST + deriving (Eq, Ord, Read, Show) + +------------------------------------------------------------------------------ +-- | HTTP Params +type Params = [(ByteString, ByteString)] + +------------------------------------------------------------------------------ +-- | used to set a specific key/value pair when the type is not enough +newtype Param k v = Param (k, v) + +------------------------------------------------------------------------------ +-- | Stripe Request holding `Method`, URL and `Params` for a Request. Also +-- includes the function needed to decode the response. +-- +data StripeRequest a = StripeRequest + { method :: Method -- ^ Method of StripeRequest (i.e. `GET`, `PUT`, `POST`, `PUT`) + , endpoint :: Text -- ^ Endpoint of StripeRequest + , queryParams :: Params -- ^ Query Parameters of StripeRequest + } + +------------------------------------------------------------------------------ +-- | convert a parameter to a key/value +class ToStripeParam param where + toStripeParam :: param -> [(ByteString, ByteString)] -> [(ByteString, ByteString)] + +instance ToStripeParam Amount where + toStripeParam (Amount i) = + (("amount", toBytestring i) :) + +instance ToStripeParam AmountOff where + toStripeParam (AmountOff i) = + (("amount_off", toBytestring i) :) + +instance ToStripeParam AccountBalance where + toStripeParam (AccountBalance i) = + (("account_balance", toBytestring i) :) + +instance ToStripeParam AddressCity where + toStripeParam (AddressCity txt) = + (("address_city", Text.encodeUtf8 txt) :) + +instance ToStripeParam AddressCountry where + toStripeParam (AddressCountry txt) = + (("address_country", Text.encodeUtf8 txt) :) + +instance ToStripeParam AddressLine1 where + toStripeParam (AddressLine1 txt) = + (("address_line1", Text.encodeUtf8 txt) :) + +instance ToStripeParam AddressLine2 where + toStripeParam (AddressLine2 txt) = + (("address_line2", Text.encodeUtf8 txt) :) + +instance ToStripeParam AddressState where + toStripeParam (AddressState txt) = + (("address_state", Text.encodeUtf8 txt) :) + +instance ToStripeParam AddressZip where + toStripeParam (AddressZip txt) = + (("address_zip", Text.encodeUtf8 txt) :) + +instance ToStripeParam ApplicationFeeId where + toStripeParam (ApplicationFeeId aid) = + (("application_fee", Text.encodeUtf8 aid) :) + +instance ToStripeParam ApplicationFeeAmount where + toStripeParam (ApplicationFeeAmount cents) = + (("application_fee", toBytestring cents) :) + +instance ToStripeParam ApplicationFeePercent where + toStripeParam (ApplicationFeePercent fee) = + (("application_fee_percent", fromString $ showFFloat (Just 2) fee "") :) + +instance ToStripeParam AvailableOn where + toStripeParam (AvailableOn time) = + (("available_on", toBytestring $ toSeconds time) :) + +instance ToStripeParam AtPeriodEnd where + toStripeParam (AtPeriodEnd p) = + (("prorate", if p then "true" else "false") :) + +instance ToStripeParam BankAccountId where + toStripeParam (BankAccountId bid) = + (("bank_account", Text.encodeUtf8 bid) :) + +instance ToStripeParam Capture where + toStripeParam (Capture b) = + (("capture", if b then "true" else "false") :) + +instance ToStripeParam CardId where + toStripeParam (CardId cid) = + (("card", Text.encodeUtf8 cid) :) + +instance ToStripeParam CardNumber where + toStripeParam (CardNumber num) = + (("number", Text.encodeUtf8 num) :) + +instance ToStripeParam ChargeId where + toStripeParam (ChargeId cid) = + (("charge", Text.encodeUtf8 cid) :) + +instance ToStripeParam Closed where + toStripeParam (Closed b) = + (("closed", if b then "true" else "false") :) + +instance ToStripeParam Created where + toStripeParam (Created time) = + (("created", toBytestring $ toSeconds time) :) + +instance ToStripeParam Currency where + toStripeParam currency = + (("currency", toBytestring currency) :) + +instance ToStripeParam CustomerId where + toStripeParam (CustomerId cid) = + (("customer", Text.encodeUtf8 cid) :) + +instance ToStripeParam CouponId where + toStripeParam (CouponId cid) = + (("coupon", Text.encodeUtf8 cid) :) + +instance ToStripeParam CVC where + toStripeParam (CVC cvc) = + (("cvc", Text.encodeUtf8 cvc) :) + +instance ToStripeParam Date where + toStripeParam (Date time) = + (("created", toBytestring $ toSeconds time) :) + +instance ToStripeParam DefaultCard where + toStripeParam (DefaultCard (CardId cid)) = + (("default_card", Text.encodeUtf8 cid) :) + +instance ToStripeParam Description where + toStripeParam (Description txt) = + (("description", Text.encodeUtf8 txt) :) + +instance ToStripeParam Duration where + toStripeParam duration = + (("duration", toBytestring duration) :) + +instance ToStripeParam DurationInMonths where + toStripeParam (DurationInMonths i) = + (("duration_in_months", toBytestring i) :) + +instance ToStripeParam Email where + toStripeParam (Email txt) = + (("email", Text.encodeUtf8 txt) :) + +instance ToStripeParam EventId where + toStripeParam (EventId eid) = + (("event", Text.encodeUtf8 eid) :) + +instance ToStripeParam Evidence where + toStripeParam (Evidence txt) = + (("evidence", Text.encodeUtf8 txt) :) + +instance ToStripeParam ExpandParams where + toStripeParam (ExpandParams params) = + (toExpandable params ++) + +instance ToStripeParam ExpMonth where + toStripeParam (ExpMonth m) = + (("exp_month", toBytestring m) :) + +instance ToStripeParam ExpYear where + toStripeParam (ExpYear y) = + (("exp_year", toBytestring y) :) + +instance ToStripeParam Forgiven where + toStripeParam (Forgiven b) = + (("forgiven", if b then "true" else "false") :) + +instance ToStripeParam Interval where + toStripeParam interval = + (("interval", toBytestring interval) :) + +instance ToStripeParam IntervalCount where + toStripeParam (IntervalCount c) = + (("interval_count", toBytestring c) :) + +instance ToStripeParam InvoiceId where + toStripeParam (InvoiceId txt) = + (("invoice", Text.encodeUtf8 txt) :) + +instance ToStripeParam InvoiceItemId where + toStripeParam (InvoiceItemId txt) = + (("id", Text.encodeUtf8 txt) :) + +instance ToStripeParam InvoiceLineItemId where + toStripeParam (InvoiceLineItemId txt) = + (("line_item", Text.encodeUtf8 txt) :) + +instance ToStripeParam IsVerified where + toStripeParam (IsVerified b) = + (("verified", if b then "true" else "false") :) + +instance ToStripeParam Limit where + toStripeParam (Limit i) = + (("limit", toBytestring i) :) + +instance ToStripeParam MaxRedemptions where + toStripeParam (MaxRedemptions i) = + (("max_redemptions", toBytestring i) :) + +instance ToStripeParam Name where + toStripeParam (Name txt) = + (("name", Text.encodeUtf8 txt) :) + +instance ToStripeParam NewBankAccount where + toStripeParam NewBankAccount{..} = + ((getParams + [ ("bank_account[country]", Just $ (\(Country x) -> x) newBankAccountCountry) + , ("bank_account[routing_number]", Just $ (\(RoutingNumber x) -> x) newBankAccountRoutingNumber) + , ("bank_account[account_number]", Just $ (\(AccountNumber x) -> x) newBankAccountAccountNumber) + ]) ++) + +instance ToStripeParam NewCard where + toStripeParam NewCard{..} = + ((getParams + [ ("card[number]", Just $ (\(CardNumber x) -> x) newCardCardNumber) + , ("card[exp_month]", Just $ (\(ExpMonth x) -> toText x) newCardExpMonth) + , ("card[exp_year]", Just $ (\(ExpYear x) -> toText x) newCardExpYear) + , ("card[cvc]", (\(CVC x) -> x) <$> newCardCVC) + , ("card[name]", getName <$> newCardName) + , ("card[address_city]", (\(AddressCity x) -> x) <$> newCardAddressCity) + , ("card[address_country]", (\(AddressCountry x) -> x) <$> newCardAddressCountry) + , ("card[address_line1]", (\(AddressLine1 x) -> x) <$> newCardAddressLine1 ) + , ("card[address_line2]", (\(AddressLine2 x) -> x) <$> newCardAddressLine2 ) + , ("card[address_state]", (\(AddressState x) -> x) <$> newCardAddressState ) + , ("card[address_zip]", (\(AddressZip x) -> x) <$> newCardAddressZip ) + ]) ++) + +instance ToStripeParam (Param Text Text) where + toStripeParam (Param (k,v)) = + ((Text.encodeUtf8 k, Text.encodeUtf8 v) :) + +instance ToStripeParam PercentOff where + toStripeParam (PercentOff i) = + (("percent_off", toBytestring i) :) + +instance ToStripeParam PlanId where + toStripeParam (PlanId pid) = + (("plan", Text.encodeUtf8 pid) :) + +instance ToStripeParam PlanName where + toStripeParam (PlanName txt) = + (("name", Text.encodeUtf8 txt) :) + +instance ToStripeParam Prorate where + toStripeParam (Prorate p) = + (("prorate", if p then "true" else "false") :) + +instance ToStripeParam Quantity where + toStripeParam (Quantity i) = + (("quantity", toBytestring i) :) + +instance ToStripeParam RecipientId where + toStripeParam (RecipientId rid) = + (("recipient", Text.encodeUtf8 rid) :) + +instance ToStripeParam RedeemBy where + toStripeParam (RedeemBy time) = + (("redeem_by", toBytestring $ toSeconds time) :) + +instance ToStripeParam RefundId where + toStripeParam (RefundId fid) = + (("refund", Text.encodeUtf8 fid) :) + +instance ToStripeParam ReceiptEmail where + toStripeParam (ReceiptEmail txt) = + (("receipt_email", Text.encodeUtf8 txt) :) + +instance ToStripeParam RecipientType where + toStripeParam recipientType = + (("type", toBytestring recipientType) :) + +instance ToStripeParam a => ToStripeParam (Source a) where + toStripeParam (Source param) = + case toStripeParam param [] of + [(_, p)] -> (("source", p) :) + _ -> error "source applied to non-singleton" + +instance ToStripeParam SubscriptionId where + toStripeParam (SubscriptionId sid) = + (("subscription", Text.encodeUtf8 sid) :) + +instance ToStripeParam TaxID where + toStripeParam (TaxID tid) = + (("tax_id", Text.encodeUtf8 tid) :) + +instance ToStripeParam a => ToStripeParam (TimeRange a) where + toStripeParam (TimeRange{..}) = + (case gt of + Nothing -> id + Just t -> toRecord (toStripeParam t) "gt") . + (case gte of + Nothing -> id + Just t -> toRecord (toStripeParam t) "gte") . + (case lt of + Nothing -> id + Just t -> toRecord (toStripeParam t) "lt") . + (case lte of + Nothing -> id + Just t -> toRecord (toStripeParam t) "lte") + where + toRecord :: ([(ByteString, ByteString)] -> [(ByteString, ByteString)]) + -> ByteString + -> ([(ByteString, ByteString)] -> [(ByteString, ByteString)]) + toRecord f n = + case f [] of + [(k,v)] -> ((k <> "[" <> n <> "]", v) :) + lst' -> error $ "toRecord in ToStripeRange (TimeRange a) expected exactly one element in this list. " ++ show lst' + +instance ToStripeParam TokenId where + toStripeParam (TokenId tid) = + (("card", Text.encodeUtf8 tid) :) + +instance ToStripeParam TrialEnd where + toStripeParam (TrialEnd time) = + (("trial_end", toBytestring $ toSeconds time) :) + +instance ToStripeParam TransactionId where + toStripeParam (TransactionId tid) = + (("transaction", Text.encodeUtf8 tid) :) + +instance ToStripeParam TransferId where + toStripeParam (TransferId tid) = + (("transfer", Text.encodeUtf8 tid) :) + +instance ToStripeParam TransferStatus where + toStripeParam transferStatus = + (("status", toBytestring transferStatus) :) + +instance ToStripeParam TrialPeriodDays where + toStripeParam (TrialPeriodDays days) = + (("trial_period_days", toBytestring days) :) + +instance ToStripeParam MetaData where + toStripeParam (MetaData kvs) = + (toMetaData kvs ++) + +instance ToStripeParam RefundApplicationFee where + toStripeParam (RefundApplicationFee b) = + (("refund_application_fee", if b then "true" else "false") :) + +instance ToStripeParam RefundReason where + toStripeParam reason = + (("reason", case reason of + RefundDuplicate -> "duplicate" + RefundFraudulent -> "fraudulent" + RefundRequestedByCustomer -> "requested_by_customer") :) + +instance ToStripeParam StatementDescription where + toStripeParam (StatementDescription txt) = + (("statement_description", Text.encodeUtf8 txt) :) + +instance ToStripeParam TransactionType where + toStripeParam txn = + (("type", case txn of + ChargeTxn -> "charge" + RefundTxn -> "refund" + AdjustmentTxn -> "adjustment" + ApplicationFeeTxn -> "application_fee" + ApplicationFeeRefundTxn + -> "application_fee_refund" + TransferTxn -> "transfer" + TransferCancelTxn -> "transfer_cancel" + TransferFailureTxn -> "transfer_failure") :) + + +instance (ToStripeParam param) => ToStripeParam (StartingAfter param) where + toStripeParam (StartingAfter param) = + case toStripeParam param [] of + [(_, p)] -> (("starting_after", p) :) + _ -> error "StartingAfter applied to non-singleton" + +instance (ToStripeParam param) => ToStripeParam (EndingBefore param) where + toStripeParam (EndingBefore param) = + case toStripeParam param [] of + [(_, p)] -> (("ending_before", p) :) + _ -> error "EndingBefore applied to non-singleton" + +------------------------------------------------------------------------------ +-- | indicate if a request allows an optional parameter +class (ToStripeParam param) => StripeHasParam request param where + +------------------------------------------------------------------------------ +-- | add an optional parameter to a `StripeRequest` +(-&-) :: StripeHasParam request param => + StripeRequest request + -> param + -> StripeRequest request +stripeRequest -&- param = + stripeRequest { queryParams = + toStripeParam param (queryParams stripeRequest) + } + +------------------------------------------------------------------------------ +-- | return type of stripe request +type family StripeReturn a :: * + +------------------------------------------------------------------------------ +-- | HTTP Params +-- +-- helper function for building a 'StripeRequest' +mkStripeRequest + :: Method + -> Text + -> Params + -> StripeRequest a +mkStripeRequest m e q = StripeRequest m e q 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,192 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Subscription +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#subscriptions > +-- +-- @ +-- {-\# LANGUAGE OverloadedStrings \#-} +-- import Web.Stripe +-- import Web.Stripe.Subscription +-- import Web.Stripe.Customer +-- import Web.Stripe.Plan +-- +-- main :: IO () +-- main = do +-- let config = StripeConfig (StripeKey "secret_key") +-- result <- stripe config $ createCustomer +-- case result of +-- (Left stripeError) -> print stripeError +-- (Right (Customer { customerId = cid })) -> do +-- result <- stripe config $ createPlan (PlanId "free plan") +-- (Amount 0) +-- USD +-- Month +-- (PlanName "sample plan") +-- case result of +-- (Left stripeError) -> print stripeError +-- (Right (Plan { planId = pid })) -> do +-- result <- stripe config $ createSubscription cid pid +-- case result of +-- (Left stripeError) -> print stripeError +-- (Right subscription) -> print subscription +-- @ +module Web.Stripe.Subscription + ( -- * API + CreateSubscription + , createSubscription + , GetSubscription + , getSubscription + , UpdateSubscription + , updateSubscription + , CancelSubscription + , cancelSubscription + , GetSubscriptions + , getSubscriptions + -- * Types + , ApplicationFeePercent (..) + , AtPeriodEnd (..) + , CustomerId (..) + , CouponId (..) + , Coupon (..) + , EndingBefore (..) + , ExpandParams (..) + , Limit (..) + , MetaData (..) + , PlanId (..) + , Prorate (..) + , Quantity (..) + , StartingAfter (..) + , StripeList (..) + , Subscription (..) + , SubscriptionId (..) + , SubscriptionStatus (..) + , TrialEnd (..) + ) where + +import Web.Stripe.StripeRequest (Method (GET, POST, DELETE), + StripeHasParam, StripeReturn, + StripeRequest (..), + ToStripeParam(..), mkStripeRequest) +import Web.Stripe.Util (()) +import Web.Stripe.Types (ApplicationFeePercent(..), + AtPeriodEnd(..), CardId(..), + CustomerId (..), Coupon(..), + CouponId(..), EndingBefore(..), + ExpandParams(..), Limit(..), MetaData(..), + PlanId (..), Prorate(..), Quantity(..), + StartingAfter(..), + Subscription (..), StripeList(..), + SubscriptionId (..), + SubscriptionStatus (..), TrialEnd(..)) +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 + -> StripeRequest CreateSubscription +createSubscription + customerid + planId = request + where request = mkStripeRequest POST url params + url = "customers" getCustomerId customerid "subscriptions" + params = toStripeParam planId [] + +data CreateSubscription +type instance StripeReturn CreateSubscription = Subscription +instance StripeHasParam CreateSubscription CouponId +instance StripeHasParam CreateSubscription TrialEnd +instance StripeHasParam CreateSubscription CardId +instance StripeHasParam CreateSubscription Quantity +instance StripeHasParam CreateSubscription ApplicationFeePercent +instance StripeHasParam CreateSubscription MetaData + +------------------------------------------------------------------------------ +-- | Retrieve a `Subscription` by `CustomerId` and `SubscriptionId` +getSubscription + :: CustomerId -- ^ The `CustomerId` of the `Subscription` + -> SubscriptionId -- ^ The `SubscriptionId` of the `Subscription` to retrieve + -> StripeRequest GetSubscription +getSubscription + customerid + (SubscriptionId subscriptionid) + = request + where request = mkStripeRequest GET url params + url = "customers" getCustomerId customerid + "subscriptions" subscriptionid + params = [] + +data GetSubscription +type instance StripeReturn GetSubscription = Subscription +instance StripeHasParam GetSubscription 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 + -> StripeRequest UpdateSubscription +updateSubscription + customerid + (SubscriptionId subscriptionid) + = request + where request = mkStripeRequest POST url params + url = "customers" getCustomerId customerid "subscriptions" subscriptionid + params = [] + +data UpdateSubscription +type instance StripeReturn UpdateSubscription = Subscription +instance StripeHasParam UpdateSubscription PlanId +instance StripeHasParam UpdateSubscription CouponId +instance StripeHasParam UpdateSubscription Prorate +instance StripeHasParam UpdateSubscription TrialEnd +instance StripeHasParam UpdateSubscription CardId +instance StripeHasParam UpdateSubscription Quantity +instance StripeHasParam UpdateSubscription ApplicationFeePercent +instance StripeHasParam UpdateSubscription MetaData + +------------------------------------------------------------------------------ +-- | Delete a `Subscription` by `CustomerId` and `SubscriptionId` +cancelSubscription + :: CustomerId -- ^ The `CustomerId` of the `Subscription` to cancel + -> SubscriptionId -- ^ The `SubscriptionId` of the `Subscription` to cancel + -> StripeRequest CancelSubscription +cancelSubscription + customerid + (SubscriptionId subscriptionid) + = request + where request = mkStripeRequest DELETE url params + url = "customers" getCustomerId customerid "subscriptions" subscriptionid + params = [] + +data CancelSubscription +instance StripeHasParam CancelSubscription AtPeriodEnd +type instance StripeReturn CancelSubscription = Subscription + +------------------------------------------------------------------------------ +-- | Retrieve active `Subscription`s +getSubscriptions + :: CustomerId -- ^ The `CustomerId` of the `Subscription`s to retrieve + -> StripeRequest GetSubscriptions +getSubscriptions + customerid = request + where request = mkStripeRequest GET url params + url = "customers" getCustomerId customerid "subscriptions" + params = [] + +data GetSubscriptions +type instance StripeReturn GetSubscriptions = StripeList Subscription +instance StripeHasParam GetSubscriptions ExpandParams +instance StripeHasParam GetSubscriptions (EndingBefore SubscriptionId) +instance StripeHasParam GetSubscriptions Limit +instance StripeHasParam GetSubscriptions (StartingAfter SubscriptionId) 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,133 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Token +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#tokens > +-- +-- @ +-- {-\# LANGUAGE OverloadedStrings \#-} +-- import Web.Stripe +-- import Web.Stripe.Token +-- +-- main :: IO () +-- main = do +-- let config = StripeConfig (StripeKey "secret_key") +-- credit = CardNumber "4242424242424242" +-- em = ExpMonth 12 +-- ey = ExpYear 2015 +-- cvc = CVC "123" +-- cardinfo = (mkNewCard credit em ey) { newCardCVC = Just cvc } +-- result <- stripe config $ createCardToken (Just cardinfo) +-- case result of +-- Right token -> print token +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.Token + ( -- * API + CreateCardToken + , createCardToken + , CreateBankAccountToken + , createBankAccountToken + , GetCardToken + , getCardToken + , GetBankAccountToken + , getBankAccountToken + -- * Types + , Account (..) + , AccountNumber (..) + , BankAccount (..) + , Card (..) + , CardNumber (..) + , Country (..) + , CustomerId (..) + , CVC (..) + , ExpMonth (..) + , ExpYear (..) + , NewBankAccount (..) + , mkNewCard + , NewCard (..) + , RoutingNumber (..) + , Token (..) + , TokenId (..) + , TokenType (..) + ) where + +import Web.Stripe.StripeRequest (Method (GET, POST), + StripeHasParam, StripeRequest (..), + StripeReturn, ToStripeParam(..), + mkStripeRequest) +import Web.Stripe.Util (()) +import Web.Stripe.Types (Account(..), AccountNumber (..), + CVC (..), CardNumber (..), CustomerId(..), + Country (..), ExpMonth (..), + BankAccount(..), ExpYear (..), + NewBankAccount(..), mkNewCard, + NewCard(..), RoutingNumber (..), + Card(..), Token (..), + TokenId (..), TokenType(..) + ) + +------------------------------------------------------------------------------ +-- | Create a `Token` by specifiying Credit `Card` information +createCardToken + :: Maybe NewCard -- ^ optional `NewCard` data + -> StripeRequest CreateCardToken +createCardToken + newCard + = request + where request = mkStripeRequest POST url params + url = "tokens" + params = maybe id toStripeParam newCard $ [] + +data CreateCardToken +type instance StripeReturn CreateCardToken = Token Card +instance StripeHasParam CreateCardToken CustomerId + +------------------------------------------------------------------------------ +-- | Create a `Token` for a specific `BankAccount` +createBankAccountToken + :: Maybe NewBankAccount -- ^ option `BankAccount` information + -> StripeRequest CreateBankAccountToken +createBankAccountToken + newBankAccount + = request + where request = mkStripeRequest POST url params + url = "tokens" + params = maybe id toStripeParam newBankAccount $ [] + +data CreateBankAccountToken +type instance StripeReturn CreateBankAccountToken = Token BankAccount + +------------------------------------------------------------------------------ +-- | Retrieve a `Token` by `TokenId` +getCardToken + :: TokenId -- ^ The `TokenId` of the `Card` `Token` to retrieve + -> StripeRequest GetCardToken +getCardToken (TokenId token) = request + where request = mkStripeRequest GET url params + url = "tokens" token + params = [] + +data GetCardToken +type instance StripeReturn GetCardToken = Token Card + +------------------------------------------------------------------------------ +-- | Retrieve a `Token` by `TokenId` +getBankAccountToken + :: TokenId -- ^ The `TokenId` of the `BankAccount` `Token` to retrieve + -> StripeRequest GetBankAccountToken +getBankAccountToken (TokenId token) = request + where request = mkStripeRequest GET url params + url = "tokens" token + params = [] + +data GetBankAccountToken +type instance StripeReturn GetBankAccountToken = Token BankAccount 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,174 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Transfer +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#transfers > +-- +-- @ +-- {-\# LANGUAGE OverloadedStrings \#-} +-- import Web.Stripe +-- import Web.Stripe.Transfer +-- import Web.Stripe.Recipient +-- +-- main :: IO () +-- main = do +-- let config = StripeConfig (StripeKey "secret_key") +-- result <- stripe config $ getRecipient (RecipientId "recipient_id") +-- case result of +-- (Left stripeError) -> print stripeError +-- (Right (Recipient { recipientId = recipientid })) -> do +-- result <- stripe config $ createTransfer recipientid (Amount 100) USD +-- case result of +-- Left stripeError -> print stripeError +-- Right transfer -> print transfer +-- @ +module Web.Stripe.Transfer + ( -- * API + CreateTransfer + , createTransfer + , GetTransfer + , getTransfer + , UpdateTransfer + , updateTransfer + , CancelTransfer + , cancelTransfer + , GetTransfers + , getTransfers + -- * Types + , Amount (..) + , BankAccountId (..) + , Card (..) + , CardId (..) + , Created (..) + , Currency (..) + , Date (..) + , Description (..) + , EndingBefore (..) + , ExpandParams (..) + , Recipient (..) + , RecipientId (..) + , StartingAfter (..) + , StatementDescription (..) + , StripeList (..) + , Transfer (..) + , TransferId (..) + , TransferStatus (..) + , TransferType (..) + , Limit (..) + ) where +import Web.Stripe.StripeRequest (Method (GET, POST), + StripeHasParam, StripeRequest (..), + StripeReturn, ToStripeParam(..), + mkStripeRequest) +import Web.Stripe.Util (()) +import Web.Stripe.Types (Amount(..), BankAccountId(..), Card(..), + CardId(..), Created(..),Currency (..), + Date(..), EndingBefore(..), + ExpandParams(..), + Limit(..), MetaData(..), Recipient (..), + RecipientId(..), StartingAfter(..), + StatementDescription(..), + StripeList (..), Transfer (..), + TransferId (..), TransferStatus (..), + Description(..), TransferType (..)) + +------------------------------------------------------------------------------ +-- | 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` + -> StripeRequest CreateTransfer +createTransfer + recipientid + amount + currency = request + where request = mkStripeRequest POST url params + url = "transfers" + params = toStripeParam recipientid $ + toStripeParam amount $ + toStripeParam currency $ + [] + +data CreateTransfer +type instance StripeReturn CreateTransfer = Transfer +instance StripeHasParam CreateTransfer Description +instance StripeHasParam CreateTransfer BankAccountId +instance StripeHasParam CreateTransfer CardId +instance StripeHasParam CreateTransfer StatementDescription +instance StripeHasParam CreateTransfer MetaData + +------------------------------------------------------------------------------ +-- | Retrieve a `Transfer` +getTransfer + :: TransferId -- ^ `TransferId` associated with the `Transfer` to retrieve + -> StripeRequest GetTransfer +getTransfer + (TransferId transferid) + = request + where request = mkStripeRequest GET url params + url = "transfers" transferid + params = [] + +data GetTransfer +type instance StripeReturn GetTransfer = Transfer +instance StripeHasParam GetTransfer ExpandParams + +------------------------------------------------------------------------------ +-- | Update a `Transfer` +updateTransfer + :: TransferId -- ^ The `TransferId` of the `Transfer` to update + -> StripeRequest UpdateTransfer +updateTransfer + (TransferId transferid) + = request + where request = mkStripeRequest POST url params + url = "transfers" transferid + params = [] + +data UpdateTransfer +type instance StripeReturn UpdateTransfer = Transfer +instance StripeHasParam UpdateTransfer Description +instance StripeHasParam UpdateTransfer MetaData + +------------------------------------------------------------------------------ +-- | Cancel a `Transfer` +cancelTransfer + :: TransferId -- ^ The `TransferId` of the `Transfer` to cancel + -> StripeRequest CancelTransfer +cancelTransfer (TransferId transferid) = request + where request = mkStripeRequest POST url params + url = "transfers" transferid "cancel" + params = [] + +data CancelTransfer +type instance StripeReturn CancelTransfer = Transfer + +------------------------------------------------------------------------------ +-- | Retrieve StripeList of `Transfers` +getTransfers + :: StripeRequest GetTransfers +getTransfers + = request + where request = mkStripeRequest GET url params + url = "transfers" + params = [] + +data GetTransfers +type instance StripeReturn GetTransfers = StripeList Transfer +instance StripeHasParam GetTransfers ExpandParams +instance StripeHasParam GetTransfers Created +instance StripeHasParam GetTransfers Date +instance StripeHasParam GetTransfers (EndingBefore TransferId) +instance StripeHasParam GetTransfers Limit +instance StripeHasParam GetTransfers RecipientId +instance StripeHasParam GetTransfers (StartingAfter TransferId) +instance StripeHasParam GetTransfers TransferStatus 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,2527 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +------------------------------------------------------------------------------ +-- | +-- 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), ToJSON(..), + Value (String, Object, Bool), (.:), + (.:?)) +import Data.Data (Data, Typeable) +import qualified Data.HashMap.Strict as H +import Data.Ratio ((%)) +import Data.Text (Text) +import Data.Time (UTCTime) +import Numeric (fromRat, showFFloat) +import Text.Read (lexP, pfail) +import qualified Text.Read as R +import Web.Stripe.Util (fromSeconds) +------------------------------------------------------------------------------ + +------------------------------------------------------------------------------ +-- | `Expandable` values +-- maps from an id to an object, e.g. `CardId` to `Card` +type family ExpandsTo id :: * + +-- | a wrapper for fields which can either be an id or an expanded object +data Expandable id + = Id id -- ^ an id such as `CardId`, `AccountId`, `CustomerId`, etc + | Expanded (ExpandsTo id) -- ^ expanded object such as `Card`, `Account`, `Customer`, etc + deriving (Typeable) + +deriving instance (Data id, Data (ExpandsTo id)) => Data (Expandable id) +deriving instance (Show id, Show (ExpandsTo id)) => Show (Expandable id) +deriving instance (Read id, Read (ExpandsTo id)) => Read (Expandable id) +deriving instance (Eq id, Eq (ExpandsTo id)) => Eq (Expandable id) +deriving instance (Ord id, Ord (ExpandsTo id)) => Ord (Expandable id) + +type instance ExpandsTo AccountId = Account +type instance ExpandsTo CardId = Card +type instance ExpandsTo ChargeId = Charge +type instance ExpandsTo CustomerId = Customer +type instance ExpandsTo InvoiceId = Invoice +type instance ExpandsTo InvoiceItemId = InvoiceItem +type instance ExpandsTo RecipientId = Recipient +type instance ExpandsTo RecipientCardId = RecipientCard +type instance ExpandsTo TransactionId = BalanceTransaction + +------------------------------------------------------------------------------ +-- | JSON Instance for `Expandable` +instance (FromJSON id, FromJSON (ExpandsTo id)) => + FromJSON (Expandable id) where + parseJSON v = (Id <$> parseJSON v) <|> (Expanded <$> parseJSON v) + +------------------------------------------------------------------------------ +-- | specify a `TimeRange` +-- FIXME: this is a little awkward to use. How can we make it moar better? +data TimeRange a = TimeRange + { gt :: Maybe a + , gte :: Maybe a + , lt :: Maybe a + , lte :: Maybe a + } deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Time range with all values set to `Nothing` +emptyTimeRange :: TimeRange a +emptyTimeRange = TimeRange + { gt = Nothing + , gte = Nothing + , lt = Nothing + , lte = Nothing + } + +------------------------------------------------------------------------------ +-- | `AvailableOn` +newtype AvailableOn = AvailableOn UTCTime + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `Created` +newtype Created = Created UTCTime + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `Date` +newtype Date = Date UTCTime + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `ChargeId` associated with a `Charge` +newtype ChargeId + = ChargeId Text + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | JSON Instance for `ChargeId` +instance FromJSON ChargeId where + parseJSON (String x) = pure $ ChargeId x + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `StatementDescription` to be added to a `Charge` +newtype StatementDescription = + StatementDescription Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +instance FromJSON StatementDescription where + parseJSON v = StatementDescription <$> parseJSON v + +------------------------------------------------------------------------------ +-- | `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 (Expandable TransactionId) + , chargeFailureMessage :: Maybe Text + , chargeFailureCode :: Maybe Text + , chargeAmountRefunded :: Int + , chargeCustomerId :: Maybe (Expandable CustomerId) + , chargeInvoice :: Maybe (Expandable InvoiceId) + , chargeDescription :: Maybe Description + , chargeDispute :: Maybe Dispute + , chargeMetaData :: MetaData + , chargeStatementDescription :: Maybe StatementDescription + , chargeReceiptEmail :: Maybe Text + , chargeReceiptNumber :: Maybe Text + } deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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" + <*> o .:? "balance_transaction" + <*> o .:? "failure_message" + <*> o .:? "failure_code" + <*> o .: "amount_refunded" + <*> o .:? "customer" + <*> o .:? "invoice" + <*> o .:? "description" + <*> o .:? "dispute" + <*> o .: "metadata" + <*> o .:? "statement_description" + <*> o .:? "receipt_email" + <*> o .:? "receipt_number" + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | Capture for `Charge` +newtype Capture = Capture { getCapture :: Bool } + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `RefundId` for `Refund` +newtype RefundId = + RefundId Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `Refund` Object +data Refund = Refund { + refundId :: RefundId + , refundAmount :: Int + , refundCurrency :: Currency + , refundCreated :: UTCTime + , refundObject :: Text + , refundCharge :: ChargeId + , refundBalanceTransaction :: Expandable TransactionId + , refundMetaData :: MetaData + } deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | JSON Instance for `Refund` +instance FromJSON Refund where + parseJSON (Object o) = + Refund <$> (RefundId <$> o .: "id") + <*> o .: "amount" + <*> o .: "currency" + <*> (fromSeconds <$> o .: "created") + <*> o .: "object" + <*> o .: "charge" + <*> o .: "balance_transaction" + <*> o .: "metadata" + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `RefundApplicationFee` +newtype RefundApplicationFee = + RefundApplicationFee { getRefundApplicationFee :: Bool } + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `RefundReason` +data RefundReason + = RefundDuplicate + | RefundFraudulent + | RefundRequestedByCustomer + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `CustomerId` for a `Customer` +newtype CustomerId + = CustomerId Text + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | JSON Instance for `CustomerId` +instance FromJSON CustomerId where + parseJSON (String x) = pure (CustomerId x) + 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 (Expandable CardId) + , customerMetaData :: MetaData + } | DeletedCustomer { + deletedCustomer :: Maybe Bool + , deletedCustomerId :: CustomerId + } deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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" + <*> o .:? "default_card" + <*> o .: "metadata" + <|> DeletedCustomer + <$> o .: "deleted" + <*> (CustomerId <$> o .: "id")) + <|> DeletedCustomer + <$> o .:? "deleted" + <*> (CustomerId <$> o .: "id") + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | AccountBalance for a `Customer` +newtype AccountBalance = AccountBalance Int + deriving (Eq, Ord, Read, Show, Data, Typeable) + +------------------------------------------------------------------------------ +-- | CardId for a `Customer` +newtype CardId = CardId Text + deriving (Eq, Ord, Read, Show, Data, Typeable) + +------------------------------------------------------------------------------ +-- | CardId for a `Recipient` +newtype RecipientCardId = RecipientCardId Text + deriving (Eq, Ord, Read, Show, Data, Typeable) + +------------------------------------------------------------------------------ +-- | JSON Instance for `CardId` +instance FromJSON CardId where + parseJSON (String x) = pure $ CardId x + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | JSON Instance for `RecipientCardId` +instance FromJSON RecipientCardId where + parseJSON (String x) = pure $ RecipientCardId x + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | Number associated with a `Card` +newtype CardNumber = CardNumber Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Expiration Month for a `Card` +newtype ExpMonth = ExpMonth Int deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Expiration Year for a `Card` +newtype ExpYear = ExpYear Int deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | CVC for a `Card` +newtype CVC = CVC Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | City address for a `Card` +newtype AddressCity = AddressCity Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Country address for a `Card` +newtype AddressCountry = AddressCountry Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Address Line One for a `Card` +newtype AddressLine1 = AddressLine1 Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Address Line Two for a `Card` +newtype AddressLine2 = AddressLine2 Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Address State for a `Card` +newtype AddressState = AddressState Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Address Zip Code for a `Card` +newtype AddressZip = AddressZip Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `IsVerified` `Recipients` +newtype IsVerified = IsVerified { getVerified :: Bool } + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Credit / Debit Card Brand +data Brand = Visa + | AMEX + | MasterCard + | Discover + | JCB + | DinersClub + | Unknown + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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 (Expandable CustomerId) + } deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `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 (Expandable RecipientId) +} deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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" + <*> 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" + <*> o .:? "recipient" + parseJSON _ = mzero + + +------------------------------------------------------------------------------ +-- | `NewCard` contains the data needed to create a new `Card` +data NewCard = NewCard + { newCardCardNumber :: CardNumber + , newCardExpMonth :: ExpMonth + , newCardExpYear :: ExpYear + , newCardCVC :: Maybe CVC + , newCardName :: Maybe Name + , newCardAddressLine1 :: Maybe AddressLine1 + , newCardAddressLine2 :: Maybe AddressLine2 + , newCardAddressCity :: Maybe AddressCity + , newCardAddressZip :: Maybe AddressZip + , newCardAddressState :: Maybe AddressState + , newCardAddressCountry :: Maybe AddressCountry + } + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | create a `NewCard` with only the required fields +mkNewCard + :: CardNumber + -> ExpMonth + -> ExpYear + -> NewCard +mkNewCard + cardNumber + expMonth + expYear + = NewCard + { newCardCardNumber = cardNumber + , newCardExpMonth = expMonth + , newCardExpYear = expYear + , newCardCVC = Nothing + , newCardName = Nothing + , newCardAddressLine1 = Nothing + , newCardAddressLine2 = Nothing + , newCardAddressCity = Nothing + , newCardAddressZip = Nothing + , newCardAddressState = Nothing + , newCardAddressCountry = Nothing + } + +------------------------------------------------------------------------------ +-- | set the `DefaultCard` +data DefaultCard = DefaultCard { getDefaultCard :: CardId } + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `SubscriptionId` for a `Subscription` +newtype SubscriptionId = SubscriptionId { getSubscriptionId :: Text } + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Subscription Object +data Subscription = Subscription { + subscriptionId :: SubscriptionId + , subscriptionPlan :: Plan + , subscriptionObject :: Text + , subscriptionStart :: UTCTime + , subscriptionStatus :: SubscriptionStatus + , subscriptionCustomerId :: Expandable 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 (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | JSON Instance for `Subscription` +instance FromJSON Subscription where + parseJSON (Object o) = + Subscription <$> (SubscriptionId <$> o .: "id") + <*> o .: "plan" + <*> o .: "object" + <*> (fromSeconds <$> o .: "start") + <*> o .: "status" + <*> 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" + <*> o .: "metadata" + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | Status of a `Subscription` +data SubscriptionStatus = + Trialing + | Active + | PastDue + | Canceled + | UnPaid + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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 (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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 StatementDescription +} deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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" + <*> o .: "metadata" + <*> o .:? "statement_description" + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `TrialPeriod` for a Plan +newtype TrialPeriod = TrialPeriod UTCTime deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | `TrialEnd` for a Plan +newtype TrialEnd = TrialEnd UTCTime + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Interval for `Plan`s +data Interval = Day | Week | Month | Year deriving (Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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" + +------------------------------------------------------------------------------ +-- | `Read` instance for `Interval` +instance Read Interval where + readPrec = + do (R.String s) <- lexP + case s of + "day" -> return Day + "week" -> return Week + "month" -> return Month + "year" -> return Year + _ -> pfail + +------------------------------------------------------------------------------ +-- | `Coupon` Duration +data Duration = Forever | Once | Repeating deriving (Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `Show` instance for `Duration` +instance Show Duration where + show Forever = "forever" + show Once = "once" + show Repeating = "repeating" + +------------------------------------------------------------------------------ +-- | `Read` instance for `Duration` +instance Read Duration where + readPrec = + do (R.String s) <- lexP + case s of + "forever" -> return Forever + "once" -> return Once + "repeating" -> return Repeating + _ -> pfail + +------------------------------------------------------------------------------ +-- | 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 (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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" + <*> o .: "metadata" + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `CouponId` for a `Coupon` +newtype CouponId = CouponId Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `AmountOff` for a `Coupon` +newtype AmountOff = AmountOff Int deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `MaxRedemptions` for a `Coupon` +newtype MaxRedemptions = MaxRedemptions Int deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `PercentOff` for a `Coupon` +newtype PercentOff = PercentOff Int deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `RedeemBy` date for a `Coupon` +newtype RedeemBy = RedeemBy UTCTime deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `DurationInMonths` for a `Coupon` +newtype DurationInMonths = DurationInMonths Int deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `IntervalCount` for a `Coupon` +newtype IntervalCount = IntervalCount Int deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `TrialPeriodDays` for a `Coupon` +newtype TrialPeriodDays = TrialPeriodDays Int deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Amount representing a monetary value. +-- Stripe represents pennies as whole numbers +-- i.e. 100 = $1 +newtype Amount = Amount { getAmount :: Int } + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `Discount` for `Coupon` +data Discount = Discount { + discountCoupon :: Coupon + , discountStart :: UTCTime + , discountEnd :: Maybe UTCTime + , discountCustomer :: Expandable CustomerId + , discountObject :: Text + , discountSubscription :: Maybe SubscriptionId +} deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | JSON Instance for `Discount` +instance FromJSON Discount where + parseJSON (Object o) = + Discount <$> o .: "coupon" + <*> (fromSeconds <$> o .: "start") + <*> (fmap fromSeconds <$> o .:? "end") + <*> o .: "customer" + <*> o .: "object" + <*> (fmap SubscriptionId <$> o .:? "subscription") + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `Invoice` for a `Coupon` +newtype InvoiceId = + InvoiceId Text + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | JSON Instance for `InvoiceId` +instance FromJSON InvoiceId where + parseJSON (String x) = pure $ InvoiceId x + 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 :: Expandable CustomerId + , invoiceObject :: Text + , invoiceAttempted :: Bool + , invoiceClosed :: Bool + , invoiceForgiven :: Bool + , invoicePaid :: Bool + , invoiceLiveMode :: Bool + , invoiceAttemptCount :: Int + , invoiceAmountDue :: Int + , invoiceCurrency :: Currency + , invoiceStartingBalance :: Int + , invoiceEndingBalance :: Maybe Int + , invoiceNextPaymentAttempt :: Maybe UTCTime + , invoiceWebHooksDeliveredAt :: Maybe UTCTime + , invoiceCharge :: Maybe (Expandable ChargeId) + , invoiceDiscount :: Maybe Discount + , invoiceApplicateFee :: Maybe FeeId + , invoiceSubscription :: Maybe SubscriptionId + , invoiceStatementDescription :: Maybe StatementDescription + , invoiceDescription :: Maybe Description + , invoiceMetaData :: MetaData +} deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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" + <*> 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") + <*> o .:? "charge" + <*> o .:? "discount" + <*> (fmap FeeId <$> o .:? "application_fee") + <*> (fmap SubscriptionId <$> o .: "subscription") + <*> o .:? "statement_description" + <*> o .:? "description" + <*> o .: "metadata" + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `InvoiceItemId` for `InvoiceItem` +newtype InvoiceItemId + = InvoiceItemId Text + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `InvoiceItem` object +data InvoiceItem = InvoiceItem { + invoiceItemObject :: Text + , invoiceItemId :: InvoiceItemId + , invoiceItemDate :: UTCTime + , invoiceItemAmount :: Int + , invoiceItemLiveMode :: Bool + , invoiceItemProration :: Bool + , invoiceItemCurrency :: Currency + , invoiceItemCustomer :: Expandable CustomerId + , invoiceItemDescription :: Maybe Description + , invoiceItemInvoice :: Maybe (Expandable InvoiceId) + , invoiceItemQuantity :: Maybe Quantity + , invoiceItemSubscription :: Maybe Subscription + , invoiceItemMetaData :: MetaData + } deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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" + <*> o .: "customer" + <*> o .:? "description" + <*> o .:? "invoice" + <*> (fmap Quantity <$> o .:? "quantity") + <*> o .:? "subscription" + <*> o .: "metadata" + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `InvoiceLineItemId` for an `InvoiceLineItem` +newtype InvoiceLineItemId = + InvoiceLineItemId Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Type of `InvoiceItem` +data InvoiceLineItemType + = InvoiceItemType | + SubscriptionItemType + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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 (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Period for an `InvoiceLineItem` +data Period = Period { + start :: UTCTime + , end :: UTCTime + } deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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" + <*> o .: "metadata" + parseJSON _ = mzero + + +------------------------------------------------------------------------------ +-- | `Closed` - invoice closed or not +newtype Closed = + Closed { getClosed :: Bool } + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `Forgiven` - invoice forgiven or not +newtype Forgiven = + Forgiven { getForgiven :: Bool } + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Status of a `Dispute` +data DisputeStatus + = WarningNeedsResponse + | WarningUnderReview + | NeedsResponse + | UnderReview + | ChargeRefunded + | Won + | Lost + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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 (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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 :: Expandable 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 (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `Evidence` associated with a `Dispute` +newtype Evidence = Evidence Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | JSON Instance for `Dispute` +instance FromJSON Dispute where + parseJSON (Object o) = + Dispute <$> 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") + <*> o .: "metadata" + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `TransferId` +newtype TransferId = + TransferId Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Status of a `Transfer` +data TransferStatus = + TransferPaid + | TransferPending + | TransferCanceled + | TransferFailed + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Type of a `Transfer` +data TransferType = + CardTransfer + | BankAccountTransfer + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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 :: Expandable TransactionId + , transferDescription :: Maybe Description + , transferBankAccount :: Maybe BankAccount + , transferFailureMessage :: Maybe Text + , transferFailureCode :: Maybe Text + , transferStatementDescription :: Maybe StatementDescription + , transferRecipient :: Maybe (Expandable RecipientId) + , transferMetaData :: MetaData +} deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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" + <*> o .: "balance_transaction" + <*> o .:? "description" + <*> o .:? "bank_account" + <*> o .:? "failure_message" + <*> o .:? "failure_code" + <*> o .:? "statement_description" + <*> o .:? "recipient" + <*> 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 (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `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 (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `BankAccountStatus` Object +data BankAccountStatus = + New | Validated | Verified | Errored + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `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 (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Country +newtype Country = + Country Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Account Number of a Bank Account +newtype AccountNumber = + AccountNumber Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | create a new `BankAccount` +data NewBankAccount = NewBankAccount + { newBankAccountCountry :: Country + , newBankAccountRoutingNumber :: RoutingNumber + , newBankAccountAccountNumber :: AccountNumber + } + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Recipients + +------------------------------------------------------------------------------ +-- | `FirstName` of a `Recipient` +newtype FirstName = FirstName Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `LastName` of a `Recipient` +newtype LastName = LastName Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Middle Initial of a `Recipient` +type MiddleInitial = Char + +------------------------------------------------------------------------------ +-- | `RecipientId` for a `Recipient` +newtype RecipientId = + RecipientId Text + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | JSON Instance for `RecipientId` +instance FromJSON RecipientId where + parseJSON (String x) = pure $ RecipientId x + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `TaxID` +newtype TaxID = TaxID { getTaxID :: Text } + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Type of `Recipient` +data RecipientType = + Individual + | Corporation deriving (Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `Show` instance for `RecipientType` +instance Show RecipientType where + show Individual = "individual" + show Corporation = "corporation" + +------------------------------------------------------------------------------ +-- | `Read` instance for `RecipientType` +instance Read RecipientType where + readPrec = + do (R.String s) <- lexP + case s of + "individual" -> return Individual + "corporation" -> return Corporation + _ -> pfail + +------------------------------------------------------------------------------ +-- | 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 (Expandable RecipientCardId) + } | DeletedRecipient { + deletedRecipient :: Maybe Bool + , deletedRecipientId :: RecipientId + } deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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" + <*> o .:? "default_card" + ) + <|> DeletedRecipient + <$> o .:? "deleted" + <*> (RecipientId <$> o .: "id") + + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `PlanId` for a `Plan` +newtype ApplicationFeeId = ApplicationFeeId Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | ApplicationFee Object +data ApplicationFee = ApplicationFee { + applicationFeeId :: ApplicationFeeId + , applicationFeeObjecet :: Text + , applicationFeeCreated :: UTCTime + , applicationFeeLiveMode :: Bool + , applicationFeeAmount :: Int + , applicationFeeCurrency :: Currency + , applicationFeeRefunded :: Bool + , applicationFeeAmountRefunded :: Int + , applicationFeeRefunds :: StripeList Refund + , applicationFeeBalanceTransaction :: Expandable TransactionId + , applicationFeeAccountId :: Expandable AccountId + , applicationFeeApplicationId :: ApplicationId + , applicationFeeChargeId :: Expandable ChargeId + , applicationFeeMetaData :: MetaData +} deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | ApplicationFeePercent +newtype ApplicationFeePercent = ApplicationFeePercent Double + deriving (Read, Show, Eq, Ord, Data, Typeable) + + +------------------------------------------------------------------------------ +-- | ApplicationFeeAmount +newtype ApplicationFeeAmount = ApplicationFeeAmount Integer + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `ApplicationId` object +newtype ApplicationId = + ApplicationId Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | JSON Instance for `ApplicationFee` +instance FromJSON ApplicationFee where + parseJSON (Object o) = + ApplicationFee <$> (ApplicationFeeId <$> o .: "id") + <*> o .: "object" + <*> (fromSeconds <$> o .: "created") + <*> o .: "livemode" + <*> o .: "amount" + <*> o .: "currency" + <*> o .: "refunded" + <*> o .: "amount_refunded" + <*> o .: "refunds" + <*> o .: "balance_transaction" + <*> o .: "account" + <*> (ApplicationId <$> o .: "application") + <*> o .: "charge" + <*> o .: "metadata" + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `FeeId` for objects with Fees +newtype FeeId = + FeeId Text + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Application Fee Refunds +data ApplicationFeeRefund = ApplicationFeeRefund { + applicationFeeRefundId :: RefundId + , applicationFeeRefundAmount :: Int + , applicationFeeRefundCurrency :: Currency + , applicationFeeRefundCreated :: UTCTime + , applicationFeeRefundObject :: Text + , applicationFeeRefundBalanceTransaction :: Maybe (Expandable TransactionId) + , applicationFeeRefundFee :: FeeId + , applicationFeeRefundMetaData :: MetaData + } deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | JSON Instance for `ApplicationFeeRefund` +instance FromJSON ApplicationFeeRefund where + parseJSON (Object o) = ApplicationFeeRefund + <$> (RefundId <$> o .: "id") + <*> o .: "amount" + <*> o .: "currency" + <*> (fromSeconds <$> o .: "created") + <*> o .: "object" + <*> o .:? "balance_transaction" + <*> (FeeId <$> o .: "fee") + <*> o .: "metadata" + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `AccountId` of an `Account` +newtype AccountId + = AccountId Text + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | JSON Instance for `AccountId` +instance FromJSON AccountId where + 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 (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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 (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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 (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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 :: Int + , balanceTransactionCurrency :: Currency + , balanceTransactionNet :: Int + , balanceTransactionType :: TransactionType + , balanceTransactionCreated :: UTCTime + , balanceTransactionAvailableOn :: UTCTime + , balanceTransactionStatus :: Text + , balanceTransactionFee :: Int + , balanceTransactionFeeDetails :: [FeeDetails] + , balanceTransactionFeeSource :: Expandable ChargeId + , balanceTransactionFeeDescription :: Maybe Description + } deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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" + <*> o .: "source" + <*> o .:? "description" + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `TransactionId` of a `Transaction` +newtype TransactionId = TransactionId Text + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | JSON Instance for `TransactionId` +instance FromJSON TransactionId where + parseJSON (String x) = pure (TransactionId x) + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `FeeDetails` Object +data FeeDetails = FeeDetails { + feeDetailsAmount :: Int + , feeDetailsCurrency :: Currency + , feeType :: Text + , feeDescription :: Maybe Description + , feeApplication :: Maybe Text +} deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | JSON Instance for `FeeDetails` +instance FromJSON FeeDetails where + parseJSON (Object o) = + FeeDetails <$> o .: "amount" + <*> o .: "currency" + <*> o .: "type" + <*> o .: "description" + <*> o .:? "application" + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `Source` used for filtering `Balance` transactions. It should contain +-- an object Id such as a `ChargeId` +newtype Source a = Source { getSource :: a } + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | transaction type for `BalanceTransaction` +data TransactionType + = ChargeTxn + | RefundTxn + | AdjustmentTxn + | ApplicationFeeTxn + | ApplicationFeeRefundTxn + | TransferTxn + | TransferCancelTxn + | TransferFailureTxn + deriving (Read, Show, Eq, Ord, Data, Typeable) + +instance FromJSON TransactionType where + parseJSON (String "charge") = pure ChargeTxn + parseJSON (String "refund") = pure RefundTxn + parseJSON (String "adjustment") = pure AdjustmentTxn + parseJSON (String "application_fee") = pure ApplicationFeeTxn + parseJSON (String "application_fee_refund") = pure ApplicationFeeRefundTxn + parseJSON (String "transfer") = pure TransferTxn + parseJSON (String "transfer_cancel") = pure TransferCancelTxn + parseJSON (String "transfer_failure") = pure TransferFailureTxn + parseJSON _ = mzero + +instance ToJSON TransactionType where + toJSON ChargeTxn = String "charge" + toJSON RefundTxn = String "refund" + toJSON AdjustmentTxn = String "adjustment" + toJSON ApplicationFeeTxn = String "application_fee" + toJSON ApplicationFeeRefundTxn = String "application_fee_refund" + toJSON TransferTxn = String "transfer" + toJSON TransferCancelTxn = String "transfer_cancel" + toJSON TransferFailureTxn = String "transfer_failure" + +------------------------------------------------------------------------------ +-- | `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 (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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 (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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 (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `Event` Object +data Event = Event { + eventId :: Maybe EventId + , eventCreated :: UTCTime + , eventLiveMode :: Bool + , eventType :: EventType + , eventData :: EventData + , eventObject :: Text + , eventPendingWebHooks :: Int + , eventRequest :: Maybe Text +} deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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 (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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 (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Type of `Token` +data TokenType = TokenCard + | TokenBankAccount + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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 (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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 (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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` +newtype Limit = Limit Int + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Pagination Option for `StripeList` +newtype StartingAfter a = StartingAfter a + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Pagination Option for `StripeList` +newtype EndingBefore a = EndingBefore a + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | JSON returned from a `Stripe` deletion request +data StripeDeleteResult = StripeDeleteResult { + deleted :: Bool + , deletedId :: Maybe Text + } deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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 +newtype MetaData = MetaData [ (Text,Text) ] + deriving (Read, Show, Eq, Ord, Data, Typeable) + +instance FromJSON MetaData where + parseJSON j = (MetaData . H.toList) <$> (parseJSON j) + +------------------------------------------------------------------------------ +-- | Type of Expansion Parameters for use on `Stripe` objects +newtype ExpandParams = ExpandParams { getExpandParams :: [Text] } + deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Generic ID for use in constructing API Calls +type ID = Text + +------------------------------------------------------------------------------ +-- | Generic URL for use in constructing API Calls +type URL = Text + +------------------------------------------------------------------------------ +-- | a cardholder's full name +newtype Name = Name { getName :: Text } + deriving (Read, Show, Eq, Ord, Data, Typeable) + +instance FromJSON Name where + parseJSON v = Name <$> parseJSON v + +------------------------------------------------------------------------------ +-- | a plan name +newtype PlanName = PlanName { getPlanName :: Text } + deriving (Read, Show, Eq, Ord, Data, Typeable) + +instance FromJSON PlanName where + parseJSON v = PlanName <$> parseJSON v + +------------------------------------------------------------------------------ +-- | Generic Description for use in constructing API Calls +newtype Description = Description Text + deriving (Read, Show, Eq, Ord, Data, Typeable) + +instance FromJSON Description where + parseJSON v = Description <$> parseJSON v + +------------------------------------------------------------------------------ +-- | Generic `Quantity` type to be used with `Customer`, +-- `Subscription` and `InvoiceLineItem` API requests +newtype Quantity = Quantity Int deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | Prorate +newtype Prorate = Prorate Bool deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | A flag that if set to true will delay the cancellation of the +-- subscription until the end of the current period. +newtype AtPeriodEnd = AtPeriodEnd Bool deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `Email` associated with a `Customer`, `Recipient` or `Charge` +newtype Email = Email Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `Email` to send receipt to +newtype ReceiptEmail = ReceiptEmail Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | 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 (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `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 + +------------------------------------------------------------------------------ +-- | BTC ReceiverObject +data BitcoinReceiver = BitcoinReceiver { + btcId :: BitcoinReceiverId + , btcObject :: Text + , btcCreated :: UTCTime + , btcLiveMode :: Bool + , btcActive :: Bool + , btcAmount :: Integer + , btcAmountReceived :: Integer + , btcBitcoinAmount :: Integer + , btcBitcoinAmountReceived :: Integer + , btcBitcoinUri :: Text + , btcCurrency :: Currency + , btcFilled :: Bool + , btcInboundAddress :: Text + , btcUncapturedFunds :: Bool + , btcDescription :: Maybe Text + , btcEmail :: Text + , btcMetadata :: MetaData + , btcRefundAddress :: Maybe Text + , btcTransactions :: Maybe Transactions + , btcPayment :: Maybe PaymentId + , btcCustomer :: Maybe CustomerId + } deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | FromJSON for BitcoinReceiverId +instance FromJSON BitcoinReceiver where + parseJSON (Object o) = + BitcoinReceiver <$> (BitcoinReceiverId <$> o .: "id") + <*> o .: "object" + <*> (fromSeconds <$> o .: "created") + <*> o .: "livemode" + <*> o .: "active" + <*> o .: "amount" + <*> o .: "amount_received" + <*> o .: "bitcoin_amount" + <*> o .: "bitcoin_amount_received" + <*> o .: "bitcoin_uri" + <*> o .: "currency" + <*> o .: "filled" + <*> o .: "inbound_address" + <*> o .: "uncaptured_funds" + <*> o .:? "description" + <*> o .: "email" + <*> (MetaData . H.toList <$> o .: "metadata") + <*> o .:? "refund_address" + <*> o .:? "transactions" + <*> (fmap PaymentId <$> o .:? "payment") + <*> (fmap CustomerId <$> o .:? "customer") + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | Bitcoin Transactions +data Transactions = Transactions { + transactionsObject :: Text + , transactionsTotalCount :: Integer + , transactionsHasMore :: Bool + , transactionsURL :: Text + , transactions :: [BitcoinTransaction] + } deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Bitcoin Transactions data +instance FromJSON Transactions where + parseJSON (Object o) = + Transactions <$> o .: "object" + <*> o .: "total_count" + <*> o .: "has_more" + <*> o .: "url" + <*> o .: "data" + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | Bitcoin Transaction +data BitcoinTransaction = BitcoinTransaction { + btcTransactionId :: BitcoinTransactionId + , btcTransactionObject :: Text + , btcTransactionCreated :: UTCTime + , btcTransactionAmount :: Integer + , btcTransactionBitcoinAmount :: Integer + , btcTransactionCurrency :: Currency + , btcTransactionReceiver :: BitcoinReceiverId + } deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | FromJSON BitcoinTransaction +instance FromJSON BitcoinTransaction where + parseJSON (Object o) = + BitcoinTransaction <$> o .: "id" + <*> o .: "object" + <*> (fromSeconds <$> o .: "created") + <*> o .: "amount" + <*> o .: "bitcoin_amount" + <*> o .: "currency" + <*> o .: "receiver" + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | BitcoinTransactionId +newtype BitcoinTransactionId = + BitcoinTransactionId Text + deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | FromJSON BitcoinTransactionId +instance FromJSON BitcoinTransactionId where + parseJSON (String o) = pure $ BitcoinTransactionId o + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | BTC ReceiverId +newtype BitcoinReceiverId = BitcoinReceiverId Text + deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | FromJSON for BitcoinReceiverId +instance FromJSON BitcoinReceiverId where + parseJSON (String x) = pure $ BitcoinReceiverId x + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | BTC PaymentId +newtype PaymentId = PaymentId Text + deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | FromJSON for PaymentId +instance FromJSON PaymentId where + parseJSON (String x) = pure $ PaymentId x + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | Show an amount accounting for zero currencies +-- +-- https:\/\/support.stripe.com\/questions\/which-zero-decimal-currencies-does-stripe-support +showAmount + :: Currency -- ^ `Currency` + -> Int -- ^ `Amount` + -> String +showAmount cur amt = + case cur of + USD -> "$" ++ show2places (currencyDivisor cur amt) + _ -> show2places (currencyDivisor cur amt) ++ " " ++ show cur + where + show2places v = showFFloat (Just 2) v "" + +------------------------------------------------------------------------------ +-- currency division funtion accounting for zero currencies +-- +-- https:\/\/support.stripe.com\/questions\/which-zero-decimal-currencies-does-stripe-support +currencyDivisor + :: Currency -- ^ `Currency` + -> (Int -> Float) -- ^ function to convert amount to a float +currencyDivisor cur = + case cur of + BIF -> zeroCurrency + CLP -> zeroCurrency + DJF -> zeroCurrency + GNF -> zeroCurrency + JPY -> zeroCurrency + KMF -> zeroCurrency + KRW -> zeroCurrency + MGA -> zeroCurrency + PYG -> zeroCurrency + RWF -> zeroCurrency + VND -> zeroCurrency + VUV -> zeroCurrency + XAF -> zeroCurrency + XOF -> zeroCurrency + XPF -> zeroCurrency + EUR -> hundred + USD -> hundred + _ -> error $ "please submit a patch to currencyDivisor for this currency: " ++ show cur + where + zeroCurrency = fromIntegral + hundred v = fromRat $ (fromIntegral v) % (100 :: Integer) 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,68 @@ +{-# 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 + +------------------------------------------------------------------------------ +-- | Helper for retrieving `CustomerId` +getCustomerId :: CustomerId -> Text +getCustomerId (CustomerId x) = x + +------------------------------------------------------------------------------ +-- | Helper for retrieving `CardId` +getCardId :: CardId -> Text +getCardId (CardId x) = x + +------------------------------------------------------------------------------ +-- | Helper for retrieving `RecipientCardId` +getRecipientCardId :: RecipientCardId -> Text +getRecipientCardId (RecipientCardId x) = x + +------------------------------------------------------------------------------ +-- | Helper for retrieiving `RecipientId` +getRecipientId :: RecipientId -> Text +getRecipientId (RecipientId x) = x + +------------------------------------------------------------------------------ +-- | Helper for retrieving `AccountId` +getAccountId :: AccountId -> Text +getAccountId (AccountId x) = x + +------------------------------------------------------------------------------ +-- | Helper for retrieving `CardId` +getChargeId :: ChargeId -> Text +getChargeId (ChargeId x) = x + +------------------------------------------------------------------------------ +-- | Helper for retrieving `InvoiceId` +getInvoiceId :: InvoiceId -> Text +getInvoiceId (InvoiceId x) = x + +------------------------------------------------------------------------------ +-- | Helper for retrieving `InvoiceItemId` +getInvoiceItemId :: InvoiceItemId -> Text +getInvoiceItemId (InvoiceItemId x) = x + diff --git a/src/Web/Stripe/Util.hs b/src/Web/Stripe/Util.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/Util.hs @@ -0,0 +1,108 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Web.Stripe.Util +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +module Web.Stripe.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 = round . 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/stripe-core.cabal b/stripe-core.cabal new file mode 100644 --- /dev/null +++ b/stripe-core.cabal @@ -0,0 +1,65 @@ +name: stripe-core +version: 2.0.0 +synopsis: Stripe API for Haskell - Pure Core +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: + . + <> + . + [Pure API Wrapper] + `stripe-core` provides a complete binding to the Stripe API. `stripe-core` provides pure wrappers around all the Stripe API objects and methods. `stripe-core` is pure and is not tied to any particular HTTP client library. End users will typically install the `stripe` package which pulls in the `stripe-http-streams` library to obtain a complete set of functionality. + +library + hs-source-dirs: src + build-depends: aeson >= 0.8 && < 0.10 + , base >= 4.7 && < 5 + , bytestring >= 0.10 && < 0.11 + , mtl >= 2.1.2 && < 2.3 + , text >= 1.0 && < 1.3 + , time >= 1.4 && < 1.6 + , transformers >= 0.3 && < 0.5 + , unordered-containers >= 0.2.5 && < 0.3 + + default-language: Haskell2010 + other-modules: Web.Stripe.Types.Util + exposed-modules: + Web.Stripe.Account + Web.Stripe.ApplicationFee + Web.Stripe.ApplicationFeeRefund + Web.Stripe.Balance + Web.Stripe.Client + Web.Stripe.Card + Web.Stripe.Charge + Web.Stripe.Coupon + Web.Stripe.Customer + Web.Stripe.Discount + Web.Stripe.Dispute + Web.Stripe.Error + Web.Stripe.Event + Web.Stripe.Invoice + Web.Stripe.InvoiceItem + Web.Stripe.Plan + Web.Stripe.Recipient + Web.Stripe.Refund + Web.Stripe.StripeRequest + Web.Stripe.Subscription + Web.Stripe.Token + Web.Stripe.Transfer + Web.Stripe.Types + Web.Stripe.Util + + ghc-options: -Wall + +source-repository head + type: git + subdir: stripe-core + location: git://github.com/dmjio/stripe-haskell.git