module Network.PayPal.NVP (
Service,
sandbox,
live,
submit,
prepareRequest,
processResponse
) where
import Network.PayPal.Types as PayPal
import Control.Applicative
import Control.Arrow
import Control.Failure
import Control.Monad
import Control.Monad.Trans
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy as L
import Data.Maybe
import Data.Monoid
import Network.HTTP.Conduit as HTTP
import Network.HTTP.Types as HTTP
import System.IO.Unsafe
import Data.Conduit
import qualified Network.Wai as W
data Service = Service (HTTP.Request IO) (HTTP.Request IO)
sandbox :: Service
sandbox = Service
(unsafePerformIO $ parseUrl "https://api-3t.sandbox.paypal.com/nvp")
(unsafePerformIO $ parseUrl "https://api.sandbox.paypal.com/nvp")
live :: Service
live = Service
(unsafePerformIO $ parseUrl "https://api-3t.paypal.com/nvp")
(unsafePerformIO $ parseUrl "https://api.paypal.com/nvp")
submit :: (Failure HttpException m, MonadIO m, PayPalRequest req) =>
Service
-> Credentials
-> req
-> m (Either (Response L.ByteString) (PayPal.Status (PayPalResponse req)))
submit service cred req = do
res <- liftIO $ withManager $ httpLbs (prepareRequest service cred req)
processResponse req res
prepareRequest :: (Monad m, PayPalRequest req) =>
Service
-> Credentials
-> req
-> HTTP.Request m
prepareRequest (Service url _) (Credentials user pwd (Signature sig) version) req =
urlEncodedBody vars url
where
vars =
[("USER", user),
("PWD", pwd),
("VERSION", version),
("SIGNATURE", sig)] ++ toVariables req
processResponse :: (PayPalRequest req, MonadIO m) =>
req
-> Response L.ByteString
-> m (Either (Response L.ByteString) (PayPal.Status (PayPalResponse req)))
processResponse req res = do
let Status statusCode _ = responseStatus res
body = responseBody res
return $ case statusCode of
200 -> Right . decodeResponseChecking
. map (second (fromMaybe mempty))
. parseQuery
. (mconcat . L.toChunks) $ body
_ -> Left res