{-# LANGUAGE MultiWayIf #-}

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 -- If the response isn't a PayResponse, it might be a PayPal error message.
        Just res@(ErrorResponse _) -> Left $ AeErrorResponse b res
        _                          -> Left $ AeDecodeFailed b (T.pack e)

-- | "en_US" is hardcoded because it's the only supported error language.
requestEnvelope :: Value
requestEnvelope = object ["errorLanguage" .= ("en_US" :: Text)]