module PayPal.Adaptive.Core.Internal where
import Control.Exception
import Data.ByteString.Lazy (ByteString)
import qualified Data.Text as T
import Data.Text.Encoding
import Network.Wreq
import Import
import PayPal.Adaptive.Core.Client
import PayPal.Adaptive.Core.Error
import PayPal.Adaptive.Core.PayResponse
ppPost :: (ToJSON a) => Client -> Text -> a -> IO (Either AdaptiveError ByteString)
ppPost c endpoint p = catch (return . Right . (^.responseBody) =<< runPost) handler
where
runPost :: IO (Response ByteString)
runPost = postWith opts (clBaseUrl <> T.unpack endpoint) (toJSON p)
clBaseUrl :: String
clBaseUrl =
case _clEnvironment c of
Sandbox -> "https://svcs.sandbox.paypal.com/AdaptivePayments/"
Production -> "https://svcs.paypal.com/AdaptivePayments/"
handler :: SomeException -> IO (Either AdaptiveError ByteString)
handler e = return . Left . AeConnectionError $ e
opts :: Options
opts = defaults
& header "X-PAYPAL-SECURITY-USERID" .~ [ encodeUtf8 (_clUserId c) ]
& header "X-PAYPAL-SECURITY-PASSWORD" .~ [ encodeUtf8 (_clPassword c) ]
& header "X-PAYPAL-SECURITY-SIGNATURE" .~ [ encodeUtf8 (_clSignature c) ]
& header "X-PAYPAL-APPLICATION-ID" .~ [ encodeUtf8 (_clAppId c) ]
& header "X-PAYPAL-REQUEST-DATA-FORMAT" .~ [ "JSON" ]
& header "X-PAYPAL-RESPONSE-DATA-FORMAT" .~ [ "JSON" ]
ppDecode :: ByteString -> Either AdaptiveError PayResponse
ppDecode b =
case eitherDecode b of
Right d -> Right d
Left e ->
case decode b of
Just res@(ErrorResponse _) -> Left $ AeErrorResponse b res
_ -> Left $ AeDecodeFailed b (T.pack e)
requestEnvelope :: Value
requestEnvelope = object ["errorLanguage" .= ("en_US" :: Text)]