stripe-tests (empty) → 2.2.0
raw patch · 26 files changed
+1838/−0 lines, 26 filesdep +aesondep +basedep +bytestringsetup-changed
Dependencies added: aeson, base, bytestring, free, hspec, hspec-core, mtl, random, stripe-core, text, time, transformers, unordered-containers
Files
- LICENSE +21/−0
- Setup.hs +2/−0
- stripe-tests.cabal +69/−0
- tests/Web/Stripe/Test/Account.hs +18/−0
- tests/Web/Stripe/Test/AllTests.hs +57/−0
- tests/Web/Stripe/Test/ApplicationFee.hs +18/−0
- tests/Web/Stripe/Test/ApplicationFeeRefund.hs +25/−0
- tests/Web/Stripe/Test/Balance.hs +52/−0
- tests/Web/Stripe/Test/Card.hs +238/−0
- tests/Web/Stripe/Test/Charge.hs +89/−0
- tests/Web/Stripe/Test/Config.hs +31/−0
- tests/Web/Stripe/Test/Coupon.hs +66/−0
- tests/Web/Stripe/Test/Customer.hs +69/−0
- tests/Web/Stripe/Test/Discount.hs +70/−0
- tests/Web/Stripe/Test/Dispute.hs +98/−0
- tests/Web/Stripe/Test/Event.hs +15/−0
- tests/Web/Stripe/Test/Invoice.hs +120/−0
- tests/Web/Stripe/Test/InvoiceItem.hs +87/−0
- tests/Web/Stripe/Test/Plan.hs +76/−0
- tests/Web/Stripe/Test/Prelude.hs +124/−0
- tests/Web/Stripe/Test/Recipient.hs +95/−0
- tests/Web/Stripe/Test/Refund.hs +92/−0
- tests/Web/Stripe/Test/Subscription.hs +138/−0
- tests/Web/Stripe/Test/Token.hs +40/−0
- tests/Web/Stripe/Test/Transfer.hs +92/−0
- tests/Web/Stripe/Test/Util.hs +36/−0
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ stripe-tests.cabal view
@@ -0,0 +1,69 @@+name: stripe-tests+version: 2.2.0+synopsis: Tests for Stripe API bindings for Haskell+license: MIT+license-file: LICENSE+author: David Johnson, Jeremy Shaw+maintainer: djohnson.m@gmail.com+copyright: Copyright (c) 2016 David M. Johnson, Jeremy Shaw+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:+ .+ <<https://stripe.com/img/navigation/logo@2x.png>>+ .+ [100+ Hspec Tests]+ This cabal package contains all the Stripe Hspec tests in an HTTP backend agnostic format.+ To run these tests you will need to install a package such as `stripe-http-streams`.+ This allows each backend to run the full testsuite.++library+ hs-source-dirs: tests+ build-depends: aeson >= 0.8 && < 0.10 || >= 0.11 && < 1.1+ , base >= 4.7 && < 5+ , bytestring >= 0.10 && < 0.11+ , free >= 4.10 && < 4.13+ , mtl >= 2.1.2 && < 2.3+ , random >= 1.1 && < 1.2+ , hspec >= 2.1.0 && < 2.3+ , hspec-core >= 2.1.0 && < 2.3+ , stripe-core >= 2.0 && < 2.3+ , text >= 1.0 && < 1.3+ , time >= 1.4 && < 1.7+ , transformers >= 0.3 && < 0.6+ , unordered-containers >= 0.2.5 && < 0.3++ default-language: Haskell2010+ exposed-modules:+ Web.Stripe.Test.Account+ Web.Stripe.Test.ApplicationFee+ Web.Stripe.Test.ApplicationFeeRefund+ Web.Stripe.Test.Balance+ Web.Stripe.Test.Card+ Web.Stripe.Test.Charge+ Web.Stripe.Test.Config+ Web.Stripe.Test.Coupon+ Web.Stripe.Test.Customer+ Web.Stripe.Test.Discount+ Web.Stripe.Test.Dispute+ Web.Stripe.Test.Event+ Web.Stripe.Test.Invoice+ Web.Stripe.Test.InvoiceItem+ Web.Stripe.Test.Plan+ Web.Stripe.Test.Prelude+ Web.Stripe.Test.Recipient+ Web.Stripe.Test.Refund+ Web.Stripe.Test.Subscription+ Web.Stripe.Test.Token+ Web.Stripe.Test.Transfer+ Web.Stripe.Test.Util+ Web.Stripe.Test.AllTests+ ghc-options: -Wall++source-repository head+ type: git+ subdir: stripe-tests+ location: git://github.com/dmjio/stripe-haskell.git
+ tests/Web/Stripe/Test/Account.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE RankNTypes #-}+module Web.Stripe.Test.Account where++import Data.Either+import Test.Hspec+import Web.Stripe.Test.Prelude+import Web.Stripe.Account++accountTests :: StripeSpec+accountTests stripe = do+ describe "Account tests" $ do+ it "Succesfully retrieves account information" $ do+ result <- stripe $ do d <- getAccountDetails + return d+ result `shouldSatisfy` isRight+
+ tests/Web/Stripe/Test/AllTests.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+module Web.Stripe.Test.AllTests where++import Test.Hspec (hspec)+import Web.Stripe.Test.Config (getConfig)+import Web.Stripe.Test.Account (accountTests)+import Web.Stripe.Test.ApplicationFee (applicationFeeTests)+import Web.Stripe.Test.ApplicationFeeRefund (applicationFeeRefundTests)+import Web.Stripe.Test.Balance (balanceTests)+import Web.Stripe.Test.Charge (chargeTests)+import Web.Stripe.Test.Card (cardTests)+import Web.Stripe.Test.Coupon (couponTests)+import Web.Stripe.Test.Customer (customerTests)+import Web.Stripe.Test.Discount (discountTests)+import Web.Stripe.Test.Dispute (disputeTests)+import Web.Stripe.Test.Invoice (invoiceTests)+import Web.Stripe.Test.InvoiceItem (invoiceItemTests)+import Web.Stripe.Test.Plan (planTests)+import Web.Stripe.Test.Recipient (recipientTests)+import Web.Stripe.Test.Refund (refundTests)+import Web.Stripe.Test.Subscription (subscriptionTests)+import Web.Stripe.Test.Token (tokenTests)+import Web.Stripe.Test.Transfer (transferTests)+import Web.Stripe.Test.Event (eventTests)+import Web.Stripe.Test.Prelude (Stripe)+import Web.Stripe.Client (StripeConfig, StripeError)+------------------------------------------------------------------------------+-- | Main test function entry point+allTests :: (forall a. StripeConfig -> Stripe a -> IO (Either StripeError a))+ -> IO ()+allTests stripe' = do+ config <- getConfig stripe'+ let stripe = stripe' config+ hspec $ do+ chargeTests stripe+ refundTests stripe+ customerTests stripe+ cardTests stripe+ subscriptionTests stripe+ planTests stripe+ couponTests stripe+ discountTests stripe+ invoiceTests stripe+ invoiceItemTests stripe+ disputeTests stripe+ transferTests stripe+ recipientTests stripe+ applicationFeeTests stripe+ applicationFeeRefundTests stripe+ accountTests stripe+ balanceTests stripe+ tokenTests stripe+ eventTests stripe++
+ tests/Web/Stripe/Test/ApplicationFee.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RebindableSyntax #-}+module Web.Stripe.Test.ApplicationFee where++import Test.Hspec+import Web.Stripe.Test.Prelude+import Web.Stripe.ApplicationFee+import Data.Either++applicationFeeTests :: StripeSpec+applicationFeeTests stripe = do+ describe "Application Fee tests" $ do+ it "Succesfully fails to retrieve an unknown application fee" $ do+ result <- stripe $ void $ getApplicationFee (FeeId "fee_unknown")+ result `shouldSatisfy` isLeft+ it "Succesfully retrieves all application fees" $ do+ result <- stripe $ void $ getApplicationFees+ result `shouldSatisfy` isRight
+ tests/Web/Stripe/Test/ApplicationFeeRefund.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE RecordWildCards #-}+module Web.Stripe.Test.ApplicationFeeRefund where++import Data.Either+import Test.Hspec+import Web.Stripe.Test.Prelude+import Web.Stripe.ApplicationFeeRefund++applicationFeeRefundTests :: StripeSpec+applicationFeeRefundTests stripe = do+ describe "Application Fee Refund tests" $ do+ it "Succesfully fails to refund an unknown application fee" $ do+ result <- stripe $ void $ createApplicationFeeRefund (FeeId "blah")+ result `shouldSatisfy` isLeft+ it "Succesfully fails to retrieve a Application ID with an unknown Refund id" $ do+ result <- stripe $ void $ getApplicationFeeRefund (FeeId "blah") (RefundId "adsf")+ result `shouldSatisfy` isLeft+ it "Succesfully fails to update an ApplicationRefund for an Invalid Fee ID" $ do+ result <- stripe $ void $ updateApplicationFeeRefund (FeeId "blah") (RefundId "blah")+ result `shouldSatisfy` isLeft+ it "Succesfully fails to retrieve all ApplicationRefunds for an Invalid Fee ID" $ do+ result <- stripe $ void $ getApplicationFeeRefunds (FeeId "blah")+ result `shouldSatisfy` isLeft
+ tests/Web/Stripe/Test/Balance.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RebindableSyntax #-}+module Web.Stripe.Test.Balance where++import Data.Either+import Test.Hspec+import Web.Stripe.Test.Prelude++import Web.Stripe.Balance+import Web.Stripe.Charge+import Web.Stripe.Customer+import Web.Stripe.StripeRequest (Expandable (..))++balanceTests :: StripeSpec+balanceTests stripe = do+ describe "Balance tests" $ do+ it "Succesfully retrieves a Balance" $ do+ result <- stripe $ do b <- getBalance+ return b+ result `shouldSatisfy` isRight+ it "Succesfully retrieves a Balance Transaction" $ do+ result <- stripe $ do+ Customer { customerId = cid } <-+ createCustomer+ -&- ((mkNewCard cn em ey) { newCardCVC = Just cvc })+ Charge { chargeBalanceTransaction = Just (Id txid) } <-+ createCharge (Amount 100) USD -&- cid+ balance <- getBalanceTransaction txid+ void $ deleteCustomer cid+ return balance+ result `shouldSatisfy` isRight+ it "Succesfully retrieves an Expanded Balance Transaction" $ do+ result <- stripe $ do+ Customer { customerId = cid } <-+ createCustomer+ -&- ((mkNewCard cn em ey) { newCardCVC = Just cvc })+ Charge { chargeBalanceTransaction = Just (Id txid)+ } <- createCharge (Amount 100) USD -&- cid+ result <- getBalanceTransaction txid -&- ExpandParams ["source"]+ void $ deleteCustomer cid+ return result+ result `shouldSatisfy` isRight+ it "Succesfully retrieves Balance Transaction History" $ do+ result <- stripe $ do b <- getBalanceTransactionHistory+ return b+ result `shouldSatisfy` isRight+ where+ cn = CardNumber "4242424242424242"+ em = ExpMonth 12+ ey = ExpYear 2020+ cvc = CVC "123"+
+ tests/Web/Stripe/Test/Card.hs view
@@ -0,0 +1,238 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE RecordWildCards #-}+module Web.Stripe.Test.Card where++import Data.Either+import Data.Maybe+import Test.Hspec+import Web.Stripe.Card+import Web.Stripe.Customer+import Web.Stripe.Recipient+import Web.Stripe.StripeRequest (Expandable (Id))+import Web.Stripe.Test.Prelude+import Web.Stripe.Token++cardTests :: StripeSpec+cardTests stripe = do+ describe "Card tests" $ do+ it "Can create a Customer and add a Card by CardNumber" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer+ card <- createCustomerCard cid cardinfo+ void $ deleteCustomer cid+ return card+ result `shouldSatisfy` isRight++ it "Can create a Customer Card by TokenId" $ do+ result <- stripe $ do+ Token { tokenId = tkid } <- createCardToken (Just cardinfo)+ Customer { customerId = cid } <- createCustomer+ card <- createCustomerCardByToken cid tkid+ void $ deleteCustomer cid+ return card+ result `shouldSatisfy` isRight++ it "Can retrieve a Customer Card" $ do+ result <- stripe $ do+ Customer { customerId = customerid+ , customerCards = StripeList { list = [ Card { cardId = cardid } ] }+ } <- createCustomer -&- cardinfo+ card <- getCustomerCard customerid cardid+ void $ deleteCustomer customerid+ return card+ result `shouldSatisfy` isRight+ let Right Card{..} = result+ cardLastFour `shouldBe` "4242"+ cardExpMonth `shouldBe` em+ cardExpYear `shouldBe` ey++ it "Can retrieve a Customer's Card with expansion" $ do+ result <- stripe $ do+ Customer { customerId = customerid+ , customerCards = StripeList { list = [ Card { cardId = cardid } ] }+ } <- createCustomer -&- cardinfo+ card <- getCustomerCard customerid cardid -&- ExpandParams ["customer"]+ void $ deleteCustomer customerid+ return card+ result `shouldSatisfy` isRight+ let Right Card{..} = result+ cardLastFour `shouldBe` "4242"+ cardExpMonth `shouldBe` em+ cardExpYear `shouldBe` ey++ it "Can retrieve a Customer's Cards" $ do+ result <- stripe $ do+ Customer { customerId = customerid+ } <- createCustomer -&- cardinfo+ card <- getCustomerCards customerid+ void $ deleteCustomer customerid+ return card+ result `shouldSatisfy` isRight++ it "Can retrieve a Customer's Cards with Expansion" $ do+ result <- stripe $ do+ Customer { customerId = customerid+ } <- createCustomer -&- cardinfo+ card <- getCustomerCards customerid -&- ExpandParams ["data.customer"]+ void $ deleteCustomer customerid+ return card+ result `shouldSatisfy` isRight++ it "Can delete a Customer's Cards" $ do+ result <- stripe $ do+ Customer { customerId = customerid+ , customerDefaultCard = Just (Id cardid)+ } <- createCustomer -&- cardinfo+ result <- deleteCustomerCard customerid cardid+ void $ deleteCustomer customerid+ return result+ result `shouldSatisfy` isRight++ it "Can update a Customer's Card" $ do+ result <- stripe $ do+ Customer { customerId = customerid+ , customerDefaultCard = Just (Id cardid)+ } <- createCustomer -&- cardinfo+ result <- updateCustomerCard customerid cardid+ -&- cardname+ -&- cardcity+ -&- cardcountry+ -&- cardaddressOne+ -&- cardaddressTwo+ -&- cardaddressState+ -&- cardzip+ void $ deleteCustomer customerid+ return result+ result `shouldSatisfy` isRight+ let Right Card{..} = result+ cardName `shouldBe` (Just cardname)+ cardAddressCity `shouldBe` (Just cardcity)+ cardAddressCountry `shouldBe` (Just cardcountry)+ cardAddressLine1 `shouldBe` (Just cardaddressOne)+ cardAddressLine2 `shouldBe` (Just cardaddressTwo)+ cardAddressState `shouldBe` (Just cardaddressState)+ cardAddressZip `shouldBe` (Just cardzip)++ describe "Recipient Card tests" $ do+ it "Can create a RecipientCard by CardNumber" $ do+ result <- stripe $ do+ r@Recipient{..} <- createRecipient name Individual -&- debitinfo+ void $ deleteRecipient recipientId+ return r+ result `shouldSatisfy` isRight+ let Right Recipient {..} = result+ length (list recipientCards) `shouldBe` 1++ it "Can create a RecipientCard by Card TokenId" $ do+ result <- stripe $ do+ Token { tokenId = tkid } <- createCardToken (Just debitinfo)+ Recipient { recipientId = rid } <- createRecipient name Individual+ rcard <- createRecipientCardByToken rid tkid+ void $ deleteRecipient rid+ return rcard+ result `shouldSatisfy` isRight++ it "Fails to create a RecipientCard by BankAccount TokenId" $ do+ result <- stripe $ do+ Token { tokenId = tkid } <- createBankAccountToken (Just $ NewBankAccount country routingnumber accountnumber)+ Recipient { recipientId = rid } <- createRecipient name Corporation+ rcard <- createRecipientCardByToken rid tkid+ void $ deleteRecipient rid+ return rcard+ result `shouldSatisfy` isLeft++ it "Can retrieve a RecipientCard" $ do+ result <- stripe $ do+ Recipient{..} <- createRecipient name Individual -&- debitinfo+ let (Id cardid) = fromJust recipientDefaultCard+ rcard <- getRecipientCard recipientId cardid+ void $ deleteRecipient recipientId+ return rcard+ result `shouldSatisfy` isRight++ it "Can retrieve a RecipientCard Expanded" $ do+ result <- stripe $ do+ Recipient{..} <- createRecipient name Individual -&- debitinfo+ let (Id cardid) = fromJust recipientDefaultCard+ rcard <- getRecipientCard recipientId cardid -&- ExpandParams ["recipient"]+ void $ deleteRecipient recipientId+ return rcard+ result `shouldSatisfy` isRight++ it "Can retrieve a Recipient's Cards" $ do+ result <- stripe $ do+ Recipient{..} <- createRecipient name Individual -&- debitinfo+ rcard <- getRecipientCards recipientId+ void $ deleteRecipient recipientId+ return rcard+ result `shouldSatisfy` isRight++ it "Can retrieve a Recipient's Cards Expanded" $ do+ result <- stripe $ do+ Recipient{..} <- createRecipient name Individual -&- debitinfo+ rcard <- getRecipientCards recipientId -&- ExpandParams ["data.recipient"]+ void $ deleteRecipient recipientId+ return rcard+ result `shouldSatisfy` isRight++ it "Can delete a Recipient Card" $ do+ result <- stripe $ do+ Recipient{..} <- createRecipient name Individual -&- debitinfo+ let (Id defaultCard) = fromJust recipientDefaultCard+ rcard <- deleteRecipientCard recipientId defaultCard+ void $ deleteRecipient recipientId+ return rcard+ result `shouldSatisfy` isRight++ it "Can update a Recipient's Card" $ do+ result <- stripe $ do+ Recipient{..} <- createRecipient name Individual -&- debitinfo+ let (Id cardid) = fromJust recipientDefaultCard+ rcard@RecipientCard{..} <-+ updateRecipientCard recipientId cardid+ -&- cardname+ -&- cardcity+ -&- cardcountry+ -&- cardaddressOne+ -&- cardaddressTwo+ -&- cardaddressState+ -&- cardzip+ void $ deleteRecipient recipientId+ return rcard+ result `shouldSatisfy` isRight+ let Right RecipientCard{..} = result+ recipientCardName `shouldBe` (Just cardname)+ recipientCardAddressCity `shouldBe` (Just cardcity)+ recipientCardAddressCountry `shouldBe` (Just cardcountry)+ recipientCardAddressLine1 `shouldBe` (Just cardaddressOne)+ recipientCardAddressLine2 `shouldBe` (Just cardaddressTwo)+ recipientCardAddressState `shouldBe` (Just cardaddressState)+ recipientCardAddressZip `shouldBe` (Just cardzip)++ it "Fails to add a Credit Card to a Recipient" $ do+ result <- stripe $ do+ r <- createRecipient name Individual -&- cardinfo+ void $ deleteRecipient (recipientId r)+ return r+ result `shouldSatisfy` isLeft++ where+ cardinfo = (mkNewCard credit em ey) { newCardCVC = Just cvc }+ debitinfo = (mkNewCard debit em ey) { newCardCVC = Just cvc }+ credit = CardNumber "4242424242424242"+ debit = CardNumber "4000056655665556"+ em = ExpMonth 12+ ey = ExpYear 2020+ cvc = CVC "123"+ country = Country "US"+ routingnumber = RoutingNumber "110000000"+ accountnumber = AccountNumber "000123456789"+ name = Name "David Johnson"+ cardname = Name "cardName"+ cardcity = AddressCity "Chicago"+ cardcountry = AddressCountry "US"+ cardaddressOne = AddressLine1 "123 Fake Street"+ cardaddressTwo = AddressLine2 "456 Fake Street"+ cardaddressState = AddressState "IL"+ cardzip = AddressZip "60610"
+ tests/Web/Stripe/Test/Charge.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE RecordWildCards #-}+module Web.Stripe.Test.Charge where++import Data.Either+import Test.Hspec+import Web.Stripe.Charge+import Web.Stripe.Customer+import Web.Stripe.Test.Prelude++chargeTests :: StripeSpec+chargeTests stripe =+ describe "Charge tests" $ do+ chargeCustomerTest+ retrieveChargeTest+ updateChargeTest+ retrieveExpandedChargeTest+ retrieveAllChargesTest+ captureChargeTest+ where+ cn = CardNumber "4242424242424242"+ em = ExpMonth 12+ ey = ExpYear 2020+ cvc = CVC "123"+ cardinfo = (mkNewCard cn em ey) { newCardCVC = Just cvc }+ chargeCustomerTest =+ it "Charges a customer succesfully" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer -&- cardinfo+ charge <- createCharge (Amount 100) USD -&- cid+ void $ deleteCustomer cid+ return charge+ result `shouldSatisfy` isRight+ retrieveChargeTest =+ it "Retrieves a charge succesfully" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer -&- cardinfo+ Charge { chargeId = chid } <- createCharge (Amount 100) USD -&- cid+ result <- getCharge chid+ void $ deleteCustomer cid+ return result+ result `shouldSatisfy` isRight+ updateChargeTest =+ it "Updates a charge succesfully" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer -&- cardinfo+ Charge { chargeId = chid } <- createCharge (Amount 100) USD -&- cid+ _ <- updateCharge chid+ -&- Description "Cool"+ -&- MetaData [("hi", "there")]+ result <- getCharge chid+ void $ deleteCustomer cid+ return result+ result `shouldSatisfy` isRight+ let Right Charge { chargeMetaData = cmd, chargeDescription = desc } = result+ cmd `shouldBe` (MetaData [("hi", "there")])+ desc `shouldSatisfy` (==(Just $ Description "Cool"))+ retrieveExpandedChargeTest =+ it "Retrieves an expanded charge succesfully" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer -&- cardinfo+ Charge { chargeId = chid } <- createCharge (Amount 100) USD -&- cid+ result <- getCharge chid+ -&- ExpandParams [ "balance_transaction"+ , "customer"+ , "invoice"+ ]+ void $ deleteCustomer cid+ return result+ result `shouldSatisfy` isRight+ retrieveAllChargesTest =+ it "Retrieves all charges" $ do+ result <- stripe $ do c <- getCharges+ return c+ result `shouldSatisfy` isRight+ captureChargeTest =+ it "Captures a charge - 2 Step Payment Flow" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer -&- cardinfo+ Charge { chargeId = chid } <- createCharge (Amount 100) USD+ -&- cid+ -&- (Capture False)+ result <- captureCharge chid+ void $ deleteCustomer cid+ return result+ result `shouldSatisfy` isRight+ let Right Charge { chargeCaptured = captured } = result+ captured `shouldBe` True
+ tests/Web/Stripe/Test/Config.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RankNTypes #-}+module Web.Stripe.Test.Config where++import qualified Data.ByteString.Char8 as B8+import Control.Applicative ((<$>))++import Web.Stripe.Client+import Web.Stripe.Balance+import System.Exit+import System.Environment+import Web.Stripe.Test.Prelude (Stripe, stripeLift)++getConfig :: (forall a. StripeConfig -> Stripe a -> IO (Either StripeError a)) -> IO StripeConfig+getConfig stripe = maybe enterKey foundKey =<< lookupEnv "STRIPEKEY"+ where+ foundKey = return . StripeConfig . StripeKey . B8.pack+ enterKey = do+ putStrLn "Please enter your Stripe *TEST* account"+ config <- StripeConfig . StripeKey. B8.pack <$> getLine+ result <- stripe config (stripeLift getBalance)+ case result of+ Left err -> print err >> exitFailure+ Right Balance{..} ->+ case balanceLiveMode of+ False -> return config+ True -> do putStrLn "You entered your production credentials, woops :)" + exitFailure++
+ tests/Web/Stripe/Test/Coupon.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RebindableSyntax #-}+module Web.Stripe.Test.Coupon where++import Data.Either+import Test.Hspec+import Web.Stripe.Test.Prelude+import Web.Stripe.Test.Util+import Web.Stripe.Coupon++couponTests :: StripeSpec+couponTests stripe = do+ describe "Coupon tests" $ do+ it "Succesfully create a coupon" $ do+ couponName <- makeCouponId+ result <- stripe $ do+ c@(Coupon { couponId = cid }) <-+ createCoupon (Just couponName) Once+ -&- (AmountOff 1)+ -&- USD+ void $ deleteCoupon cid+ return c+ result `shouldSatisfy` isRight++ it "Succesfully retrieve a coupon" $ do+ couponName <- makeCouponId+ result <- stripe $ do+ Coupon { couponId = cid } <-+ createCoupon (Just couponName)+ Once+ -&- (AmountOff 1)+ -&- USD+ res <- getCoupon cid+ void $ deleteCoupon cid+ return res+ result `shouldSatisfy` isRight+ it "Succesfully delete a coupon" $ do+ couponName <- makeCouponId+ result <- stripe $ do+ Coupon { couponId = cid } <- createCoupon+ (Just couponName)+ Once+ -&- (AmountOff 1)+ -&- USD+ void $ deleteCoupon cid+ result `shouldSatisfy` isRight++ it "Succesfully update a coupon" $ do+ couponName <- makeCouponId+ result <- stripe $ do+ Coupon { couponId = cid } <- createCoupon+ (Just couponName)+ Once+ -&-(AmountOff 1)+ -&- USD+ r <- updateCoupon cid -&- MetaData [("hi", "there")]+ void $ deleteCoupon cid+ return r+ result `shouldSatisfy` isRight+ let Right (Coupon { couponMetaData = cmd }) = result+ cmd `shouldBe` (MetaData [("hi", "there")])++ it "Succesfully retrieves all coupons" $ do+ result <- stripe $ do void $ getCoupons+ result `shouldSatisfy` isRight+
+ tests/Web/Stripe/Test/Customer.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RebindableSyntax #-}+module Web.Stripe.Test.Customer where+import Data.Either+import Data.Maybe+import Test.Hspec+import Web.Stripe.Test.Prelude+import Web.Stripe.Customer++customerTests :: StripeSpec+customerTests stripe =+ describe "Customer tests" $ do+ it "Creates an empty customer" $ do+ result <- stripe $ do+ c@Customer{..} <- createCustomer+ _ <- deleteCustomer customerId+ return c+ result `shouldSatisfy` isRight+ it "Deletes a customer" $ do+ result <- stripe $ do+ c@Customer{..} <- createCustomer+ _ <- deleteCustomer customerId+ return c+ result `shouldSatisfy` isRight+ it "Gets a customer" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer+ customer <- getCustomer cid+ _ <- deleteCustomer cid+ return customer+ result `shouldSatisfy` isRight+ it "Gets a customer expandable" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer+ customer <- getCustomer cid -&- ExpandParams ["default_card"]+ _ <- deleteCustomer cid+ return customer+ result `shouldSatisfy` isRight+ it "Gets customers" $ do+ result <- stripe $ void $ getCustomers -&- Limit 100+ result `shouldSatisfy` isRight+ it "Gets customers expandable" $ do+ result <- stripe $ void $ getCustomers+ -&- ExpandParams ["data.default_card"]+ result `shouldSatisfy` isRight+ it "Updates a customer" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer+ customer <- updateCustomer cid+ -&- bal+ -&- desc+ -&- email+ -&- meta+ _ <- deleteCustomer cid+ return customer+ result `shouldSatisfy` isRight+ let Right Customer{..} = result+ (AccountBalance customerAccountBalance) `shouldBe` bal+ customerDescription `shouldBe` (Just desc)+ customerEmail `shouldBe` (Just email)+ customerMetaData `shouldBe` meta+ where+ bal = AccountBalance 100+ desc = Description "hey"+ email = Email "djohnson.m@gmail.com"+ meta = MetaData [("hey","there")]++
+ tests/Web/Stripe/Test/Discount.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RebindableSyntax #-}+module Web.Stripe.Test.Discount where++import Data.Either+import Test.Hspec+import Web.Stripe.Test.Util+import Web.Stripe.Test.Prelude++import Web.Stripe.Coupon+import Web.Stripe.Customer+import Web.Stripe.Discount+import Web.Stripe.Plan+import Web.Stripe.Subscription++discountTests :: StripeSpec+discountTests stripe = do+ describe "Discount tests" $ do+ it "Succesfully deletes a discount from a Customer" $ do+ coupon <- makeCouponId+ result <- stripe $ do+ Coupon { couponId = couponid } <-+ createCoupon+ (Just coupon)+ Once+ -&- (AmountOff 1)+ -&- USD+ Customer { customerId = customerid } <-+ createCustomer -&- couponid+ r <- deleteCustomerDiscount customerid+ c <- getCustomer customerid+ void $ deleteCustomer customerid+ void $ deleteCoupon couponid+ return (r,c)+ result `shouldSatisfy` isRight+ let Right (_, Customer{..}) = result+ customerDiscount `shouldBe` Nothing+ it "Succesfully deletes a discount from a Subscription" $ do+ coupon <- makeCouponId+ plan <- makePlanId+ result <- stripe $ do+ Plan { planId = planid } <-+ createPlan plan+ (Amount 0) -- free plan+ USD+ Month+ (PlanName "sample plan")+ Coupon { couponId = couponid } <-+ createCoupon+ (Just coupon)+ Once+ -&- (AmountOff 1)+ -&- USD+ Customer { customerId = customerid } <-+ createCustomer+ -&- coupon+ Subscription { subscriptionId = sid } <-+ createSubscription customerid plan+ void $ updateSubscription customerid sid -&- coupon+ result <- deleteSubscriptionDiscount customerid sid+ void $ deletePlan planid+ void $ deleteCustomer customerid+ void $ deleteCoupon couponid+ return result+ result `shouldSatisfy` isRight++++
+ tests/Web/Stripe/Test/Dispute.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE RecordWildCards #-}+module Web.Stripe.Test.Dispute where++import Control.Concurrent (threadDelay)+import Data.Either (Either (Right), isRight)++import Test.Hspec+import Web.Stripe.Test.Prelude+import Web.Stripe.Test.Util++import Web.Stripe.Charge+import Web.Stripe.Customer+import Web.Stripe.Dispute++disputeTests :: StripeSpec+disputeTests stripe = do+ describe "Dispute Tests" $ do+ it "Creates a Dispute" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer -&- cardinfo+ Charge { chargeId = chid } <- createCharge (Amount 100) USD -&- cid+ liftIO $ threadDelay (secs 20) -- Sleep to allow the thread to dispute to happen+ Charge { chargeDispute = cd } <- getCharge chid+ void $ deleteCustomer cid+ return cd+ result `shouldSatisfy` isRight+ let Right (Just Dispute{..}) = result+ disputeStatus `shouldBe` NeedsResponse++ it "Makes Dispute Under Review" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer -&- cardinfo+ Charge { chargeId = chid } <- createCharge (Amount 100) USD -&- cid+ liftIO $ threadDelay (secs 10)+ void $ updateDispute chid -&- evi -&- meta+ liftIO $ threadDelay (secs 10)+ Charge { chargeDispute = Just dispute } <- getCharge chid+ void $ deleteCustomer cid+ return dispute+ result `shouldSatisfy` isRight+ let Right Dispute {..} = result+ disputeMetaData `shouldBe` meta+ disputeEvidence `shouldBe` (Just evi)+ disputeStatus `shouldBe` UnderReview+ it "Wins a Dispute" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer -&- cardinfo+ Charge { chargeId = chid } <- createCharge (Amount 100) USD -&- cid+ liftIO $ threadDelay (secs 10)+ void $ updateDispute chid -&- win -&- meta+ liftIO $ threadDelay (secs 10)+ Charge { chargeDispute = Just dispute } <- getCharge chid+ void $ deleteCustomer cid+ return dispute+ result `shouldSatisfy` isRight+ let Right Dispute {..} = result+ disputeMetaData `shouldBe` meta+ disputeEvidence `shouldBe` (Just win)+ disputeStatus `shouldBe` Won+ it "Loses a Dispute" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer -&- cardinfo+ Charge { chargeId = chid } <- createCharge (Amount 100) USD -&- cid+ liftIO $ threadDelay (secs 10) -- Sleep to allow the thread to dispute to happen+ void $ updateDispute chid -&- lose -&- meta+ liftIO $ threadDelay (secs 10)+ Charge { chargeDispute = Just dispute } <- getCharge chid+ void $ deleteCustomer cid+ return dispute+ result `shouldSatisfy` isRight+ let Right Dispute {..} = result+ disputeMetaData `shouldBe` meta+ disputeEvidence `shouldBe` (Just lose)+ disputeStatus `shouldBe` Lost+ it "Closes a Dispute" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer -&- cardinfo+ Charge { chargeId = chid } <- createCharge (Amount 100) USD -&- cid+ liftIO $ threadDelay (secs 10) -- Sleep to allow the thread to dispute to happen+ dispute <- closeDispute chid+ void $ deleteCustomer cid+ return dispute+ result `shouldSatisfy` isRight+ let Right Dispute {..} = result+ disputeStatus `shouldBe` Lost+ where+ cn = CardNumber "4000000000000259"+ em = ExpMonth 12+ ey = ExpYear 2020+ cvc = CVC "123"+ win = Evidence "winning_evidence"+ lose = Evidence "losing_evidence"+ evi = Evidence "some evidence"+ meta = MetaData [ ("some", "metadata") ]+ cardinfo =+ (mkNewCard cn em ey) { newCardCVC = Just cvc }
+ tests/Web/Stripe/Test/Event.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RebindableSyntax #-}+module Web.Stripe.Test.Event where++import Data.Either+import Test.Hspec+import Web.Stripe.Test.Prelude+import Web.Stripe.Event++eventTests :: StripeSpec+eventTests stripe = do+ describe "Event tests" $ do+ it "Succesfully retrieves events" $ do+ result <- stripe $ void $ getEvents+ result `shouldSatisfy` isRight
+ tests/Web/Stripe/Test/Invoice.hs view
@@ -0,0 +1,120 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE RecordWildCards #-}+module Web.Stripe.Test.Invoice where++import Data.Either+import Test.Hspec+import Web.Stripe.Customer+import Web.Stripe.Invoice+import Web.Stripe.InvoiceItem+import Web.Stripe.Plan+import Web.Stripe.Test.Prelude+import Web.Stripe.Test.Util++invoiceTests :: StripeSpec+invoiceTests stripe = do+ describe "Invoice tests" $ do+ it "Create an Invoice via Invoice item on a Customer" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer+ InvoiceItem { invoiceItemId = iiid } <- createInvoiceItem cid (Amount 100) USD+ i <- createInvoice cid -&- meta+ void $ deleteInvoiceItem iiid+ void $ deleteCustomer cid+ return i+ result `shouldSatisfy` isRight+ it "Retrieve an Invoice" $ do+ planid <- makePlanId+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer+ Plan { planId = pid} <- createPlan planid (Amount 20) USD Day (PlanName "testplan")+ InvoiceItem { invoiceItemId = iiid } <- createInvoiceItem cid (Amount 100) USD+ Invoice { invoiceId = Just iid } <- createInvoice cid -&- meta+ i <- getInvoice iid+ void $ deleteInvoiceItem iiid+ void $ deletePlan pid+ void $ deleteCustomer cid+ return i+ result `shouldSatisfy` isRight+ it "Retrieve an Invoice Expanded" $ do+ planid <- makePlanId+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer+ Plan { planId = pid} <- createPlan planid (Amount 20) USD Day (PlanName "testplan")+ InvoiceItem { invoiceItemId = iiid } <- createInvoiceItem cid (Amount 100) USD+ Invoice { invoiceId = Just iid } <- createInvoice cid -&- meta+ i <- getInvoice iid -&- ExpandParams ["customer", "charge"]+ void $ deleteInvoiceItem iiid+ void $ deletePlan pid+ void $ deleteCustomer cid+ return i+ result `shouldSatisfy` isRight+ it "Retrieve an Invoice's Line Items" $ do+ planid <- makePlanId+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer+ Plan { planId = pid } <- createPlan planid (Amount 20) USD Day (PlanName "testplan")+ InvoiceItem { invoiceItemId = iiid } <- createInvoiceItem cid (Amount 100) USD+ Invoice { invoiceId = Just iid } <- createInvoice cid -&- meta+ i <- getInvoiceLineItems iid+ void $ deleteInvoiceItem iiid+ void $ deletePlan pid+ void $ deleteCustomer cid+ return i+ result `shouldSatisfy` isRight+ it "Retrieve Invoices" $ do+ result <- stripe $ void $ getInvoices+ result `shouldSatisfy` isRight+ it "Retrieve Invoices Expandable" $ do+ result <- stripe $ void $ getInvoices+ -&- ExpandParams ["data.customer", "data.charge"]+ result `shouldSatisfy` isRight+ it "Updates an Invoice" $ do+ planid <- makePlanId+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer+ Plan { planId = pid } <- createPlan planid (Amount 20) USD Day (PlanName "testplan")+ InvoiceItem { invoiceItemId = iiid } <- createInvoiceItem cid (Amount 100) USD+ Invoice { invoiceId = Just iid } <- createInvoice cid -&- meta+ i <- updateInvoice iid -&- (MetaData [("some", "thing")])+ void $ deleteInvoiceItem iiid+ void $ deletePlan pid+ void $ deleteCustomer cid+ return i+ result `shouldSatisfy` isRight+ let Right Invoice {..} = result+ invoiceMetaData `shouldBe` (MetaData [("some", "thing")])+ it "Retrieve an Upcoming Invoice" $ do+ planid <- makePlanId+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer+ Plan { planId = pid } <- createPlan planid (Amount 20) USD Day (PlanName "testplan")+ InvoiceItem { invoiceItemId = iiid } <- createInvoiceItem cid (Amount 100) USD+ i <- getUpcomingInvoice cid+ void $ deleteInvoiceItem iiid+ void $ deletePlan pid+ void $ deleteCustomer cid+ return i+ result `shouldSatisfy` isRight+ it "Pay an Invoice" $ do+ planid <- makePlanId+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer -&- cardinfo+ Plan { planId = pid } <- createPlan planid (Amount 20) USD Day (PlanName "testplan")+ InvoiceItem { } <- createInvoiceItem cid (Amount 100) USD+ Invoice { invoiceId = Just iid } <- createInvoice cid -&- meta+ i <- payInvoice iid+ void $ deletePlan pid+ void $ deleteCustomer cid+ return i+ result `shouldSatisfy` isRight+ let Right Invoice{..} = result+ invoicePaid `shouldBe` True+ where+ cardinfo = (mkNewCard credit em ey) { newCardCVC = Just cvc }+ meta = MetaData [ ("some","metadata") ]+ credit = CardNumber "4242424242424242"+ em = ExpMonth 12+ ey = ExpYear 2020+ cvc = CVC "123"
+ tests/Web/Stripe/Test/InvoiceItem.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RebindableSyntax #-}+module Web.Stripe.Test.InvoiceItem where++import Data.Either++import Test.Hspec+import Web.Stripe.Test.Prelude++import Web.Stripe.InvoiceItem+import Web.Stripe.Customer++invoiceItemTests :: StripeSpec+invoiceItemTests stripe = do+ describe "Invoice item tests" $ do+ it "Succesfully creates an invoice item" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer+ ii <- createInvoiceItem cid (Amount 100) USD+ -&- (Description "hey")+ _ <- deleteCustomer cid+ return ii+ result `shouldSatisfy` isRight+ it "Succesfully retrieves an existing invoice item" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer+ InvoiceItem { invoiceItemId = iid } <-+ createInvoiceItem cid (Amount 100) USD -&- (Description "hey")+ ii <- getInvoiceItem iid+ _ <- deleteCustomer cid+ return ii+ result `shouldSatisfy` isRight+ it "Succesfully retrieves an existing invoice item expandable" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer+ InvoiceItem { invoiceItemId = iid } <-+ createInvoiceItem cid (Amount 100) USD -&- (Description "hey")+ ii <- getInvoiceItem iid -&- ExpandParams ["customer"]+ _ <- deleteCustomer cid+ return ii+ result `shouldSatisfy` isRight+ it "Succesfully retrieves invoice items" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer+ InvoiceItem { } <-+ createInvoiceItem cid (Amount 100) USD -&- (Description "hey")+ ii <- getInvoiceItems+ _ <- deleteCustomer cid+ return ii+ result `shouldSatisfy` isRight+ it "Succesfully retrieves invoice items with expansion" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer+ InvoiceItem { } <-+ createInvoiceItem cid (Amount 100) USD -&- (Description "hey")+ ii <- getInvoiceItems -&- ExpandParams ["data.customer"]+ _ <- deleteCustomer cid+ return ii+ result `shouldSatisfy` isRight+ it "Succesfully updates an existing invoice item" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer+ InvoiceItem { invoiceItemId = iid } <-+ createInvoiceItem cid (Amount 100) USD+ -&- (Description "hey")+ ii <- updateInvoiceItem iid+ -&- (Amount 200)+ -&- (Description "description")+ -&- MetaData [("some","thing")]+ _ <- deleteCustomer cid+ return ii+ result `shouldSatisfy` isRight+ let Right InvoiceItem{..} = result+ invoiceItemMetaData `shouldBe` (MetaData [("some","thing")])+ invoiceItemDescription `shouldBe` (Just (Description "description"))+ invoiceItemAmount `shouldBe` 200+ it "Succesfully deletes an invoice item" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer+ InvoiceItem { invoiceItemId = iid } <-+ createInvoiceItem cid (Amount 100) USD+ -&- (Description "hey")+ result <- deleteInvoiceItem iid+ _ <- deleteCustomer cid+ return result+ result `shouldSatisfy` isRight
+ tests/Web/Stripe/Test/Plan.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RebindableSyntax #-}+module Web.Stripe.Test.Plan where++import Data.Either (Either(..), isRight)+import Test.Hspec+import Web.Stripe.Test.Util (makePlanId)+import Web.Stripe.Test.Prelude++import Web.Stripe.Plan+import Web.Stripe.Customer++planTests :: StripeSpec+planTests stripe = do+ describe "Plan tests" $ do+ it "Succesfully creates a Plan" $ do+ planid <- makePlanId+ result <- stripe $ do+ p <- createPlan planid+ (Amount 0) -- free plan+ USD+ Month+ (PlanName "sample plan")+ void $ deletePlan planid+ return p+ result `shouldSatisfy` isRight+ it "Succesfully deletes a Plan" $ do+ planid <- makePlanId+ result <- stripe $ do+ Plan { planId = pid } <-+ createPlan planid+ (Amount 0) -- free plan+ USD+ Month+ (PlanName "sample plan")+ void $ deletePlan pid+ result `shouldSatisfy` isRight+ it "Succesfully updates a Plan" $ do+ planid <- makePlanId+ result <- stripe $ do+ Plan { planId = pid } <-+ createPlan planid+ (Amount 0) -- free plan+ USD+ Month+ (PlanName "sample plan")+ r <- updatePlan pid+ -&- (PlanName "cookie")+ -&- (StatementDescription "test")+ -&- MetaData [("key","value")]+ void $ deletePlan pid+ return r+ result `shouldSatisfy` isRight+ let Right Plan { planMetaData = pm+ , planName = pname+ , planDescription = pdesc+ } = result+ pm `shouldBe` (MetaData [("key", "value")])+ pname `shouldBe` "cookie"+ pdesc `shouldBe` (Just $ StatementDescription "test")+ it "Succesfully retrieves a Plan" $ do+ planid <- makePlanId+ result <- stripe $ do+ Plan { planId = pid } <-+ createPlan planid+ (Amount 0) -- free plan+ USD+ Month+ (PlanName "sample plan")+ r <- getPlan pid+ void $ deletePlan pid+ return r+ result `shouldSatisfy` isRight+ it "Succesfully retrieves a list of Plans" $ do+ result <- stripe $ void $ getPlans+ result `shouldSatisfy` isRight
+ tests/Web/Stripe/Test/Prelude.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE RankNTypes #-}+module Web.Stripe.Test.Prelude+ ( ($)+ , (-&-)+ , Char+ , Functor+ , IO+ , String+ , error+ , module GHC.Num+ , id+ , (.)+ , length+ , undefined+ , return+ , (>>=)+ , (>>)+ , fail+ , void+ , liftIO+ , fromString+ , stripeLift+ , module Test.Hspec+ , Eq(..)+ , Bool(..)+ , Maybe(..)+ , Stripe+ , StripeRequestF(..)+ , StripeSpec+ ) where++import Data.Aeson (Value, Result(..), FromJSON, fromJSON)+import Data.Either (Either)+import Data.String (fromString)+import Data.Maybe (Maybe(..))+import GHC.Num (fromInteger)+import Prelude (Bool(..), Eq(..), Functor(..), ($), IO, Char, String, error, undefined, (.), id, length)+import Test.Hspec+import Test.Hspec.Core.Spec (SpecM)+import qualified Control.Monad as M+import qualified Control.Monad.Trans as M+import Control.Monad.Trans.Free (FreeT(..), liftF)+import Web.Stripe.Client++------------------------------------------------------------------------------+-- Stripe free monad++data StripeRequestF ret = forall req. StripeRequestF+ { getStripeRequest :: StripeRequest req+ , decode :: Value -> Result ret+ }++instance Functor StripeRequestF where+ fmap f (StripeRequestF req d) = StripeRequestF req (fmap f . d)++toStripeRequestF+ :: (FromJSON ret, StripeReturn req ~ ret)+ => StripeRequest req+ -> StripeRequestF ret+toStripeRequestF (StripeRequest m e q) =+ StripeRequestF (StripeRequest m e q) fromJSON++type Stripe = FreeT StripeRequestF IO+type StripeSpec = (forall a. Stripe a -> IO (Either StripeError a)) -> Spec++------------------------------------------------------------------------------+-- A class which lifts 'StripeRequest a' to the 'Stripe' monad and+-- leaves everything else alone.+--+class StripeLift a where+ type LiftedType a+ stripeLift :: a -> (LiftedType a)++instance (FromJSON (StripeReturn req)) => StripeLift (StripeRequest req) where+ type LiftedType (StripeRequest req) = Stripe (StripeReturn req)+ stripeLift req = liftF $ toStripeRequestF req++instance StripeLift (Stripe a) where+ type LiftedType (Stripe a) = Stripe a+ stripeLift = id++instance StripeLift (IO a) where+ type LiftedType (IO a) = IO a+ stripeLift = id++instance StripeLift (SpecM a r) where+ type LiftedType (SpecM a r) = SpecM a r+ stripeLift = id++------------------------------------------------------------------------------+-- hack the do-syntax and related functions to automatically turn+-- StripeReq values into monadic functions.+--+-- This is useful in the test suite where we a running a bunch of+-- back-to-back stripe transactions with little business logic in+-- between.++(>>=) :: (StripeLift t, M.Monad m, LiftedType t ~ m a) =>+ t -> (a -> m b) -> m b+m >>= f = (stripeLift m) M.>>= f++(>>) :: (StripeLift t, M.Monad m, LiftedType t ~ m a) => t -> m b -> m b+(>>) m n = m >>= \_ -> n++void :: (FromJSON (StripeReturn a)) => StripeRequest a -> Stripe ()+void req = M.void (stripeLift req)++fail :: (M.Monad m) => String -> m a+fail = M.fail++return :: (M.Monad m) => a -> m a+return = M.return++liftIO :: IO a -> Stripe a+liftIO io = M.liftIO io
+ tests/Web/Stripe/Test/Recipient.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RebindableSyntax #-}+module Web.Stripe.Test.Recipient where++import Data.Either+import Test.Hspec+import Web.Stripe.Test.Prelude+import Web.Stripe.Recipient++recipientTests :: StripeSpec+recipientTests stripe = do+ describe "Recipient tests" $ do+ it "Succesfully creates an Individual Recipient" $ do+ result <- stripe $ do+ recipient@Recipient { recipientId = rid } <- createRecipient+ name+ Individual+ void $ deleteRecipient rid+ return recipient+ result `shouldSatisfy` isRight+ let Right Recipient {..} = result+ recipientType `shouldBe` Individual+ it "Succesfully creates a Corporation Recipient" $ do+ result <- stripe $ do+ recipient@Recipient { recipientId = rid } <-+ createRecipient+ name+ Corporation+ void $ deleteRecipient rid+ return recipient+ result `shouldSatisfy` isRight+ let Right Recipient {..} = result+ recipientType `shouldBe` Corporation+ it "Succesfully retrieves a Recipient" $ do+ result <- stripe $ do+ Recipient { recipientId = rid } <-+ createRecipient+ name+ Corporation+ recipient <- getRecipient rid+ void $ deleteRecipient rid+ return recipient+ result `shouldSatisfy` isRight+ let Right Recipient {..} = result+ recipientType `shouldBe` Corporation+ it "Succesfully retrieves a Recipient" $ do+ result <- stripe $ do+ Recipient { recipientId = rid } <-+ createRecipient+ name+ Corporation+ recipient <- getRecipient rid+ void $ deleteRecipient rid+ return recipient+ result `shouldSatisfy` isRight+ let Right Recipient {..} = result+ recipientType `shouldBe` Corporation+ it "Succesfully updates a Recipient" $ do+ result <- stripe $ do+ Recipient { recipientId = rid } <-+ createRecipient+ name+ Corporation+ recipient <- updateRecipient rid+ -&- (Name "David R. Johnson")+ -&- taxid+ -&- (NewBankAccount country routingnumber accountnumber)+ -&- email+ -&- description+ -&- meta+ void $ deleteRecipient rid+ return recipient+ result `shouldSatisfy` isRight+ let Right Recipient {..} = result+ recipientType `shouldBe` Corporation+ recipientName `shouldBe` (Name "David R. Johnson")+ recipientDescription `shouldBe` (Just description)+ recipientEmail `shouldBe` (Just email)+ it "Succesfully deletes a Recipient" $ do+ result <- stripe $ do+ Recipient { recipientId = rid } <-+ createRecipient+ name+ Corporation+ void $ deleteRecipient rid+ result `shouldSatisfy` isRight+ where name = Name "David M. Johnson"+ meta = MetaData [("this", "thing")]+ email = Email "djohnson.m@gmail.com"+ country = Country "US"+ description = Description "description"+ routingnumber = RoutingNumber "110000000"+ accountnumber = AccountNumber "000123456789"+ taxid = TaxID "000000000"
+ tests/Web/Stripe/Test/Refund.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE RecordWildCards #-}+module Web.Stripe.Test.Refund where++import Data.Either+import Test.Hspec+import Web.Stripe.Charge+import Web.Stripe.Customer+import Web.Stripe.Refund+import Web.Stripe.Test.Prelude++------------------------------------------------------------------------------+-- | Card Info+cn :: CardNumber+cn = CardNumber "4242424242424242"++em :: ExpMonth+em = ExpMonth 12++ey :: ExpYear+ey = ExpYear 2020++cvc :: CVC+cvc = CVC "123"++cardinfo :: NewCard+cardinfo = (mkNewCard cn em ey) { newCardCVC = Just cvc }++------------------------------------------------------------------------------+-- | Refund Tests+refundTests :: StripeSpec+refundTests stripe = do+ describe "Refund Tests" $ do+ it "Creates a refund succesfully" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer -&- cardinfo+ Charge { chargeId = chid } <- createCharge (Amount 100) USD -&- cid+ refund <- createRefund chid+ void $ deleteCustomer cid+ return refund+ result `shouldSatisfy` isRight+ it "Retrieves a refund succesfully" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer -&- cardinfo+ Charge { chargeId = chid } <- createCharge (Amount 100) USD -&- cid+ Refund { refundId = rid } <- createRefund chid+ void $ deleteCustomer cid+ void $ getRefund chid rid+ result `shouldSatisfy` isRight+ it "Retrieves a refund succesfully with expansion" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer -&- cardinfo+ Charge { chargeId = chid } <- createCharge (Amount 100) USD -&- cid+ Refund { refundId = rid } <- createRefund chid+ r <- getRefund chid rid -&- ExpandParams ["balance_transaction"]+ void $ deleteCustomer cid+ return r+ result `shouldSatisfy` isRight+ it "Updates a refund succesfully" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer -&- cardinfo+ Charge { chargeId = chid } <- createCharge (Amount 100) USD -&- cid+ Refund { refundId = rid } <- createRefund chid+ ref <- updateRefund chid rid -&- (MetaData [("hello","there")])+ void $ deleteCustomer cid+ return ref+ result `shouldSatisfy` isRight+ let Right Refund{..} = result+ refundMetaData `shouldBe` (MetaData [("hello","there")])+ it "Retrieves all refunds for a Charge" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer -&- cardinfo+ Charge { chargeId = chid } <- createCharge (Amount 100) USD -&- cid+ Refund { } <- createRefund chid+ r <- getRefunds chid+ void $ deleteCustomer cid+ return r+ result `shouldSatisfy` isRight+ let Right StripeList {..} = result+ length list `shouldBe` 1+ it "Retrieves all refunds for a Charge with expansion" $ do+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer -&- cardinfo+ Charge { chargeId = chid } <- createCharge (Amount 100) USD -&- cid+ Refund { } <- createRefund chid+ r <- getRefunds chid -&- ExpandParams ["data.balance_transaction"]+ void $ deleteCustomer cid+ return r+ result `shouldSatisfy` isRight+ let Right StripeList {..} = result+ length list `shouldBe` 1
+ tests/Web/Stripe/Test/Subscription.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RebindableSyntax #-}+module Web.Stripe.Test.Subscription where++import Data.Either+import Data.Maybe++import Test.Hspec+import Web.Stripe.Test.Prelude+import Web.Stripe.Test.Util++import Web.Stripe.Subscription+import Web.Stripe.Customer+import Web.Stripe.Plan+import Web.Stripe.Coupon++subscriptionTests :: StripeSpec+subscriptionTests stripe = do+ describe "Subscription tests" $ do+ it "Succesfully creates a Subscription" $ do+ planid <- makePlanId+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer+ void $ createPlan planid+ (Amount 0) -- free plan+ USD+ Month+ (PlanName "sample plan")+ sub <- createSubscription cid planid+ void $ deletePlan planid+ void $ deleteCustomer cid+ return sub+ result `shouldSatisfy` isRight+ it "Succesfully retrieves a Subscription" $ do+ planid <- makePlanId+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer+ void $ createPlan planid+ (Amount 0) -- free plan+ USD+ Month+ (PlanName "sample plan")+ Subscription { subscriptionId = sid } <- createSubscription cid planid+ sub <- getSubscription cid sid+ void $ deletePlan planid+ void $ deleteCustomer cid+ return sub+ result `shouldSatisfy` isRight+ it "Succesfully retrieves a Subscription expanded" $ do+ planid <- makePlanId+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer+ void $ createPlan planid+ (Amount 0) -- free plan+ USD+ Month+ (PlanName "sample plan")+ Subscription { subscriptionId = sid } <- createSubscription cid planid+ sub <- getSubscription cid sid -&- ExpandParams ["customer"]+ void $ deletePlan planid+ void $ deleteCustomer cid+ return sub+ result `shouldSatisfy` isRight+ it "Succesfully retrieves a Customer's Subscriptions expanded" $ do+ planid <- makePlanId+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer+ void $ createPlan planid+ (Amount 0) -- free plan+ USD+ Month+ (PlanName "sample plan")+ void $ createSubscription cid planid+ sub <- getSubscriptions cid -&- ExpandParams ["data.customer"]+ void $ deletePlan planid+ void $ deleteCustomer cid+ return sub+ result `shouldSatisfy` isRight+ it "Succesfully retrieves a Customer's Subscriptions" $ do+ planid <- makePlanId+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer+ void $ createPlan planid+ (Amount 0) -- free plan+ USD+ Month+ (PlanName "sample plan")+ void $ createSubscription cid planid+ sub <- getSubscriptions cid+ void $ deletePlan planid+ void $ deleteCustomer cid+ return sub+ result `shouldSatisfy` isRight+ it "Succesfully updates a Customer's Subscriptions" $ do+ planid <- makePlanId+ secondPlanid <- makePlanId+ couponid <- makeCouponId+ result <- stripe $ do+ Coupon { } <-+ createCoupon+ (Just couponid)+ Once+ -&- (AmountOff 1)+ -&- USD+ Customer { customerId = cid } <- createCustomer+ void $ createPlan planid+ (Amount 0) -- free plan+ USD+ Month+ (PlanName "sample plan")+ Subscription { subscriptionId = sid } <- createSubscription cid planid+ sub <- updateSubscription cid sid+ -&- couponid+ -&- MetaData [("hi","there")]+ void $ deleteCustomer cid+ return sub+ result `shouldSatisfy` isRight+ let Right Subscription {..} = result+ subscriptionMetaData `shouldBe` (MetaData [("hi", "there")])+ subscriptionDiscount `shouldSatisfy` isJust+ it "Succesfully cancels a Customer's Subscription" $ do+ planid <- makePlanId+ result <- stripe $ do+ Customer { customerId = cid } <- createCustomer+ void $ createPlan planid+ (Amount 0) -- free plan+ USD+ Month+ (PlanName "sample plan")+ Subscription { subscriptionId = sid } <- createSubscription cid planid+ sub <- cancelSubscription cid sid -&- AtPeriodEnd False+ void $ deletePlan planid+ void $ deleteCustomer cid+ return sub+ result `shouldSatisfy` isRight+ let Right Subscription {..} = result+ subscriptionStatus `shouldBe` Canceled
+ tests/Web/Stripe/Test/Token.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE RecordWildCards #-}+module Web.Stripe.Test.Token where++import Data.Either+import Test.Hspec+import Web.Stripe.Test.Prelude+import Web.Stripe.Token++tokenTests :: StripeSpec+tokenTests stripe = do+ describe "Token tests" $ do+ it "Can create a Card Token" $ do+ result <- stripe $ void $ createCardToken (Just cardinfo)+ result `shouldSatisfy` isRight+ it "Can create a Bank Account Token" $ do+ result <- stripe $ void $ createBankAccountToken+ (Just bankinfo)+ result `shouldSatisfy` isRight+ it "Can retrieve an Existing Card Token" $ do+ result <- stripe $ do+ Token { tokenId = tkid } <- createCardToken (Just cardinfo)+ void $ getCardToken tkid+ result `shouldSatisfy` isRight+ it "Can retrieve an Existing Bank Account Token" $ do+ result <- stripe $ do+ Token { tokenId = tkid } <- createBankAccountToken (Just bankinfo)+ void $ getBankAccountToken tkid+ result `shouldSatisfy` isRight+ where+ cn = CardNumber "4242424242424242"+ em = ExpMonth 12+ ey = ExpYear 2020+ cvc = CVC "123"+ cardinfo = (mkNewCard cn em ey) { newCardCVC = Just cvc }+ bankinfo = NewBankAccount+ (Country "US")+ (RoutingNumber "110000000")+ (AccountNumber "000123456789")
+ tests/Web/Stripe/Test/Transfer.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RebindableSyntax #-}+module Web.Stripe.Test.Transfer where++import Data.Maybe+import Data.Either+import Data.String+import Web.Stripe.Test.Prelude++import Web.Stripe.Recipient+import Web.Stripe.Transfer++------------------------------------------------------------------------------+-- the tests++transferTests :: StripeSpec+transferTests stripe =+ describe "Transfer tests" $ do+ it "Create a new transfer" $ do+ result <- stripe $ do+ Recipient { recipientId = rid } <-+ createRecipient name Individual -&- bankinfo+ transfer <- createTransfer rid (Amount 100) USD+ void $ deleteRecipient rid+ return transfer+ result `shouldSatisfy` isRight+ it "Retrieves a transfer" $ do+ result <- stripe $ do+ Recipient { recipientId = rid } <-+ createRecipient name Individual -&- bankinfo+ Transfer { transferId = tid }+ <- createTransfer rid (Amount 100) USD+ t <- getTransfer tid+ void $ deleteRecipient rid+ return t+ result `shouldSatisfy` isRight+ it "Retrieves a transfer expandable" $ do+ result <- stripe $ do+ Recipient { recipientId = rid } <-+ createRecipient name Individual -&- bankinfo+ Transfer { transferId = tid }+ <- createTransfer rid (Amount 100) USD+ t <- getTransfer tid -&- ExpandParams ["recipient", "balance_transaction"]+ void $ deleteRecipient rid+ return t+ result `shouldSatisfy` isRight+ it "Retrieves transfers" $ do+ result <- stripe $ do t <- getTransfers+ return t+ result `shouldSatisfy` isRight+ it "Retrieves transfers expandable" $ do+ result <- stripe $ do t <- getTransfers -&- ExpandParams+ [ "data.recipient"+ , "data.balance_transaction"+ ]+ return t+ result `shouldSatisfy` isRight+ it "Updates a transfer" $ do+ result <- stripe $ do+ Recipient { recipientId = rid } <-+ createRecipient name Individual -&- bankinfo+ Transfer { transferId = tid }+ <- createTransfer rid (Amount 100) USD+ t <- updateTransfer tid+ -&- (Description "hey there")+ -&- (MetaData [("hey", "there")])+ void $ deleteRecipient rid+ return t+ result `shouldSatisfy` isRight+ let Right Transfer {..} = result+ transferMetaData `shouldBe` (MetaData [("hey", "there")])+ transferDescription `shouldBe` (Just (Description "hey there"))+ it "Can't Cancel a committed transfer" $ do+ result <- stripe $ do+ Recipient { recipientId = rid } <-+ createRecipient+ name+ Individual+ -&- bankinfo+ Transfer { transferId = tid }+ <- createTransfer rid (Amount 100) USD+ t <- cancelTransfer tid+ void $ deleteRecipient rid+ return t+ result `shouldSatisfy` isLeft+ where+ country = Country "US"+ routingnumber = RoutingNumber "110000000"+ accountnumber = AccountNumber "000123456789"+ name = Name "David Johnson"+ bankinfo = NewBankAccount country routingnumber accountnumber
+ tests/Web/Stripe/Test/Util.hs view
@@ -0,0 +1,36 @@+module Web.Stripe.Test.Util+ ( -- * Helpers+ makePlanId+ , makeCouponId+ , secs+ ) where++import System.Random+import Control.Applicative+import qualified Data.Text as T+import Data.Text (Text)+import Control.Monad++import Web.Stripe.Plan+import Web.Stripe.Coupon++------------------------------------------------------------------------------+-- | `PlanId` creation helper+makePlanId :: IO PlanId+makePlanId = PlanId <$> makeGuid++------------------------------------------------------------------------------+-- | `CouponId` creation helper+makeCouponId :: IO CouponId+makeCouponId = CouponId <$> makeGuid++------------------------------------------------------------------------------+-- | Guid Creation Helper+makeGuid :: IO Text+makeGuid = T.pack <$> replicateM 10 (randomRIO ('a', 'z'))++------------------------------------------------------------------------------+-- | Seconds+secs :: Int -> Int+secs = (*1000000)+