module Web.Stripe.Charge
( Charge(..)
, ChargeId(..)
, chargeToken
, chargeTokenById
, chargeCustomer
, chargeCustomerById
, chargeRCard
, getCharge
, getCharges
, partialRefund
, partialRefundById
, fullRefund
, fullRefundById
, Amount(..)
, Count(..)
, Currency(..)
, Description(..)
, Offset(..)
, UTCTime(..)
, SConfig(..)
, StripeT(StripeT)
, runStripeT
) where
import Control.Applicative ( (<$>) )
import Control.Monad ( liftM, ap )
import Control.Monad.Error ( MonadIO, throwError, strMsg )
import Network.HTTP.Types ( StdMethod(..) )
import Text.JSON ( Result(Error), JSON(..), JSValue(JSObject)
, resultToEither, valFromObj
)
import Web.Stripe.Card ( Card, RequestCard, rCardKV )
import Web.Stripe.Customer ( Customer(..), CustomerId(..) )
import Web.Stripe.Client ( StripeT(..), SConfig(..), SRequest(..), baseSReq
, query, runStripeT
)
import Web.Stripe.Token ( Token(..), TokenId(..) )
import Web.Stripe.Utils ( Amount(..), Count(..), Currency(..)
, Description(..), Offset(..), UTCTime(..)
, fromSeconds, jGet, mjGet, optionalArgs
)
data Charge = Charge
{ chargeId :: ChargeId
, chargeCreated :: UTCTime
, chargeDescription :: Maybe Description
, chargeCurrency :: Currency
, chargeAmount :: Amount
, chargeFee :: Int
, chargeLive :: Bool
, chargePaid :: Bool
, chargeRefunded :: Bool
, chargeCard :: Card
} deriving Show
newtype ChargeId = ChargeId { unChargeId :: String } deriving Show
chargeToken :: MonadIO m => Token -> Amount -> Currency
-> Maybe Description -> StripeT m Charge
chargeToken = chargeTokenById . tokId
chargeTokenById :: MonadIO m => TokenId -> Amount -> Currency
-> Maybe Description -> StripeT m Charge
chargeTokenById (TokenId tid) = charge [("card", tid)]
chargeCustomer :: MonadIO m => Customer -> Amount -> Currency
-> Maybe Description -> StripeT m Charge
chargeCustomer = chargeCustomerById . custId
chargeCustomerById :: MonadIO m => CustomerId -> Amount -> Currency
-> Maybe Description -> StripeT m Charge
chargeCustomerById (CustomerId cid) = charge [("customer", cid)]
chargeRCard :: MonadIO m => RequestCard -> Amount -> Currency
-> Maybe Description -> StripeT m Charge
chargeRCard rc = charge (rCardKV rc)
charge :: MonadIO m => [(String, String)] -> Amount -> Currency
-> Maybe Description -> StripeT m Charge
charge adata a c mcd =
snd `liftM` query (chargeRq []) { sMethod = POST, sData = fdata }
where
fdata = head (optionalArgs odata) : adata ++ bdata
odata = [ ("description", unDescription <$> mcd) ]
bdata = [ ("amount", show . unAmount $ a)
, ("currency", unCurrency c)
]
getCharge :: MonadIO m => ChargeId -> StripeT m Charge
getCharge (ChargeId cid) = snd `liftM` query (chargeRq [cid])
getCharges :: MonadIO m => Maybe CustomerId -> Maybe Count -> Maybe Offset
-> StripeT m [Charge]
getCharges mcid mc mo = do
(_, rsp) <- query $ (chargeRq []) { sQString = optionalArgs oqs }
either err return . resultToEither . valFromObj "data" $ rsp
where
oqs = [ ("count", show . unCount <$> mc)
, ("offset", show . unOffset <$> mo)
, ("customer", unCustomerId <$> mcid)
]
err _ = throwError $ strMsg "Unable to parse charge list."
partialRefund :: MonadIO m => Charge -> Amount -> StripeT m Charge
partialRefund = partialRefundById . chargeId
partialRefundById :: MonadIO m => ChargeId -> Amount -> StripeT m Charge
partialRefundById cid = refundChargeById cid . Just
fullRefund :: MonadIO m => Charge -> StripeT m Charge
fullRefund = fullRefundById . chargeId
fullRefundById :: MonadIO m => ChargeId -> StripeT m Charge
fullRefundById cid = refundChargeById cid Nothing
refundChargeById :: MonadIO m => ChargeId -> Maybe Amount -> StripeT m Charge
refundChargeById (ChargeId cid) ma =
snd `liftM` query (chargeRq [cid, "refund"]) { sMethod = POST, sData = fd }
where fd = optionalArgs [("amount", show . unAmount <$> ma)]
chargeRq :: [String] -> SRequest
chargeRq pcs = baseSReq { sDestination = "charges":pcs }
instance JSON Charge where
readJSON (JSObject c) =
Charge `liftM` (ChargeId <$> jGet c "id")
`ap` (fromSeconds <$> jGet c "created")
`ap` ((Description <$>) <$> mjGet c "description")
`ap` (Currency <$> jGet c "currency")
`ap` (Amount <$> jGet c "amount")
`ap` jGet c "fee"
`ap` jGet c "livemode"
`ap` jGet c "paid"
`ap` jGet c "refunded"
`ap` jGet c "card"
readJSON _ = Error "Unable to read Stripe charge."
showJSON _ = undefined