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 Control.Lens         hiding ((.=))
import Data.Aeson
import Data.Text            (Text)
import PayPal.Adaptive.Core

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'.
req :: Client -> Withdrawal -> IO (Either AdaptiveErr CompletePayResp)
req c w = do
  resp <- ppPost c "Pay" $ SerializeWithdrawal w (_clAccountEmail c)
  return $ checkComplete =<< ppDecode =<< resp

-- * Lenses
$(makeLenses ''Withdrawal)