Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Made fee of type Amount. Added "createCustomerToken" function to Conn…

…ect.
  • Loading branch information...
commit bc0cf642ad88771b118d711a1fcf13a80ab3b460 1 parent 2a7ad28
@LukeHoersten authored
View
22 src/Web/Stripe/Charge.hs
@@ -56,7 +56,7 @@ data Charge = Charge
, chargeDescription :: Maybe Description
, chargeCurrency :: Currency
, chargeAmount :: Amount
- , chargeFee :: Int
+ , chargeFee :: Amount
, chargeLive :: Bool
, chargePaid :: Bool
, chargeRefunded :: Bool
@@ -68,41 +68,43 @@ newtype ChargeId = ChargeId { unChargeId :: T.Text } deriving Show
-- | Submit a 'Charge' to the Stripe API using an already constructed 'Token'.
chargeToken :: MonadIO m => Token -> Amount -> Currency
- -> Maybe Description -> StripeT m Charge
+ -> Maybe Description -> Maybe Amount -> StripeT m Charge
chargeToken = chargeTokenById . tokId
-- | Submit a 'Charge' to the Stripe API using a 'TokenId'.
chargeTokenById :: MonadIO m => TokenId -> Amount -> Currency
- -> Maybe Description -> StripeT m Charge
+ -> Maybe Description -> Maybe Amount -> StripeT m Charge
chargeTokenById (TokenId tid) = charge [("card", textToByteString tid)]
-- | Submit a 'Charge' to the Stripe for a specific 'Customer' that already has
-- payment details on file.
chargeCustomer :: MonadIO m => Customer -> Amount -> Currency
- -> Maybe Description -> StripeT m Charge
+ -> Maybe Description -> Maybe Amount -> StripeT m Charge
chargeCustomer = chargeCustomerById . custId
-- | Submit a 'Charge' to the Stripe for a specific 'Customer', identified by
-- its 'CustomerId', that already has payment details on file.
chargeCustomerById :: MonadIO m => CustomerId -> Amount -> Currency
- -> Maybe Description -> StripeT m Charge
+ -> Maybe Description -> Maybe Amount -> StripeT m Charge
chargeCustomerById (CustomerId cid) = charge [("customer", textToByteString cid)]
-- | Submit a 'Charge' to the Stripe API using a 'RequestCard' to describe
-- payment details.
chargeRCard :: MonadIO m => RequestCard -> Amount -> Currency
- -> Maybe Description -> StripeT m Charge
+ -> Maybe Description -> Maybe Amount -> StripeT m Charge
chargeRCard rc = charge (rCardKV rc)
-- | Internal convenience function to handle actually submitting a 'Charge'
-- request to the Stripe API.
charge :: MonadIO m => [(B.ByteString, B.ByteString)] -> Amount -> Currency
- -> Maybe Description -> StripeT m Charge
-charge adata a c mcd =
+ -> Maybe Description -> Maybe Amount -> StripeT m Charge
+charge adata a c mcd maf =
snd `liftM` query (chargeRq []) { sMethod = POST, sData = fdata }
where
fdata = optionalArgs odata ++ adata ++ bdata
- odata = [ ("description", textToByteString . unDescription <$> mcd) ]
+ odata = [ ("description", textToByteString . unDescription <$> mcd)
+ , ("application_fee", showByteString . unAmount <$> maf)
+ ]
bdata = [ ("amount", showByteString . unAmount $ a)
, ("currency", textToByteString $ unCurrency c)
]
@@ -171,7 +173,7 @@ instance FromJSON Charge where
<*> ((Description <$>) <$> v .:? "description")
<*> (Currency <$> v .: "currency")
<*> (Amount <$> v .: "amount")
- <*> v .: "fee"
+ <*> (Amount <$> v .: "fee")
<*> v .: "livemode"
<*> v .: "paid"
<*> v .: "refunded"
View
4 src/Web/Stripe/Client.hs
@@ -208,12 +208,12 @@ query' sReq = do
-- > query baseSReq { sDestination = ["charges"] }
query :: (MonadIO m, FromJSON a) => StripeRequest -> StripeT m (StripeResponseCode, a)
query req = query' req >>= \(code, ans) ->
- either (throwError . strMsg) (return . (code, )) $ eitherDecode' ans
+ either (throwError . strMsg . ("JSON parse error: " ++)) (return . (code, )) $ eitherDecode' ans
-- | same as `query` but pulls out the value inside a data field and returns that
queryData :: (MonadIO m, FromJSON a) => StripeRequest -> StripeT m (StripeResponseCode, a)
queryData req = query' req >>= \(code, ans) -> do
- val <- either (throwError . strMsg) return $ eitherDecode' ans
+ val <- either (throwError . strMsg . ("JSON parse error: " ++)) return $ eitherDecode' ans
case val of
Object o -> do
objVal <- maybe (throwError $ strMsg "no data in json" ) return $
View
53 src/Web/Stripe/Connect.hs
@@ -4,16 +4,24 @@
module Web.Stripe.Connect
( authURL
, getAccessToken
+ , createCustomerToken
- , APIKey(..)
- , StripeConnectTokens(..)
+ , APIKey (..)
+ , StripeConnectTokens (..)
+ , Scope (..)
+ , Landing (..)
, AuthCode
+ , AccessToken
+ , RefreshToken
+ , UserId
+ , ClientId
) where
import Control.Applicative ((<$>), (<*>))
import Control.Exception (Exception, SomeException (..))
-import Control.Monad (mzero)
+import Control.Monad (liftM, mzero)
+import Control.Monad.Error (MonadIO)
import Data.Aeson (FromJSON (..), Value (..), decode, (.:))
import Data.ByteString.Char8 (ByteString, pack)
import qualified Data.ByteString.Char8 as B
@@ -22,10 +30,13 @@ import Data.Text.Encoding (encodeUtf8)
import Data.Typeable (Typeable)
import Network.HTTP.Conduit (Request (..), Response (..), httpLbs,
parseUrl, urlEncodedBody, withManager)
-import Network.HTTP.Types (Query, Status (..), hAccept,
- renderQuery)
-import Web.Stripe.Client (APIKey (..))
-import Web.Stripe.Utils (optionalArgs)
+import Network.HTTP.Types (Query, Status (..), StdMethod (..),
+ hAccept, renderQuery)
+import Web.Stripe.Client (APIKey (..), StripeRequest (..),
+ StripeT, query)
+import Web.Stripe.Customer (CustomerId (..))
+import Web.Stripe.Token (Token, tokRq)
+import Web.Stripe.Utils (optionalArgs, textToByteString)
type URL = ByteString
@@ -35,7 +46,8 @@ type UserId = ByteString
type ClientId = ByteString
type AuthCode = ByteString
-data StripeConnectException = StripeConnectException String deriving (Show, Eq, Typeable)
+newtype StripeConnectException = StripeConnectException String deriving (Show, Eq, Typeable)
+
data Scope = ReadOnly | ReadWrite
data Landing = Login | Register
data StripeConnectTokens = StripeConnectTokens
@@ -48,14 +60,14 @@ data StripeConnectTokens = StripeConnectTokens
-- URIs ------------------------------------------------------------------------
authURL :: ClientId -> Maybe Scope -> Maybe Text -> Maybe Landing -> URL
authURL clientId mScope mState mLanding =
- B.append "https://connect.stripe.com/oauth/authorize" query
- where query = renderQuery True
- [ ("response_type", Just "code")
- , ("client_id", Just clientId)
- , ("scope", pack . show <$> mScope)
- , ("state", encodeUtf8 <$> mState)
- , ("stripe_landing", pack . show <$> mLanding)
- ]
+ B.append "https://connect.stripe.com/oauth/authorize" q
+ where q = renderQuery True
+ [ ("response_type", Just "code")
+ , ("client_id", Just clientId)
+ , ("scope", pack . show <$> mScope)
+ , ("state", encodeUtf8 <$> mState)
+ , ("stripe_landing", pack . show <$> mLanding)
+ ]
accessTokenURL :: URL
@@ -101,6 +113,15 @@ statusCodeChecker s@(Status c _) h
| otherwise = Just . SomeException . StripeConnectException $ show s ++ show h
+
+-- Stripe API ---------------------------------------------------------------------
+createCustomerToken :: MonadIO m => CustomerId -> StripeT m Token
+createCustomerToken cid =
+ snd `liftM` query (tokRq []) { sMethod = POST, sData = fdata }
+ where
+ fdata = [("customer", textToByteString $ unCustomerId cid)]
+
+
-- Instances ----------------------------------------------------------------------
instance Show Scope where
show ReadOnly = "read_only"
View
11 src/Web/Stripe/Token.hs
@@ -5,6 +5,7 @@ module Web.Stripe.Token
, TokenId(..)
, createToken
, getToken
+ , tokRq
{- Re-Export -}
, UTCTime(..)
@@ -19,7 +20,7 @@ module Web.Stripe.Token
import Control.Applicative ((<$>), (<*>))
import Control.Monad (liftM, mzero)
import Control.Monad.Error (MonadIO)
-import Data.Aeson (FromJSON (..), Value (..), (.:))
+import Data.Aeson (FromJSON (..), Value (..), (.:), (.:?))
import qualified Data.Text as T
import Network.HTTP.Types (StdMethod (..))
import Web.Stripe.Card (Card (..), RequestCard (..), rCardKV)
@@ -39,8 +40,8 @@ data Token = Token
, tokLive :: Bool
, tokUsed :: Bool
, tokCreated :: UTCTime
- , tokAmount :: Amount
- , tokCurrency :: Currency
+ , tokAmount :: Maybe Amount
+ , tokCurrency :: Maybe Currency
, tokCard :: Card
} deriving Show
@@ -77,7 +78,7 @@ instance FromJSON Token where
<*> o .: "livemode"
<*> o .: "used"
<*> (fromSeconds <$> o .: "created")
- <*> (Amount <$> o .: "amount")
- <*> (Currency <$> o .: "currency")
+ <*> ((Amount <$>) <$> o .:? "amount")
+ <*> ((Currency <$>) <$> o .:? "currency")
<*> o .: "card"
parseJSON _ = mzero
Please sign in to comment.
Something went wrong with that request. Please try again.