packages feed

paypal-adaptive-hoops-0.8.0.0: tests/Remote.hs

{-# 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
      }