{-# OPTIONS_GHC -fno-warn-orphans #-}
module Main where
import Control.Monad
import qualified Data.ByteString.Lazy as B
import Test.Framework (Test, defaultMain, testGroup)
import Test.Framework.Providers.HUnit (testCase)
import Test.HUnit hiding (Test)
import Import
import PayPal.Adaptive
import qualified PayPal.Adaptive.Deposit as DP
import qualified PayPal.Adaptive.Lookup as LP
import qualified PayPal.Adaptive.Withdrawal as WD
main :: IO ()
main = defaultMain [integrationRemote]
integrationRemote :: Test
integrationRemote = testGroup "remote"
[ testCase
"withdrawal succeeds with good arguments"
correctWithdrawal
, testCase
"withdrawal with a bad account address gives the correct error"
withdrawalAccountAddressDNE
, testCase
"withdrawal with a bad user address gives the correct error"
withdrawalUserAddressDNE
, testCase
"withdrawal without a large enough balance gives the correct error"
withdrawalNotEnoughFunds
, testCase
"deposit succeeds with good arguments"
correctDepositBeginning
, testCase
"deposit with a bad account address does NOT produce an error"
depositAccountAddressDNE
, testCase
"deposit with a bad user address gives the correct error"
depositUserAddressDNE
]
newtype TestSettings = TestSettings { _unTestSettings :: (Client, Text, Text) }
instance FromJSON TestSettings where
parseJSON = withObject "TestSettings" $ \o -> do
client <- o .: "client"
userEmail <- (.: "email_with_paypal_account") =<< o .: "other"
nonSandboxEmail <- (.: "email_without_paypal_account") =<< o .: "other"
return $ TestSettings (client,userEmail,nonSandboxEmail)
config :: IO (Client, Text, Text)
config = fmap _unTestSettings . assertRight . eitherDecode =<< B.readFile "sandbox.json"
incorrectEmailClient :: Text -> Client -> Client
incorrectEmailClient badAccountEmail (Client a b c d e _) = Client a b c d e badAccountEmail
withdrawal :: Text -> WD.Withdrawal
withdrawal userAddr = WD.Withdrawal
{ WD._amount = USD 1
, WD._receiverEmail = userAddr
}
deposit :: Text -> DP.Deposit
deposit userAddr = DP.Deposit
{ DP._amount = USD 1
, DP._senderEmail = userAddr
, DP._returnUrl = "https://example.com/"
, DP._cancelUrl = "https://example.com/cancel"
}
correctWithdrawal :: Assertion
correctWithdrawal = do
(client, userEmail, _) <- config
wdResp <- assertRight . checkComplete =<< fmap snd . assertRight =<< WD.request client (withdrawal userEmail)
lpResp <- fmap snd . assertRight =<< LP.request client (LP.LookupPayKey $ _cpPayKey wdResp)
void $ assertRight (checkComplete lpResp)
withdrawalAccountAddressDNE :: Assertion
withdrawalAccountAddressDNE = do
(client, userEmail, notSandboxEmail) <- config
let c = incorrectEmailClient notSandboxEmail client
adaptiveErr <- assertLeft =<< WD.request c (withdrawal userEmail)
case adaptiveErr of
AeErrorResponse _ (ErrorResponse [PayError code _]) ->
assertEqual "send error due to a nonexistent account address" noSuchEmail code
e -> assertFailure $ "withdrawalAccountAddressDNE got unexpected error " <> show e
withdrawalUserAddressDNE :: Assertion
withdrawalUserAddressDNE = do
(client, _, notSandboxEmail) <- config
payResp <- fmap snd . assertRight =<< WD.request client (withdrawal notSandboxEmail)
assertExpected payResp
assertLookup =<< fmap snd . assertRight =<< LP.request client (LP.LookupPayKey $ _prPayKey payResp)
where
assertExpected :: PayResponse -> IO ()
assertExpected payResp = do
void . assertLeft $ checkComplete payResp
assertEqual "withdraw to nonexistent user addresses return no PayInfos"
0
(length $ _prPaymentInfos payResp)
assertLookup :: PayResponse -> Assertion
assertLookup a = do
assertEqual "withdrawalAccountAddressDNE _prPayStatus" PeCompleted (_prPayStatus a)
info <- assertRight (getPaymentInfo a)
assertEqual "pending withdrawal transaction status" Nothing (_piTransactionStatus info)
withdrawalNotEnoughFunds :: Assertion
withdrawalNotEnoughFunds = do
(client, userEmail, _) <- config
adaptiveErr <- assertLeft =<< WD.request client (largeWithdrawal userEmail)
case adaptiveErr of
AeErrorResponse _ (ErrorResponse [PayError code _]) ->
assertEqual "send error due to not enough funds" (ErrorCode 520009) code
e -> assertFailure $ "withdrawalAccountAddressDNE got unexpected error " <> show e
where
largeWithdrawal :: Text -> WD.Withdrawal
largeWithdrawal userAddr = WD.Withdrawal
{ WD._amount = USD 100000000
, WD._receiverEmail = userAddr
}
correctDepositBeginning :: Assertion
correctDepositBeginning = do
(client, userEmail, _) <- config
payKey <- fmap (_prPayKey . snd) . assertRight =<< DP.request client (deposit userEmail)
assertExpected =<< fmap snd . assertRight =<< LP.request client (LP.LookupPayKey payKey)
where
assertExpected :: PayResponse -> Assertion
assertExpected a = do
assertEqual "correctDepositBeginning _prPayStatus" PeCreated (_prPayStatus a)
info <- assertRight (getPaymentInfo a)
assertEqual "pending deposit transaction status" Nothing (_piTransactionStatus info)
depositAccountAddressDNE :: Assertion
depositAccountAddressDNE = do
(client, userEmail, notSandboxEmail) <- config
let c = incorrectEmailClient notSandboxEmail client
payKey <- fmap (_prPayKey . snd) . assertRight =<< DP.request c (deposit userEmail)
assertExpected . snd =<< assertRight =<< LP.request client (LP.LookupPayKey payKey)
where
assertExpected :: PayResponse -> Assertion
assertExpected a = do
assertEqual "depositUserAddressDNE _prPayStatus" PeCreated (_prPayStatus a)
info <- assertRight (getPaymentInfo a)
assertEqual "status for deposit where to address isn't an account" Nothing (_piTransactionStatus info)
depositUserAddressDNE :: Assertion
depositUserAddressDNE = do
(client, _, notSandboxEmail) <- config
adaptiveErr <- assertLeft =<< DP.request client (deposit notSandboxEmail)
case adaptiveErr of
AeErrorResponse _ (ErrorResponse [PayError code _]) ->
assertEqual "create error due to a nonexistent user address" noSuchEmail code
e -> assertFailure $ "withdrawalAccountAddressDNE got unexpected error " <> show e