module PayPal.Adaptive.Deposit where
import Control.Lens hiding ((.=))
import Data.Aeson
import Data.Monoid
import Data.Text (Text)
import PayPal.Adaptive.Core
data Deposit = Deposit
{ _amount :: Money
, _senderEmail :: Text
, _returnUrl :: Text
, _cancelUrl :: Text
} deriving (Eq, Show)
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
]
req :: Client -> Deposit -> IO (Either AdaptiveErr PayKey)
req c d = do
resp <- ppPost c "Pay" $ SerializeDeposit d (_clAccountEmail c)
return $ do
pr <- ppDecode =<< resp
payExecStatusCreated pr
noPayInfo pr
errorFieldNothing pr
checkPayKey pr
Right (_prPayKey pr)
approvalUrl :: Client -> PayKey -> Text
approvalUrl c k =
case _clEnv 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)