module Web.Stripe.Subscription
( Subscription(..)
, SubStatus(..)
, SubProrate(..)
, SubTrialEnd(..)
, SubAtPeriodEnd(..)
, updateSubRCard
, updateSubToken
, cancelSub
, UTCTime(..)
, SConfig(..)
, StripeT(StripeT)
, runStripeT
) where
import Control.Applicative ( (<$>) )
import Control.Monad ( liftM, ap )
import Control.Monad.Error ( MonadIO )
import Data.Char ( toLower )
import Network.HTTP.Types ( StdMethod(..) )
import Text.JSON ( Result(Error), JSON(..), JSValue(JSObject) )
import Web.Stripe.Card ( RequestCard, rCardKV )
import Web.Stripe.Client ( StripeT(..), SConfig(..), SRequest(..), baseSReq
, query, runStripeT
)
import Web.Stripe.Coupon ( CpnId(..) )
import Web.Stripe.Customer ( CustomerId(..) )
import Web.Stripe.Token ( TokenId(..) )
import Web.Stripe.Plan ( Plan, PlanId(..) )
import Web.Stripe.Utils ( UTCTime(..), fromSeconds, jGet, optionalArgs )
data Subscription = Subscription
{ subCustomerId :: CustomerId
, subPlan :: Plan
, subStatus :: SubStatus
, subStart :: UTCTime
, subTrialStart :: UTCTime
, subTrialEnd :: UTCTime
, subPeriodStart :: UTCTime
, subPeriodEnd :: UTCTime
} deriving Show
data SubStatus = Trialing | Active | PastDue | Unpaid | Canceled
| UnknownStatus String deriving Show
newtype SubProrate = SubProrate { unSubProrate :: Bool } deriving Show
newtype SubTrialEnd = SubTrialEnd { unSubTrialEnd :: Int } deriving Show
newtype SubAtPeriodEnd = SubAtPeriodEnd { unSubAtPeriodEnd :: Bool }
deriving Show
updateSubRCard :: MonadIO m => RequestCard -> CustomerId -> PlanId
-> Maybe CpnId -> Maybe SubProrate -> Maybe SubTrialEnd
-> StripeT m Subscription
updateSubRCard = updateSub . rCardKV
updateSubToken :: MonadIO m => TokenId -> CustomerId -> PlanId -> Maybe CpnId
-> Maybe SubProrate -> Maybe SubTrialEnd
-> StripeT m Subscription
updateSubToken (TokenId tid) = updateSub [("token", tid)]
updateSub :: MonadIO m => [(String, String)] -> CustomerId -> PlanId
-> Maybe CpnId -> Maybe SubProrate -> Maybe SubTrialEnd
-> StripeT m Subscription
updateSub sdata cid pid mcpnid mspr mste =
snd `liftM` query (subRq cid []) { sMethod = POST, sData = fdata }
where
fdata = ("plan", unPlanId pid) : sdata ++ optionalArgs odata
odata = [ ("coupon", unCpnId <$> mcpnid)
, ("prorate", show . unSubProrate <$> mspr)
, ("trial_end", show . unSubTrialEnd <$> mste)
]
cancelSub :: MonadIO m => CustomerId -> Maybe SubAtPeriodEnd
-> StripeT m Subscription
cancelSub cid mspe = snd `liftM`
query (subRq cid []) { sMethod = DELETE, sData = optionalArgs odata }
where odata = [("at_period_end", show . unSubAtPeriodEnd <$> mspe)]
subRq :: CustomerId -> [String] -> SRequest
subRq (CustomerId cid) pcs =
baseSReq { sDestination = "customers":cid:"subscription":pcs }
toSubStatus :: String -> SubStatus
toSubStatus s = case map toLower s of
"trialing" -> Trialing
"active" -> Active
"past_due" -> PastDue
"canceled" -> Canceled
"unpaid" -> Unpaid
_ -> UnknownStatus s
instance JSON Subscription where
readJSON (JSObject c) =
Subscription `liftM` (CustomerId <$> jGet c "customer")
`ap` jGet c "plan"
`ap` (toSubStatus <$> jGet c "status")
`ap` (fromSeconds <$> jGet c "start")
`ap` (fromSeconds <$> jGet c "trial_start")
`ap` (fromSeconds <$> jGet c "trial_end")
`ap` (fromSeconds <$> jGet c "current_period_start")
`ap` (fromSeconds <$> jGet c "current_period_end")
readJSON _ = Error "Unable to read Stripe subscription."
showJSON _ = undefined