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/stripe-tests.cabal b/stripe-tests.cabal new file mode 100644 --- /dev/null +++ b/stripe-tests.cabal @@ -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: + . + <> + . + [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 diff --git a/tests/Web/Stripe/Test/Account.hs b/tests/Web/Stripe/Test/Account.hs new file mode 100644 --- /dev/null +++ b/tests/Web/Stripe/Test/Account.hs @@ -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 + diff --git a/tests/Web/Stripe/Test/AllTests.hs b/tests/Web/Stripe/Test/AllTests.hs new file mode 100644 --- /dev/null +++ b/tests/Web/Stripe/Test/AllTests.hs @@ -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 + + diff --git a/tests/Web/Stripe/Test/ApplicationFee.hs b/tests/Web/Stripe/Test/ApplicationFee.hs new file mode 100644 --- /dev/null +++ b/tests/Web/Stripe/Test/ApplicationFee.hs @@ -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 diff --git a/tests/Web/Stripe/Test/ApplicationFeeRefund.hs b/tests/Web/Stripe/Test/ApplicationFeeRefund.hs new file mode 100644 --- /dev/null +++ b/tests/Web/Stripe/Test/ApplicationFeeRefund.hs @@ -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 diff --git a/tests/Web/Stripe/Test/Balance.hs b/tests/Web/Stripe/Test/Balance.hs new file mode 100644 --- /dev/null +++ b/tests/Web/Stripe/Test/Balance.hs @@ -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" + diff --git a/tests/Web/Stripe/Test/Card.hs b/tests/Web/Stripe/Test/Card.hs new file mode 100644 --- /dev/null +++ b/tests/Web/Stripe/Test/Card.hs @@ -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" diff --git a/tests/Web/Stripe/Test/Charge.hs b/tests/Web/Stripe/Test/Charge.hs new file mode 100644 --- /dev/null +++ b/tests/Web/Stripe/Test/Charge.hs @@ -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 diff --git a/tests/Web/Stripe/Test/Config.hs b/tests/Web/Stripe/Test/Config.hs new file mode 100644 --- /dev/null +++ b/tests/Web/Stripe/Test/Config.hs @@ -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 + + diff --git a/tests/Web/Stripe/Test/Coupon.hs b/tests/Web/Stripe/Test/Coupon.hs new file mode 100644 --- /dev/null +++ b/tests/Web/Stripe/Test/Coupon.hs @@ -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 + diff --git a/tests/Web/Stripe/Test/Customer.hs b/tests/Web/Stripe/Test/Customer.hs new file mode 100644 --- /dev/null +++ b/tests/Web/Stripe/Test/Customer.hs @@ -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")] + + diff --git a/tests/Web/Stripe/Test/Discount.hs b/tests/Web/Stripe/Test/Discount.hs new file mode 100644 --- /dev/null +++ b/tests/Web/Stripe/Test/Discount.hs @@ -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 + + + + diff --git a/tests/Web/Stripe/Test/Dispute.hs b/tests/Web/Stripe/Test/Dispute.hs new file mode 100644 --- /dev/null +++ b/tests/Web/Stripe/Test/Dispute.hs @@ -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 } diff --git a/tests/Web/Stripe/Test/Event.hs b/tests/Web/Stripe/Test/Event.hs new file mode 100644 --- /dev/null +++ b/tests/Web/Stripe/Test/Event.hs @@ -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 diff --git a/tests/Web/Stripe/Test/Invoice.hs b/tests/Web/Stripe/Test/Invoice.hs new file mode 100644 --- /dev/null +++ b/tests/Web/Stripe/Test/Invoice.hs @@ -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" diff --git a/tests/Web/Stripe/Test/InvoiceItem.hs b/tests/Web/Stripe/Test/InvoiceItem.hs new file mode 100644 --- /dev/null +++ b/tests/Web/Stripe/Test/InvoiceItem.hs @@ -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 diff --git a/tests/Web/Stripe/Test/Plan.hs b/tests/Web/Stripe/Test/Plan.hs new file mode 100644 --- /dev/null +++ b/tests/Web/Stripe/Test/Plan.hs @@ -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 diff --git a/tests/Web/Stripe/Test/Prelude.hs b/tests/Web/Stripe/Test/Prelude.hs new file mode 100644 --- /dev/null +++ b/tests/Web/Stripe/Test/Prelude.hs @@ -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 diff --git a/tests/Web/Stripe/Test/Recipient.hs b/tests/Web/Stripe/Test/Recipient.hs new file mode 100644 --- /dev/null +++ b/tests/Web/Stripe/Test/Recipient.hs @@ -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" diff --git a/tests/Web/Stripe/Test/Refund.hs b/tests/Web/Stripe/Test/Refund.hs new file mode 100644 --- /dev/null +++ b/tests/Web/Stripe/Test/Refund.hs @@ -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 diff --git a/tests/Web/Stripe/Test/Subscription.hs b/tests/Web/Stripe/Test/Subscription.hs new file mode 100644 --- /dev/null +++ b/tests/Web/Stripe/Test/Subscription.hs @@ -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 diff --git a/tests/Web/Stripe/Test/Token.hs b/tests/Web/Stripe/Test/Token.hs new file mode 100644 --- /dev/null +++ b/tests/Web/Stripe/Test/Token.hs @@ -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") diff --git a/tests/Web/Stripe/Test/Transfer.hs b/tests/Web/Stripe/Test/Transfer.hs new file mode 100644 --- /dev/null +++ b/tests/Web/Stripe/Test/Transfer.hs @@ -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 diff --git a/tests/Web/Stripe/Test/Util.hs b/tests/Web/Stripe/Test/Util.hs new file mode 100644 --- /dev/null +++ b/tests/Web/Stripe/Test/Util.hs @@ -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) +