Withdrawal.hs

{-# LANGUAGE TemplateHaskell #-}

-- | Send a single payment from your account.
--
-- "Pay" operation docs:
-- <https://developer.paypal.com/docs/classic/api/adaptive-payments/Pay_API_Operation/>
--
-- This is a "Simple Payment" which means there's a single sender
-- and receiver (same as Deposit).
--
-- It uses the "Implicit" payment approval type, meaning the application
-- making the API call must also be the sender of the payment.

module PayPal.Adaptive.Withdrawal where

import           Data.ByteString.Lazy             (ByteString)

import           Import
import           PayPal.Adaptive.Core.Client
import           PayPal.Adaptive.Core.Error
import           PayPal.Adaptive.Core.Internal
import           PayPal.Adaptive.Core.Money
import           PayPal.Adaptive.Core.PayResponse

data Withdrawal = Withdrawal
  { _amount        :: Money
  , _receiverEmail :: Text
  } deriving (Eq, Show)

-- | For internal use.
data SerializeWithdrawal = SerializeWithdrawal Withdrawal Text

instance ToJSON SerializeWithdrawal where
  toJSON (SerializeWithdrawal p accountEmail) = object
    [ "actionType"      .= ("PAY" :: Text)
    , "currencyCode"    .= m2Currency (_amount p)
    , "receiverList"    .= object
                             [ "receiver" .=
                               [ object
                                 [ "amount" .= m2PayPal (_amount p)
                                 , "email"  .= _receiverEmail p
                                 ]
                               ]
                             ]
    , "returnUrl"       .= ("https://example.com/" :: Text)
    , "cancelUrl"       .= ("https://example.com/" :: Text)
    , "requestEnvelope" .= requestEnvelope
    , "senderEmail"     .= accountEmail
    ]

-- | If a PayPal account doesn't exist yet PayPal responds with an empty
-- list of PayInfos. We return this as Left 'AePending'.
request :: Client -> Withdrawal -> IO (Either AdaptiveError (ByteString,PayResponse) )
request c w = do
  resp <- ppPost c "Pay" $ SerializeWithdrawal w (_clAccountEmail c)
  case resp of
    Left e    -> return $ Left e
    Right bts -> return $ (,) bts <$> ppDecode bts

$(makeLenses ''Withdrawal)