{-# 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)