module Web.Stripe.Customer
( Customer(..)
, CustomerId(..)
, Email(..)
, createCustomer
, updateCustomer
, updateCustomerById
, getCustomer
, getCustomers
, delCustomer
, delCustomerById
, Count(..)
, Offset(..)
, Description(..)
, UTCTime(..)
, SConfig(..)
, StripeT(StripeT)
, runStripeT
) where
import Control.Applicative ( (<$>) )
import Control.Monad ( liftM, ap )
import Control.Monad.Error ( Error, MonadIO, MonadError, throwError, strMsg )
import Data.Maybe ( fromMaybe )
import Text.JSON ( Result(..), JSON(..), JSValue(..), resultToEither
, valFromObj
)
import Web.Stripe.Card ( Card, RequestCard, rCardKV )
import Web.Stripe.Client ( StripeT(..), SConfig(..), SRequest(..)
, StdMethod(..), baseSReq, query, runStripeT
)
import Web.Stripe.Coupon ( CpnId(..) )
import Web.Stripe.Plan ( PlanId(..) )
import Web.Stripe.Utils ( Count(..), Offset(..), Description(..)
, UTCTime(..), fromSeconds, jGet, mjGet
, optionalArgs
)
data Customer = Customer
{ custId :: CustomerId
, custEmail :: Email
, custDescription :: Maybe Description
, custLive :: Bool
, custCreated :: UTCTime
, custActiveCard :: Maybe Card
} deriving Show
newtype CustomerId = CustomerId { unCustomerId :: String } deriving Show
newtype Email = Email { unEmail :: String } deriving Show
createCustomer :: MonadIO m => Maybe RequestCard -> Maybe CpnId -> Maybe Email
-> Maybe Description -> Maybe PlanId -> Maybe Int
-> StripeT m Customer
createCustomer mrc mcid me md mpid mtime =
snd `liftM` query (customerRq []) { sMethod = POST, sData = fdata }
where
fdata = fromMaybe [] (rCardKV <$> mrc) ++ optionalArgs odata
odata = [ ("coupon", unCpnId <$> mcid)
, ("email", unEmail <$> me)
, ("description", unDescription <$> md)
, ("plan", unPlanId <$> mpid)
, ("trial_end", show <$> mtime)
]
updateCustomer :: MonadIO m => Customer -> Maybe RequestCard -> Maybe CpnId
-> Maybe Email -> Maybe Description -> StripeT m Customer
updateCustomer = updateCustomerById . custId
updateCustomerById :: MonadIO m => CustomerId -> Maybe RequestCard
-> Maybe CpnId -> Maybe Email -> Maybe Description
-> StripeT m Customer
updateCustomerById (CustomerId cid) mrc mcid me md =
snd `liftM` query (customerRq [cid]) { sMethod = POST, sData = fdata }
where
fdata = fromMaybe [] (rCardKV <$> mrc) ++ optionalArgs odata
odata = [ ("coupon", unCpnId <$> mcid)
, ("email", unEmail <$> me)
, ("description", unDescription <$> md)
]
getCustomer :: MonadIO m => CustomerId -> StripeT m Customer
getCustomer (CustomerId cid) =
return . snd =<< query (customerRq [cid])
getCustomers :: MonadIO m => Maybe Count -> Maybe Offset -> StripeT m [Customer]
getCustomers mc mo = do
(_, rsp) <- query $ (customerRq []) { sQString = qstring }
either err return . resultToEither . valFromObj "data" $ rsp
where
qstring = optionalArgs [ ("count", show . unCount <$> mc)
, ("offset", show . unOffset <$> mo)
]
err _ = throwError $ strMsg "Unable to parse customer list."
delCustomer :: MonadIO m => Customer -> StripeT m Bool
delCustomer = delCustomerById . custId
delCustomerById :: MonadIO m => CustomerId -> StripeT m Bool
delCustomerById (CustomerId cid) = query req >>=
either err return . resultToEither . valFromObj "deleted" . snd
where
err _ = throwError $ strMsg "Unable to parse customer delete."
req = (customerRq [cid]) { sMethod = DELETE }
customerRq :: [String] -> SRequest
customerRq pcs = baseSReq { sDestination = "customers":pcs }
instance JSON Customer where
readJSON (JSObject c) =
Customer `liftM` (CustomerId <$> jGet c "id")
`ap` (Email <$> jGet c "email")
`ap` ((Description <$>) <$> mjGet c "description")
`ap` jGet c "livemode"
`ap` (fromSeconds <$> jGet c "created")
`ap` mjGet c "active_card"
readJSON _ = Error "Unable to read Stripe customer."
showJSON _ = undefined