diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -10,6 +10,16 @@ Getting production approval for the Adaptive Payments API takes some time. You should start the process well before you actually need to go into production. Detailed instructions for doing so are out of the scope of this project, but you can get started [here](https://developer.paypal.com/docs/classic/lifecycle/goingLive/). -# Status +# Local Tests -Working. +`cabal test local` + +# Integration Tests + +Requires an internet connection, a PayPal sandbox app account, and a PayPal sandbox test user account. The test accounts must each have at least a penny in them. + +1. `cp sandbox-template.json sandbox.json` + +2. Fill out `sandbox.json` with your credentials. + +3. `cabal test remote` diff --git a/paypal-adaptive-hoops.cabal b/paypal-adaptive-hoops.cabal --- a/paypal-adaptive-hoops.cabal +++ b/paypal-adaptive-hoops.cabal @@ -1,5 +1,5 @@ name: paypal-adaptive-hoops -version: 0.7.0.0 +version: 0.8.0.0 author: Ian Grant Jeffries maintainer: ian@housejeffries.com category: Web @@ -10,7 +10,7 @@ license-file: MIT-LICENSE.txt cabal-version: >=1.10 extra-source-files: README.md - tests/JSON/*.json + tests/Local/json/*.json library hs-source-dirs: src @@ -19,9 +19,9 @@ other-modules: Web.PayPal.Adaptive.Core default-language: Haskell2010 ghc-options: -Wall + default-extensions: OverloadedStrings other-extensions: GADTs , MultiWayIf - , OverloadedStrings , TemplateHaskell build-depends: aeson >= 0.8 && < 0.9 @@ -38,27 +38,47 @@ , vector >= 0.10.12 && < 0.11 , wreq >= 0.3 && < 0.4 -test-suite unit +test-suite local type: exitcode-stdio-1.0 hs-source-dirs: tests - main-is: Test.hs - other-modules: Unit.Money - Unit.Parser - Unit.Utils + main-is: Local.hs + other-modules: Local.Money + Local.Parser + Utils default-language: Haskell2010 ghc-options: -Wall - other-extensions: OverloadedStrings + default-extensions: OverloadedStrings build-depends: aeson - , base >=4.7 && <= 5.0 + , base , bytestring , data-default - , HUnit , paypal-adaptive-hoops - , QuickCheck - , test-framework - , test-framework-hunit - , test-framework-quickcheck2 + , text + , HUnit >= 1.2 && < 1.3 + , test-framework >= 0.8 && < 0.9 + , test-framework-hunit >= 0.3 && < 0.4 + , unordered-containers >= 0.2 && < 0.3 + +test-suite remote + type: exitcode-stdio-1.0 + hs-source-dirs: tests + main-is: Remote.hs + other-modules: Utils + default-language: Haskell2010 + ghc-options: -Wall + default-extensions: OverloadedStrings + + build-depends: aeson + , base + , bytestring + , data-default + , paypal-adaptive-hoops + , text + , HUnit >= 1.2 && < 1.3 + , test-framework >= 0.8 && < 0.9 + , test-framework-hunit >= 0.3 && < 0.4 + , unordered-containers >= 0.2 && < 0.3 executable example main-is: Example.hs diff --git a/src/Web/PayPal/Adaptive/Core.hs b/src/Web/PayPal/Adaptive/Core.hs --- a/src/Web/PayPal/Adaptive/Core.hs +++ b/src/Web/PayPal/Adaptive/Core.hs @@ -1,6 +1,5 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Web.PayPal.Adaptive.Core where diff --git a/tests/JSON/parseCreateResp.json b/tests/JSON/parseCreateResp.json deleted file mode 100644 --- a/tests/JSON/parseCreateResp.json +++ /dev/null @@ -1,10 +0,0 @@ -{ - "responseEnvelope": { - "correlationId": "caf7d2d1a85aa", - "build": "13414382", - "ack": "Success", - "timestamp": "2015-01-12T13:47:48.819-08:00" - }, - "paymentExecStatus": "CREATED", - "payKey": "AP-3NL080742J1818731" -} diff --git a/tests/JSON/parseErrResp.json b/tests/JSON/parseErrResp.json deleted file mode 100644 --- a/tests/JSON/parseErrResp.json +++ /dev/null @@ -1,21 +0,0 @@ -{ - "responseEnvelope": { - "correlationId": "8415665a8815f", - "build": "13414382", - "ack": "Failure", - "timestamp": "2014-11-10T16:42:00.311-08:00" - }, - "error": [ - { - "subdomain": "Application", - "category": "Application", - "domain": "PLATFORM", - "severity": "Error", - "errorId": "560022", - "message": "The X-PAYPAL-APPLICATION-ID header contains an invalid value", - "parameter": [ - "X-PAYPAL-APPLICATION-ID" - ] - } - ] -} diff --git a/tests/JSON/parseLookupResp.json b/tests/JSON/parseLookupResp.json deleted file mode 100644 --- a/tests/JSON/parseLookupResp.json +++ /dev/null @@ -1,41 +0,0 @@ -{ - "status": "COMPLETED", - "feesPayer": "EACHRECEIVER", - "currencyCode": "USD", - "reverseAllParallelPaymentsOnError": "false", - "cancelUrl": "https://example.com/cancel", - "responseEnvelope": { - "correlationId": "db7b90a8b503a", - "build": "13414382", - "ack": "Success", - "timestamp": "2015-01-13T16:09:46.064-08:00" - }, - "sender": { - "email": "payments-facilitator@mail.com", - "accountId": "SQ6CLCESENNDL", - "useCredentials": "false" - }, - "returnUrl": "https://example.com/", - "senderEmail": "payments-facilitator@mail.com", - "payKey": "AP-5XY65045XE4097324", - "actionType": "PAY", - "paymentInfoList": { - "paymentInfo": [ - { - "refundedAmount": "0.00", - "senderTransactionStatus": "COMPLETED", - "transactionId": "0CL88103PF900230J", - "receiver": { - "email": "user@mail.com", - "amount": "1.00", - "primary": "false", - "accountId": "69D9D7KVA6WAN", - "paymentType": "SERVICE" - }, - "senderTransactionId": "9U084775U2533540T", - "transactionStatus": "COMPLETED", - "pendingRefund": "false" - } - ] - } -} diff --git a/tests/JSON/parseSendResp.json b/tests/JSON/parseSendResp.json deleted file mode 100644 --- a/tests/JSON/parseSendResp.json +++ /dev/null @@ -1,30 +0,0 @@ -{ - "responseEnvelope": { - "correlationId": "8d141f13b157e", - "build": "13414382", - "ack": "Success", - "timestamp": "2014-11-10T16:27:18.328-08:00" - }, - "paymentExecStatus": "COMPLETED", - "sender": { - "accountId": "SQ6CLCESENNDL" - }, - "payKey": "AP-21C62741YR509274N", - "paymentInfoList": { - "paymentInfo": [ - { - "senderTransactionStatus": "COMPLETED", - "transactionId": "1DG71997KF688883E", - "receiver": { - "email": "user@mail.com", - "amount": "1.00", - "primary": "false", - "accountId": "69D9D7KVA6WAN" - }, - "senderTransactionId": "7TU31598YN877045D", - "transactionStatus": "COMPLETED", - "pendingRefund": "false" - } - ] - } -} diff --git a/tests/JSON/serializeCreatePayment.json b/tests/JSON/serializeCreatePayment.json deleted file mode 100644 --- a/tests/JSON/serializeCreatePayment.json +++ /dev/null @@ -1,18 +0,0 @@ -{ - "currencyCode": "USD", - "cancelUrl": "https://example.com/cancel", - "receiverList": { - "receiver": [ - { - "email": "payments@mail.com", - "amount": "1.00" - } - ] - }, - "returnUrl": "https://example.com/", - "senderEmail": "user@mail.com", - "requestEnvelope": { - "errorLanguage": "en_US" - }, - "actionType": "PAY" -} diff --git a/tests/JSON/serializeSendPayment.json b/tests/JSON/serializeSendPayment.json deleted file mode 100644 --- a/tests/JSON/serializeSendPayment.json +++ /dev/null @@ -1,18 +0,0 @@ -{ - "currencyCode": "USD", - "cancelUrl": "https://example.com/cancel", - "receiverList": { - "receiver": [ - { - "email": "user@mail.com", - "amount": "1.00" - } - ] - }, - "returnUrl": "https://example.com/", - "senderEmail": "payments@mail.com", - "requestEnvelope": { - "errorLanguage": "en_US" - }, - "actionType": "PAY" -} diff --git a/tests/Local.hs b/tests/Local.hs new file mode 100644 --- /dev/null +++ b/tests/Local.hs @@ -0,0 +1,11 @@ +module Main where + +import Local.Money +import Local.Parser +import Test.Framework (Test, defaultMain) + +tests :: [Test] +tests = [unitMoney, unitParser] + +main :: IO () +main = defaultMain tests diff --git a/tests/Local/Money.hs b/tests/Local/Money.hs new file mode 100644 --- /dev/null +++ b/tests/Local/Money.hs @@ -0,0 +1,46 @@ +module Local.Money (unitMoney) where + +import Test.Framework +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit ((@=?), Assertion) +import Web.PayPal.Adaptive + +unitMoney :: Test +unitMoney = testGroup "money" + [ testCase "handle large negative amount correctly" largeNegative + , testCase "handle negative amount correctly" negative + , testCase "handle 0 correctly" zero + , testCase "handle 1 correctly" oneDigit + , testCase "handle 10 correctly" twoDigitsTrailingZero + , testCase "show both decimals even if both are zero" threeDigitsTrailingZeros + , testCase "show both decimals even if the second is zero" threeDigitsTrailingZero + , testCase "handles large amount correctly" largeAmount + ] + +testM2P :: Int -> String -> Assertion +testM2P input correct = + correct @=? m2PayPal USD { _usdCents = input } + +largeNegative :: Assertion +largeNegative = testM2P (-98783) "-987.83" + +negative :: Assertion +negative = testM2P (-1) "-0.01" + +zero :: Assertion +zero = testM2P 0 "0.00" + +oneDigit :: Assertion +oneDigit = testM2P 1 "0.01" + +twoDigitsTrailingZero :: Assertion +twoDigitsTrailingZero = testM2P 10 "0.10" + +threeDigitsTrailingZeros :: Assertion +threeDigitsTrailingZeros = testM2P 100 "1.00" + +threeDigitsTrailingZero :: Assertion +threeDigitsTrailingZero = testM2P 110 "1.10" + +largeAmount :: Assertion +largeAmount = testM2P 792874 "7928.74" diff --git a/tests/Local/Parser.hs b/tests/Local/Parser.hs new file mode 100644 --- /dev/null +++ b/tests/Local/Parser.hs @@ -0,0 +1,118 @@ +module Local.Parser (unitParser) where + +import Data.Aeson +import qualified Data.ByteString.Lazy as B +import qualified Data.ByteString.Lazy.Char8 as BSC +import Data.Char (isSpace) +import Data.Default +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit (Assertion, (@=?)) +import Utils +import Web.PayPal.Adaptive + +unitParser :: Test +unitParser = testGroup "parsers" + [ testCase "correctly encodes a SendPayment" serializeSendPayment + , testCase "correctly encodes a CreatePayment" serializeCreatePayment + , testCase "correctly decodes a SendPayment response" parseSendResp + , testCase "correctly decodes a CreatePayment response" parseCreateResp + , testCase "correctly decodes a LookupPayment response" parseLookupResp + , testCase "correctly decodes an error code response" parseErrResp + ] + +eqSerialized :: (ToJSON a) => FilePath -> a -> Assertion +eqSerialized x y = do + expected <- B.readFile x + let actual = encode y + filterBS expected @=? filterBS actual + where + filterBS :: BSC.ByteString -> BSC.ByteString + filterBS = BSC.filter (not . isSpace) + +eqParsed :: (Show a, Eq a, FromJSON a) => a -> FilePath -> Assertion +eqParsed expected x = do + b <- B.readFile x + actual <- assertRight (eitherDecode b) + expected @=? actual + +serializeSendPayment :: Assertion +serializeSendPayment = "tests/Local/json/serializeSendPayment.json" `eqSerialized` a + where + a = def + { _spReceiverList = rl + , _spSenderEmail = "payments@mail.com" + } + rl = ReceiverList + { _rlAmount = USD 100 + , _rlEmail = "user@mail.com" + } + +serializeCreatePayment :: Assertion +serializeCreatePayment = "tests/Local/json/serializeCreatePayment.json" `eqSerialized` a + where + a = def + { _cpReceiverList = rl + , _cpSenderEmail = "user@mail.com" + } + rl = ReceiverList + { _rlAmount = USD 100 + , _rlEmail = "payments@mail.com" + } + +parseSendResp :: Assertion +parseSendResp = expected `eqParsed` "tests/Local/json/parseSendResp.json" + where + expected = PayResp + { _prPayError = Nothing + , _prPayExecStatus = PeCompleted + , _prPayKey = PayKey "AP-21C62741YR509274N" + , _prPayInfo = [p] + } + p = PayInfo + { _piReceiver = r + , _piSenderTransactionId = Just (TransactionId "7TU31598YN877045D") + , _piTransactionStatus = Just TsCompleted + , _piTransactionId = Just (TransactionId "1DG71997KF688883E") + } + r = Receiver + { _reAmount = "1.00" + , _reEmail = "user@mail.com" + , _reAccountId = "69D9D7KVA6WAN" + } + +parseCreateResp :: Assertion +parseCreateResp = expected `eqParsed` "tests/Local/json/parseCreateResp.json" + where + expected = PayResp + { _prPayError = Nothing + , _prPayExecStatus = PeCreated + , _prPayKey = PayKey "AP-3NL080742J1818731" + , _prPayInfo = [] + } + +parseLookupResp :: Assertion +parseLookupResp = expected `eqParsed` "tests/Local/json/parseLookupResp.json" + where + expected = PayResp + { _prPayError = Nothing + , _prPayExecStatus = PeCompleted + , _prPayKey = PayKey "AP-5XY65045XE4097324" + , _prPayInfo = [p] + } + p = PayInfo + { _piReceiver = r + , _piSenderTransactionId = Just (TransactionId "9U084775U2533540T") + , _piTransactionStatus = Just TsCompleted + , _piTransactionId = Just (TransactionId "0CL88103PF900230J") + } + r = Receiver + { _reAmount = "1.00" + , _reEmail = "user@mail.com" + , _reAccountId = "69D9D7KVA6WAN" + } + +parseErrResp :: Assertion +parseErrResp = expected `eqParsed` "tests/Local/json/parseErrResp.json" + where + expected = AeErrCodes [560022] diff --git a/tests/Local/json/parseCreateResp.json b/tests/Local/json/parseCreateResp.json new file mode 100644 --- /dev/null +++ b/tests/Local/json/parseCreateResp.json @@ -0,0 +1,10 @@ +{ + "responseEnvelope": { + "correlationId": "caf7d2d1a85aa", + "build": "13414382", + "ack": "Success", + "timestamp": "2015-01-12T13:47:48.819-08:00" + }, + "paymentExecStatus": "CREATED", + "payKey": "AP-3NL080742J1818731" +} diff --git a/tests/Local/json/parseErrResp.json b/tests/Local/json/parseErrResp.json new file mode 100644 --- /dev/null +++ b/tests/Local/json/parseErrResp.json @@ -0,0 +1,21 @@ +{ + "responseEnvelope": { + "correlationId": "8415665a8815f", + "build": "13414382", + "ack": "Failure", + "timestamp": "2014-11-10T16:42:00.311-08:00" + }, + "error": [ + { + "subdomain": "Application", + "category": "Application", + "domain": "PLATFORM", + "severity": "Error", + "errorId": "560022", + "message": "The X-PAYPAL-APPLICATION-ID header contains an invalid value", + "parameter": [ + "X-PAYPAL-APPLICATION-ID" + ] + } + ] +} diff --git a/tests/Local/json/parseLookupResp.json b/tests/Local/json/parseLookupResp.json new file mode 100644 --- /dev/null +++ b/tests/Local/json/parseLookupResp.json @@ -0,0 +1,41 @@ +{ + "status": "COMPLETED", + "feesPayer": "EACHRECEIVER", + "currencyCode": "USD", + "reverseAllParallelPaymentsOnError": "false", + "cancelUrl": "https://example.com/cancel", + "responseEnvelope": { + "correlationId": "db7b90a8b503a", + "build": "13414382", + "ack": "Success", + "timestamp": "2015-01-13T16:09:46.064-08:00" + }, + "sender": { + "email": "payments-facilitator@mail.com", + "accountId": "SQ6CLCESENNDL", + "useCredentials": "false" + }, + "returnUrl": "https://example.com/", + "senderEmail": "payments-facilitator@mail.com", + "payKey": "AP-5XY65045XE4097324", + "actionType": "PAY", + "paymentInfoList": { + "paymentInfo": [ + { + "refundedAmount": "0.00", + "senderTransactionStatus": "COMPLETED", + "transactionId": "0CL88103PF900230J", + "receiver": { + "email": "user@mail.com", + "amount": "1.00", + "primary": "false", + "accountId": "69D9D7KVA6WAN", + "paymentType": "SERVICE" + }, + "senderTransactionId": "9U084775U2533540T", + "transactionStatus": "COMPLETED", + "pendingRefund": "false" + } + ] + } +} diff --git a/tests/Local/json/parseSendResp.json b/tests/Local/json/parseSendResp.json new file mode 100644 --- /dev/null +++ b/tests/Local/json/parseSendResp.json @@ -0,0 +1,30 @@ +{ + "responseEnvelope": { + "correlationId": "8d141f13b157e", + "build": "13414382", + "ack": "Success", + "timestamp": "2014-11-10T16:27:18.328-08:00" + }, + "paymentExecStatus": "COMPLETED", + "sender": { + "accountId": "SQ6CLCESENNDL" + }, + "payKey": "AP-21C62741YR509274N", + "paymentInfoList": { + "paymentInfo": [ + { + "senderTransactionStatus": "COMPLETED", + "transactionId": "1DG71997KF688883E", + "receiver": { + "email": "user@mail.com", + "amount": "1.00", + "primary": "false", + "accountId": "69D9D7KVA6WAN" + }, + "senderTransactionId": "7TU31598YN877045D", + "transactionStatus": "COMPLETED", + "pendingRefund": "false" + } + ] + } +} diff --git a/tests/Local/json/serializeCreatePayment.json b/tests/Local/json/serializeCreatePayment.json new file mode 100644 --- /dev/null +++ b/tests/Local/json/serializeCreatePayment.json @@ -0,0 +1,18 @@ +{ + "currencyCode": "USD", + "cancelUrl": "https://example.com/cancel", + "receiverList": { + "receiver": [ + { + "email": "payments@mail.com", + "amount": "1.00" + } + ] + }, + "returnUrl": "https://example.com/", + "senderEmail": "user@mail.com", + "requestEnvelope": { + "errorLanguage": "en_US" + }, + "actionType": "PAY" +} diff --git a/tests/Local/json/serializeSendPayment.json b/tests/Local/json/serializeSendPayment.json new file mode 100644 --- /dev/null +++ b/tests/Local/json/serializeSendPayment.json @@ -0,0 +1,18 @@ +{ + "currencyCode": "USD", + "cancelUrl": "https://example.com/cancel", + "receiverList": { + "receiver": [ + { + "email": "user@mail.com", + "amount": "1.00" + } + ] + }, + "returnUrl": "https://example.com/", + "senderEmail": "payments@mail.com", + "requestEnvelope": { + "errorLanguage": "en_US" + }, + "actionType": "PAY" +} diff --git a/tests/Remote.hs b/tests/Remote.hs new file mode 100644 --- /dev/null +++ b/tests/Remote.hs @@ -0,0 +1,77 @@ +{-# 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 + +main :: IO () +main = defaultMain [integrationRemote] + +integrationRemote :: Test +integrationRemote = testGroup "remote" + [ testCase "successfully sends a payment" sendPayment + , testCase "successfully creates a deposit" createPayment + ] + +-- | Currently the ID for all sandbox apps. +appId :: Text +appId = "APP-80W284485P519543T" + +instance FromJSON PpClient where + parseJSON = withObject "client credentials" $ \o -> + PpClient appId PpSandbox <$> + o .: "sandboxClientPassword" <*> + o .: "sandboxClientSig" <*> + o .: "sandboxClientUid" + +config :: IO (PpClient, Text, Text) +config = do + b <- B.readFile "sandbox.json" + client <- assertRight (eitherDecode b) + Object o <- assertRight (eitherDecode b) + String accountEmail <- assertJust "sandboxAccountEmail not found" + $ H.lookup "sandboxAccountEmail" o + String userEmail <- assertJust "sandboxUserEmail not found" + $ H.lookup "sandboxUserEmail" o + return (client, accountEmail, userEmail) + +sendPayment :: Assertion +sendPayment = do + (client, accountEmail, userEmail) <- config + payResp <- assertRight =<< toPayPal client (send accountEmail userEmail) + void . assertRight =<< toPayPal client (LookupPayKey . _prPayKey $ payResp) + where + send :: Text -> Text -> SendPayment + send accountAddr userAddr = def + { _spReceiverList = ReceiverList + { _rlAmount = USD 1 + , _rlEmail = userAddr + } + , _spSenderEmail = accountAddr + } + +createPayment :: Assertion +createPayment = do + (client, accountEmail, userEmail) <- config + payResp <- assertRight =<< toPayPal client (create accountEmail userEmail) + void . assertRight =<< toPayPal client (LookupPayKey . _prPayKey $ payResp) + where + create :: Text -> Text -> CreatePayment + create accountAddr userAddr = def + { _cpReceiverList = ReceiverList + { _rlAmount = USD 1 + , _rlEmail = accountAddr + } + , _cpSenderEmail = userAddr + } diff --git a/tests/Test.hs b/tests/Test.hs deleted file mode 100644 --- a/tests/Test.hs +++ /dev/null @@ -1,9 +0,0 @@ -import Test.Framework (Test, defaultMain) -import Unit.Money -import Unit.Parser - -tests :: [Test] -tests = [unitMoney, unitParser] - -main :: IO () -main = defaultMain tests diff --git a/tests/Unit/Money.hs b/tests/Unit/Money.hs deleted file mode 100644 --- a/tests/Unit/Money.hs +++ /dev/null @@ -1,48 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Unit.Money (unitMoney) where - -import Test.Framework -import Test.Framework.Providers.HUnit (testCase) -import Test.HUnit ((@=?), Assertion) -import Web.PayPal.Adaptive - -unitMoney :: Test -unitMoney = testGroup "money" - [ testCase "handle large negative amount correctly" largeNegative - , testCase "handle negative amount correctly" negative - , testCase "handle 0 correctly" zero - , testCase "handle 1 correctly" oneDigit - , testCase "handle 10 correctly" twoDigitsTrailingZero - , testCase "show both decimals even if both are zero" threeDigitsTrailingZeros - , testCase "show both decimals even if the second is zero" threeDigitsTrailingZero - , testCase "handles large amount correctly" largeAmount - ] - -testM2P :: Int -> String -> Assertion -testM2P input correct = - correct @=? m2PayPal USD { _usdCents = input } - -largeNegative :: Assertion -largeNegative = testM2P (-98783) "-987.83" - -negative :: Assertion -negative = testM2P (-1) "-0.01" - -zero :: Assertion -zero = testM2P 0 "0.00" - -oneDigit :: Assertion -oneDigit = testM2P 1 "0.01" - -twoDigitsTrailingZero :: Assertion -twoDigitsTrailingZero = testM2P 10 "0.10" - -threeDigitsTrailingZeros :: Assertion -threeDigitsTrailingZeros = testM2P 100 "1.00" - -threeDigitsTrailingZero :: Assertion -threeDigitsTrailingZero = testM2P 110 "1.10" - -largeAmount :: Assertion -largeAmount = testM2P 792874 "7928.74" diff --git a/tests/Unit/Parser.hs b/tests/Unit/Parser.hs deleted file mode 100644 --- a/tests/Unit/Parser.hs +++ /dev/null @@ -1,102 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Unit.Parser (unitParser) where - -import Data.Default -import Test.Framework (Test, testGroup) -import Test.Framework.Providers.HUnit (testCase) -import Test.HUnit (Assertion) -import Unit.Utils -import Web.PayPal.Adaptive - -unitParser :: Test -unitParser = testGroup "parsers" - [ testCase "correctly encodes a SendPayment" serializeSendPayment - , testCase "correctly encodes a CreatePayment" serializeCreatePayment - , testCase "correctly decodes a SendPayment response" parseSendResp - , testCase "correctly decodes a CreatePayment response" parseCreateResp - , testCase "correctly decodes a LookupPayment response" parseLookupResp - , testCase "correctly decodes an error code response" parseErrResp - ] - -serializeSendPayment :: Assertion -serializeSendPayment = "tests/JSON/serializeSendPayment.json" `eqSerialized` a - where - a = def - { _spReceiverList = rl - , _spSenderEmail = "payments@mail.com" - } - rl = ReceiverList - { _rlAmount = USD 100 - , _rlEmail = "user@mail.com" - } - -serializeCreatePayment :: Assertion -serializeCreatePayment = "tests/JSON/serializeCreatePayment.json" `eqSerialized` a - where - a = def - { _cpReceiverList = rl - , _cpSenderEmail = "user@mail.com" - } - rl = ReceiverList - { _rlAmount = USD 100 - , _rlEmail = "payments@mail.com" - } - -parseSendResp :: Assertion -parseSendResp = expected `eqParsed` "tests/JSON/parseSendResp.json" - where - expected = PayResp - { _prPayError = Nothing - , _prPayExecStatus = PeCompleted - , _prPayKey = PayKey "AP-21C62741YR509274N" - , _prPayInfo = [p] - } - p = PayInfo - { _piReceiver = r - , _piSenderTransactionId = Just (TransactionId "7TU31598YN877045D") - , _piTransactionStatus = Just TsCompleted - , _piTransactionId = Just (TransactionId "1DG71997KF688883E") - } - r = Receiver - { _reAmount = "1.00" - , _reEmail = "user@mail.com" - , _reAccountId = "69D9D7KVA6WAN" - } - -parseCreateResp :: Assertion -parseCreateResp = expected `eqParsed` "tests/JSON/parseCreateResp.json" - where - expected = PayResp - { _prPayError = Nothing - , _prPayExecStatus = PeCreated - , _prPayKey = PayKey "AP-3NL080742J1818731" - , _prPayInfo = [] - } - --- TODO: add tests for lookups of Created payments as well as Completed. -parseLookupResp :: Assertion -parseLookupResp = expected `eqParsed` "tests/JSON/parseLookupResp.json" - where - expected = PayResp - { _prPayError = Nothing - , _prPayExecStatus = PeCompleted - , _prPayKey = PayKey "AP-5XY65045XE4097324" - , _prPayInfo = [p] - } - p = PayInfo - { _piReceiver = r - , _piSenderTransactionId = Just (TransactionId "9U084775U2533540T") - , _piTransactionStatus = Just TsCompleted - , _piTransactionId = Just (TransactionId "0CL88103PF900230J") - } - r = Receiver - { _reAmount = "1.00" - , _reEmail = "user@mail.com" - , _reAccountId = "69D9D7KVA6WAN" - } - -parseErrResp :: Assertion -parseErrResp = expected `eqParsed` "tests/JSON/parseErrResp.json" - where - expected = AeErrCodes [560022] diff --git a/tests/Unit/Utils.hs b/tests/Unit/Utils.hs deleted file mode 100644 --- a/tests/Unit/Utils.hs +++ /dev/null @@ -1,37 +0,0 @@ -module Unit.Utils where - -import Data.Aeson (FromJSON, ToJSON, eitherDecode, encode) -import qualified Data.ByteString.Lazy as B -import qualified Data.ByteString.Lazy.Char8 as BSC -import Data.Char (isSpace) -import Test.HUnit (Assertion, (@=?), assertFailure) - -eqSerialized :: (ToJSON a) => FilePath -> a -> Assertion -eqSerialized x y = do - expected <- B.readFile x - let actual = encode y - filterBS expected @=? filterBS actual - - where - filterBS :: BSC.ByteString -> BSC.ByteString - filterBS = BSC.filter (not . isSpace) - -eqParsed :: (Show a, Eq a, FromJSON a) => a -> FilePath -> Assertion -eqParsed x y = do - j <- B.readFile y - actual <- assertDecode j - x @=? actual - - where - assertDecode :: FromJSON a => BSC.ByteString -> IO a - assertDecode json = do - let d = eitherDecode json - assertRight d - let Right actual = d - return actual - - where - assertRight :: Either String b -> Assertion - assertRight e = case e of - Left s -> assertFailure s - Right _ -> return () diff --git a/tests/Utils.hs b/tests/Utils.hs new file mode 100644 --- /dev/null +++ b/tests/Utils.hs @@ -0,0 +1,15 @@ +module Utils where + +import Test.HUnit + +assertJust :: String -> Maybe a -> IO a +assertJust s a = + case a of + Nothing -> assertFailure s >> fail "assertJust failed" + Just b -> return b + +assertRight :: (Show a) => Either a b -> IO b +assertRight a = + case a of + Left e -> assertFailure (show e) >> fail "assertRight failed" + Right b -> return b