{-# OPTIONS_GHC -fno-warn-orphans #-}
module Main where
import Control.Applicative
import Control.Monad
import Data.Aeson
import qualified Data.ByteString.Lazy as B
import Data.HashMap.Strict as H
import Data.Text (Text)
import PayPal.Adaptive
import qualified PayPal.Adaptive.Deposit as DP
import PayPal.Adaptive.Internal
import qualified PayPal.Adaptive.Lookup as LP
import qualified PayPal.Adaptive.Withdrawal as WD
import Test.Framework (Test, defaultMain, testGroup)
import Test.Framework.Providers.HUnit (testCase)
import Test.HUnit hiding (Test)
import Utils
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
]
-- | Currently the ID for all sandbox apps.
appId :: Text
appId = "APP-80W284485P519543T"
instance FromJSON Client where
parseJSON = withObject "client credentials" $ \o ->
Client appId <$>
o .: "sandboxClientUid" <*>
pure Sandbox <*>
o .: "sandboxClientPassword" <*>
o .: "sandboxClientSig" <*>
o .: "sandboxAccountEmail"
config :: IO (Client, Text, Text)
config = do
b <- B.readFile "sandbox.json"
client <- assertRight (eitherDecode b)
Object o <- assertRight (eitherDecode b)
String userEmail <- assertJust "sandboxUserEmail not found"
$ H.lookup "sandboxUserEmail" o
String notSandboxEmail <- assertJust "randomNonSandboxUserEmail not found"
$ H.lookup "randomNonSandboxUserEmail" o
return (client, userEmail, notSandboxEmail)
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 =<< WD.req client (withdrawal userEmail)
lpResp <- assertRight =<< LP.req client (LP.LookupPayKey $ _crPayKey wdResp)
void $ assertRight (checkComplete lpResp)
withdrawalAccountAddressDNE :: Assertion
withdrawalAccountAddressDNE = do
(client, userEmail, notSandboxEmail) <- config
let c = incorrectEmailClient notSandboxEmail client
adaptiveErr <- assertLeft =<< WD.req c (withdrawal userEmail)
assertEqual "send error due to a nonexistent account address" AeNoSuchEmail adaptiveErr
withdrawalUserAddressDNE :: Assertion
withdrawalUserAddressDNE = do
(client, _, notSandboxEmail) <- config
payResp <- assertExpected =<< assertLeft =<< WD.req client (withdrawal notSandboxEmail)
assertLookup =<< assertRight =<< LP.req client (LP.LookupPayKey $ _prPayKey payResp)
where
assertExpected :: AdaptiveErr -> IO PayResp
assertExpected (AePending payResp) = do
assertEqual
"withdraw to nonexistent user addresses return no PayInfos"
0 (length $ _prPayInfos payResp)
return payResp
assertExpected _ =
assertFalse "send error due to a nonexistent user address didn't return AePending"
>> fail "checkResp failed"
assertLookup :: PayResp -> Assertion
assertLookup a = do
info <- assertRight $ do
payExecStatusCompleted a
errorFieldNothing a
checkPayKey a
getPayInfo a
assertEqual "pending withdrawal transaction status" Nothing (_piTransactionStatus info)
withdrawalNotEnoughFunds :: Assertion
withdrawalNotEnoughFunds = do
(client, userEmail, _) <- config
adaptiveErr <- assertLeft =<< WD.req client (largeWithdrawal userEmail)
assertEqual "send error due to not enough funds" (AeErrCodes [520009]) adaptiveErr
where
largeWithdrawal :: Text -> WD.Withdrawal
largeWithdrawal userAddr = WD.Withdrawal
{ WD._amount = USD 100000000
, WD._receiverEmail = userAddr
}
correctDepositBeginning :: Assertion
correctDepositBeginning = do
(client, userEmail, _) <- config
payKey <- assertRight =<< DP.req client (deposit userEmail)
assertExpected =<< assertRight =<< LP.req client (LP.LookupPayKey payKey)
where
assertExpected :: PayResp -> Assertion
assertExpected a = do
info <- assertRight $ do
payExecStatusCreated a
errorFieldNothing a
checkPayKey a
getPayInfo a
assertEqual "pending deposit transaction status" Nothing (_piTransactionStatus info)
depositAccountAddressDNE :: Assertion
depositAccountAddressDNE = do
(client, userEmail, notSandboxEmail) <- config
let c = incorrectEmailClient notSandboxEmail client
payKey <- assertRight =<< DP.req c (deposit userEmail)
assertExpected =<< assertRight =<< LP.req client (LP.LookupPayKey payKey)
where
assertExpected :: PayResp -> Assertion
assertExpected a = do
info <- assertRight $ do
payExecStatusCreated a
errorFieldNothing a
checkPayKey a
getPayInfo 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.req client (deposit notSandboxEmail)
assertEqual "create error due to a nonexistent user address" AeNoSuchEmail adaptiveErr