{-# LANGUAGE TemplateHaskell #-}
-- | Start the process of someone paying you. You have to redirect the payer's
-- browser to PayPal to finish it.
--
-- "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 Withdrawal).
--
-- It uses the "Explicit" payment approval type, meaning the payer must go to
-- PayPal in their browser to approve the payment. Here's an example payment
-- approval URL with a PayKey of "foo":
--
-- https://www.paypal.com/cgi-bin/webscr?cmd=_ap-payment&paykey=foo
module PayPal.Adaptive.Deposit 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 Deposit = Deposit
{ _amount :: Money
, _senderEmail :: Text
, _returnUrl :: Text
, _cancelUrl :: Text
} deriving (Eq, Show)
-- | For internal use.
data SerializeDeposit = SerializeDeposit Deposit Text
instance ToJSON SerializeDeposit where
toJSON (SerializeDeposit p accountEmail) = object
[ "actionType" .= ("PAY" :: Text)
, "currencyCode" .= m2Currency (_amount p)
, "receiverList" .= object
[ "receiver" .=
[ object
[ "amount" .= m2PayPal (_amount p)
, "email" .= accountEmail
]
]
]
, "returnUrl" .= _returnUrl p
, "cancelUrl" .= _cancelUrl p
, "requestEnvelope" .= requestEnvelope
, "senderEmail" .= _senderEmail p
]
request :: Client -> Deposit -> IO (Either AdaptiveError (ByteString,PayResponse) )
request c d = do
resp <- ppPost c "Pay" $ SerializeDeposit d (_clAccountEmail c)
case resp of
Left e -> return $ Left e
Right bts -> return $ (,) bts <$> ppDecode bts
approvalUrl :: Client -> PayKey -> Text
approvalUrl c k =
case _clEnvironment c of
Sandbox -> "https://www.sandbox.paypal.com/cgi-bin/webscr?cmd=_ap-payment&paykey=" <> _unPayKey k
Production -> "https://www.paypal.com/cgi-bin/webscr?cmd=_ap-payment&paykey=" <> _unPayKey k
$(makeLenses ''Deposit)