module Yesod.Payments.PayPal
( PayPalCredentials
, YesodPayPalState
, mkYesodPayPalState
, YesodPayPal(..)
, yesodExecPayPal
) where
import Data.IORef
import Data.Time.Clock
import Network.Payments.PayPal
import Network.Payments.PayPal.Auth
import Network.Payments.PayPal.Environment
import Yesod.Core
type PayPalCredentials = (EnvironmentUrl, ClientID, Secret)
data YesodPayPalState =
YesodPayPalState { yPpStToken :: IORef (AccessToken, UTCTime) }
mkYesodPayPalState :: PayPalCredentials -> IO (Maybe YesodPayPalState)
mkYesodPayPalState (envUrl, clientId, secret) = do
accessTokenOrErr <- fetchAccessTokenWithExpiration envUrl clientId secret
case accessTokenOrErr of
Left err -> return Nothing
Right accessToken -> do
ref <- newIORef accessToken
return $ Just $ YesodPayPalState ref
class Yesod site => YesodPayPal site where
yesodPayPalCredentials :: site -> PayPalCredentials
yesodPayPalState :: site -> YesodPayPalState
yesodExecPayPal :: (YesodPayPal site, FromJSON a) =>
PayPalOperations a -> HandlerT site IO (Either PayPalError a)
yesodExecPayPal operations = do
site <- getYesod
let (envUrl, clientId, secret) = yesodPayPalCredentials site
accessTokenRef = yPpStToken $ yesodPayPalState site
liftIO $ do
accessToken <- readIORef accessTokenRef
resultOrErr <- execPayPalOpers envUrl clientId secret accessToken operations
case resultOrErr of
Left err -> return $ Left err
Right (result, accessToken') -> do
writeIORef accessTokenRef accessToken'
return $ Right result