module Web.Stripe.Plan
( Plan(..)
, PlanInterval(..)
, PlanId(..)
, PlanTrialDays(..)
, createPlan
, getPlan
, getPlans
, delPlan
, delPlanById
, Amount(..)
, Count(..)
, Currency(..)
, Offset(..)
, SConfig(..)
, StripeT(StripeT)
, runStripeT
) where
import Control.Applicative ( (<$>) )
import Control.Monad ( liftM, ap )
import Control.Monad.Error ( MonadIO, throwError, strMsg )
import Data.Char ( toLower )
import Network.HTTP.Types ( StdMethod(..) )
import Text.JSON ( Result(Error), JSON(..), JSValue(JSObject)
, resultToEither, valFromObj
)
import Web.Stripe.Client ( StripeT(..), SConfig(..), SRequest(..), baseSReq
, query, query_, runStripeT
)
import Web.Stripe.Utils ( Amount(..), Count(..), Currency(..), Offset(..)
, jGet, mjGet, optionalArgs
)
data Plan = Plan
{ planId :: PlanId
, planAmount :: Amount
, planInterval :: PlanInterval
, planName :: String
, planCurrency :: Currency
, planTrialDays :: Maybe PlanTrialDays
} deriving Show
data PlanInterval = Monthly | Yearly | UnknownPlan String deriving Show
newtype PlanId = PlanId { unPlanId :: String } deriving Show
newtype PlanTrialDays = PlanTrialDays { unPlanTrialDays :: Int } deriving Show
createPlan :: MonadIO m => Plan -> StripeT m ()
createPlan p = query_ (planRq []) { sMethod = POST, sData = fdata }
where
fdata = pdata ++ optionalArgs odata
pdata = [ ("id", unPlanId $ planId p)
, ("amount", show . unAmount $ planAmount p)
, ("interval", fromPlanInterval $ planInterval p)
, ("name", planName p)
, ("currency", unCurrency $ planCurrency p)
]
odata = [ ( "trial_period_days"
, show . unPlanTrialDays <$> planTrialDays p
)
]
getPlan :: MonadIO m => PlanId -> StripeT m Plan
getPlan (PlanId pid) = return . snd =<< query (planRq [pid])
getPlans :: MonadIO m => Maybe Count -> Maybe Offset -> StripeT m [Plan]
getPlans mc mo = do
(_, rsp) <- query (planRq []) { sQString = qs }
either err return . resultToEither . valFromObj "data" $ rsp
where
qs = optionalArgs [ ("count", show . unCount <$> mc)
, ("offset", show . unOffset <$> mo)
]
err _ = throwError $ strMsg "Unable to parse plan list."
delPlan :: MonadIO m => Plan -> StripeT m Bool
delPlan = delPlanById . planId
delPlanById :: MonadIO m => PlanId -> StripeT m Bool
delPlanById (PlanId pid) = query req >>=
either err return . resultToEither . valFromObj "deleted" . snd
where
err _ = throwError $ strMsg "Unable to parse plan delete."
req = (planRq [pid]) { sMethod = DELETE }
planRq :: [String] -> SRequest
planRq pcs = baseSReq { sDestination = "plans":pcs }
fromPlanInterval :: PlanInterval -> String
fromPlanInterval Monthly = "month"
fromPlanInterval Yearly = "year"
fromPlanInterval (UnknownPlan p) = p
toPlanInterval :: String -> PlanInterval
toPlanInterval p = case map toLower p of
"month" -> Monthly
"year" -> Yearly
_ -> UnknownPlan p
instance JSON Plan where
readJSON (JSObject c) =
Plan `liftM` (PlanId <$> jGet c "id")
`ap` (Amount <$> jGet c "amount")
`ap` (toPlanInterval <$> jGet c "interval")
`ap` jGet c "name"
`ap` (Currency <$> jGet c "currency")
`ap` ((PlanTrialDays <$>) <$> mjGet c "trial_period_days")
readJSON _ = Error "Unable to read Stripe plan."
showJSON _ = undefined