{-# 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.Default
import Data.HashMap.Strict as H
import Data.Text (Text)
import Test.Framework (Test, defaultMain, testGroup)
import Test.Framework.Providers.HUnit (testCase)
import Test.HUnit hiding (Test)
import Utils
import Web.PayPal.Adaptive
import Web.PayPal.Adaptive.Internal
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"
correctDeposit
, 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 -> Withdrawal
withdrawal userAddr = def
{ _wdAmount = USD 1
, _wdReceiverEmail = userAddr
}
deposit :: Text -> Deposit
deposit userAddr = def
{ _dpAmount = USD 1
, _dpSenderEmail = userAddr
}
assrt :: Either AdaptiveErr () -> IO ()
assrt (Left e) = assertFailure (show e) >> fail "check failed"
assrt (Right _) = return ()
correctWithdrawal :: Assertion
correctWithdrawal = do
(client, userEmail, _) <- config
payResp <- assertRight =<< toPayPal client (withdrawal userEmail)
(assrt . checkLookup) =<< assertRight =<< toPayPal client (LookupPayKey . _prPayKey $ payResp)
where
checkLookup :: PayResp -> Either AdaptiveErr ()
checkLookup a = do
payExecStatusCompleted a
info <- getPayInfo a
transactionStatusCompleted a info
errorFieldNothing a
checkPayKey a
Right ()
withdrawalAccountAddressDNE :: Assertion
withdrawalAccountAddressDNE = do
(client, userEmail, notSandboxEmail) <- config
let c = incorrectEmailClient notSandboxEmail client
adaptiveErr <- assertLeft =<< toPayPal c (withdrawal userEmail)
assertEqual "send error due to a nonexistent account address" AeNoSuchEmail adaptiveErr
withdrawalUserAddressDNE :: Assertion
withdrawalUserAddressDNE = do
(client, _, notSandboxEmail) <- config
payResp <- checkResp =<< assertLeft =<< toPayPal client (withdrawal notSandboxEmail)
(assrt . checkLookup) =<< assertRight =<< toPayPal client (LookupPayKey . _prPayKey $ payResp)
where
checkResp :: AdaptiveErr -> IO PayResp
checkResp (AePending payResp) = do
assertEqual
"withdraw to nonexistent user addresses return no PayResps"
0 (length $ _prPayInfo payResp)
return payResp
checkResp _ =
assertFalse "send error due to a nonexistent user address didn't return AePending"
>> fail "checkResp failed"
checkLookup :: PayResp -> Either AdaptiveErr ()
checkLookup a = do
payExecStatusCompleted a
info <- getPayInfo a
unless (_piTransactionStatus info == Nothing) $ Left (AeShouldNotHappen a
"a pending withdrawal should not have transaction status in this situation")
errorFieldNothing a
checkPayKey a
Right ()
withdrawalNotEnoughFunds :: Assertion
withdrawalNotEnoughFunds = do
(client, userEmail, _) <- config
adaptiveErr <- assertLeft =<< toPayPal client (largeWithdrawal userEmail)
assertEqual "send error due to not enough funds" (AeErrCodes [520009]) adaptiveErr
where
largeWithdrawal :: Text -> Withdrawal
largeWithdrawal userAddr = def
{ _wdAmount = USD 1000000
, _wdReceiverEmail = userAddr
}
correctDeposit :: Assertion
correctDeposit = do
(client, userEmail, _) <- config
payResp <- assertRight =<< toPayPal client (deposit userEmail)
(assrt . checkLookup) =<< assertRight =<< toPayPal client (LookupPayKey . _prPayKey $ payResp)
where
checkLookup :: PayResp -> Either AdaptiveErr ()
checkLookup a = do
payExecStatusCreated a
info <- getPayInfo a
unless (_piTransactionStatus info == Nothing) $ Left (AeShouldNotHappen a
"an uncompleted deposit should not have transaction status in this situation")
errorFieldNothing a
checkPayKey a
Right ()
depositAccountAddressDNE :: Assertion
depositAccountAddressDNE = do
(client, userEmail, notSandboxEmail) <- config
let c = incorrectEmailClient notSandboxEmail client
payResp <- assertRight =<< toPayPal c (deposit userEmail)
(assrt . checkLookup) =<< assertRight =<< toPayPal client (LookupPayKey . _prPayKey $ payResp)
where
checkLookup :: PayResp -> Either AdaptiveErr ()
checkLookup a = do
payExecStatusCreated a
info <- getPayInfo a
unless (_piTransactionStatus info == Nothing) $ Left (AeShouldNotHappen a
"a deposit should not have transaction status in this situation")
errorFieldNothing a
checkPayKey a
Right ()
depositUserAddressDNE :: Assertion
depositUserAddressDNE = do
(client, _, notSandboxEmail) <- config
adaptiveErr <- assertLeft =<< toPayPal client (deposit notSandboxEmail)
assertEqual "create error due to a nonexistent user address" AeNoSuchEmail adaptiveErr