paypal-adaptive-hoops 0.7.0.0 → 0.8.0.0
raw patch · 24 files changed
+452/−352 lines, 24 filesdep +unordered-containersdep −QuickCheckdep −test-framework-quickcheck2dep ~HUnitdep ~aesondep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: unordered-containers
Dependencies removed: QuickCheck, test-framework-quickcheck2
Dependency ranges changed: HUnit, aeson, base, bytestring, data-default, test-framework, test-framework-hunit, text
API changes (from Hackage documentation)
Files
- README.md +12/−2
- paypal-adaptive-hoops.cabal +35/−15
- src/Web/PayPal/Adaptive/Core.hs +0/−1
- tests/JSON/parseCreateResp.json +0/−10
- tests/JSON/parseErrResp.json +0/−21
- tests/JSON/parseLookupResp.json +0/−41
- tests/JSON/parseSendResp.json +0/−30
- tests/JSON/serializeCreatePayment.json +0/−18
- tests/JSON/serializeSendPayment.json +0/−18
- tests/Local.hs +11/−0
- tests/Local/Money.hs +46/−0
- tests/Local/Parser.hs +118/−0
- tests/Local/json/parseCreateResp.json +10/−0
- tests/Local/json/parseErrResp.json +21/−0
- tests/Local/json/parseLookupResp.json +41/−0
- tests/Local/json/parseSendResp.json +30/−0
- tests/Local/json/serializeCreatePayment.json +18/−0
- tests/Local/json/serializeSendPayment.json +18/−0
- tests/Remote.hs +77/−0
- tests/Test.hs +0/−9
- tests/Unit/Money.hs +0/−48
- tests/Unit/Parser.hs +0/−102
- tests/Unit/Utils.hs +0/−37
- tests/Utils.hs +15/−0
README.md view
@@ -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`
paypal-adaptive-hoops.cabal view
@@ -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
src/Web/PayPal/Adaptive/Core.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Web.PayPal.Adaptive.Core where
− tests/JSON/parseCreateResp.json
@@ -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"-}
− tests/JSON/parseErrResp.json
@@ -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"- ]- }- ]-}
− tests/JSON/parseLookupResp.json
@@ -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"- }- ]- }-}
− tests/JSON/parseSendResp.json
@@ -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"- }- ]- }-}
− tests/JSON/serializeCreatePayment.json
@@ -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"-}
− tests/JSON/serializeSendPayment.json
@@ -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"-}
+ tests/Local.hs view
@@ -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
+ tests/Local/Money.hs view
@@ -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"
+ tests/Local/Parser.hs view
@@ -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]
+ tests/Local/json/parseCreateResp.json view
@@ -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"+}
+ tests/Local/json/parseErrResp.json view
@@ -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"+ ]+ }+ ]+}
+ tests/Local/json/parseLookupResp.json view
@@ -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"+ }+ ]+ }+}
+ tests/Local/json/parseSendResp.json view
@@ -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"+ }+ ]+ }+}
+ tests/Local/json/serializeCreatePayment.json view
@@ -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"+}
+ tests/Local/json/serializeSendPayment.json view
@@ -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"+}
+ tests/Remote.hs view
@@ -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+ }
− tests/Test.hs
@@ -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
− tests/Unit/Money.hs
@@ -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"
− tests/Unit/Parser.hs
@@ -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]
− tests/Unit/Utils.hs
@@ -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 ()
+ tests/Utils.hs view
@@ -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