paypal-adaptive-hoops-0.13.1.0: Example.hs

{-# LANGUAGE OverloadedStrings #-}

module Main where

import           Prelude                    hiding (getLine, lookup, putStr, putStrLn)
import           Data.Text                  (Text)
import           Data.Text.IO

import qualified PayPal.Adaptive            as PP
import qualified PayPal.Adaptive.Deposit    as DP
import qualified PayPal.Adaptive.Lookup     as LP
import qualified PayPal.Adaptive.Withdrawal as WD

-- You need to create a sandbox app on PayPal and enter its credentials
-- below for this app to run.
--
-- Also, the email associated with the sandbox app will need at least
-- a dollar in its sandbox account.
userId, password, sig, accountEmail :: Text
userId       = "foo_api1.example.com"
password     = "bar"
sig          = "baz"
accountEmail = "foo@example.com"

-- You must also create a sandbox user on PayPal. Enter its email here.
-- This is the account we'll be sending money to and from.
sandboxTestUser :: Text
sandboxTestUser = "user@mail.com"

main :: IO ()
main = do

  exampleWithdrawal

  payKey <- startExampleDeposit

  putStrLn "-- Go here and use the other account's password to approve the payment:"
  putStrLn (DP.approvalUrl client payKey)
  putStrLn ""
  putStrLn "-- Once that's done press enter ..."
  _ <- getLine

  finishExampleDeposit payKey


exampleWithdrawal :: IO ()
exampleWithdrawal = do
  putStrLn "-- Sending money to another PayPal account."
  resp <- WD.request client withdrawal
  case resp of
    Left e               -> error (show e)
    Right withdrawalResp -> do
      print withdrawalResp
      putStrLn ""

startExampleDeposit :: IO PP.PayKey
startExampleDeposit = do
  putStrLn "-- Creating a payment from another account to us."
  resp <- DP.request client deposit
  putStrLn ""
  case resp of
    Left e            -> error (show e)
    Right (_,payResp) -> return (PP._prPayKey payResp)

finishExampleDeposit :: PP.PayKey -> IO ()
finishExampleDeposit payKey = do
  putStrLn "-- Now looking up the payment on PayPal to make sure it succeeded."
  resp <- LP.request client (LP.LookupPayKey payKey)
  case resp of
    Left e            -> error (show e)
    Right (_,payResp) ->
      case PP.checkComplete payResp of
        Left e2               -> error (show e2)
        Right completePayment -> print completePayment

client :: PP.Client
client = PP.Client
  { PP._clAppId        = "APP-80W284485P519543T" -- Currently the ID for all sandbox apps.
  , PP._clUserId       = userId
  , PP._clEnvironment  = PP.Sandbox
  , PP._clPassword     = password
  , PP._clSignature    = sig
  , PP._clAccountEmail = accountEmail
  }

withdrawal :: WD.Withdrawal
withdrawal = WD.Withdrawal
  { WD._amount        = PP.USD 100
  , WD._receiverEmail = sandboxTestUser
  }

deposit :: DP.Deposit
deposit = DP.Deposit
  { DP._amount      = PP.USD 100
  , DP._senderEmail = sandboxTestUser
  , DP._returnUrl   = "https://example.com/"
  , DP._cancelUrl   = "https://example.com/"
  }