diff --git a/src/Web/Stripe/Bitcoin.hs b/src/Web/Stripe/Bitcoin.hs new file mode 100644 --- /dev/null +++ b/src/Web/Stripe/Bitcoin.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE OverloadedStrings #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Bitcoin +-- Copyright : (c) David Johnson, 2015 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https://stripe.com/docs/api#bitcoin_receivers > +-- < https://stripe.com/docs/guides/bitcoin > +-- +-- @ +-- import Web.Stripe +-- import Web.Stripe.Bitcoin +-- +-- main :: IO () +-- main = do +-- let config = SecretKey "secret_key" +-- result <- stripe config listAllReceivers +-- case result of +-- Right receivers -> print receivers +-- Left stripeError -> print stripeError +-- @ +module Web.Stripe.Bitcoin + ( -- * API + createReceiver + , getReceiver + , listReceivers + -- * Types + , BitcoinReceiver (..) + , BitcoinReceiverId (..) + , BitcoinTransaction (..) + , BitcoinTransactionId (..) + , Email (..) + , StripeList (..) + ) where + +import Web.Stripe.Client.Internal ( Method (GET, POST) + , Stripe + , StripeRequest (..) + , () + , callAPI + , getParams + , toText ) +import Web.Stripe.Types + +------------------------------------------------------------------------------ +-- | Retrieve the object that represents your Stripe account +createReceiver + :: Integer -- ^ Amount + -> Email -- ^ Email + -> Stripe BitcoinReceiver +createReceiver amount (Email email) = callAPI request + where request = StripeRequest POST url params + url = "bitcoin/receivers" + params = getParams [ ("currency", Just "usd") + , ("amount", Just $ toText amount ) + , ("email", Just email ) + ] + +------------------------------------------------------------------------------ +-- | Retrieve a `BitcoinReceiver` +getReceiver + :: BitcoinReceiverId + -> Stripe BitcoinReceiver +getReceiver (BitcoinReceiverId receiverId) = callAPI request + where request = StripeRequest GET url params + url = "bitcoin/receivers" receiverId + params = [] + +------------------------------------------------------------------------------ +-- | Retrieve a list of `BitcoinReceiver`s +listReceivers + :: Maybe Limit -- ^ Defaults to 10 if `Nothing` specified + -> StartingAfter BitcoinReceiverId -- ^ Paginate starting after the following `BitcoinReceiverId` + -> EndingBefore BitcoinReceiverId -- ^ Paginate ending before the following `BitcoinReceiverId` + -> Stripe (StripeList BitcoinReceiver) +listReceivers + limit + startingAfter + endingBefore = callAPI request + where + request = StripeRequest GET url params + url = "bitcoin/receivers" + params = getParams [ + ("limit", toText `fmap` limit ) + , ("starting_after", (\(BitcoinReceiverId x) -> x) `fmap` startingAfter) + , ("ending_before", (\(BitcoinReceiverId x) -> x) `fmap` endingBefore) + ] diff --git a/src/Web/Stripe/Subscription.hs b/src/Web/Stripe/Subscription.hs --- a/src/Web/Stripe/Subscription.hs +++ b/src/Web/Stripe/Subscription.hs @@ -150,17 +150,20 @@ :: CustomerId -- ^ The `CustomerId` of the `Subscription` to update -> SubscriptionId -- ^ The `SubscriptionId` of the `Subscription` to update -> Maybe CouponId -- ^ Optional: The `Coupon` of the `Subscription` to update + -> Maybe PlanId -- ^ Optional: The id `Plan` to switch the `Subscription` to -> MetaData -> Stripe Subscription updateSubscription customerid (SubscriptionId subscriptionid) couponid + planid metadata = callAPI request where request = StripeRequest POST url params url = "customers" getCustomerId customerid "subscriptions" subscriptionid params = toMetaData metadata ++ getParams [ - ("coupon", (\(CouponId x) -> x) `fmap` couponid) + ("coupon", (\(CouponId x) -> x) `fmap` couponid) + , ("plan", (\(PlanId x) -> x) `fmap` planid) ] ------------------------------------------------------------------------------ diff --git a/src/Web/Stripe/Types.hs b/src/Web/Stripe/Types.hs --- a/src/Web/Stripe/Types.hs +++ b/src/Web/Stripe/Types.hs @@ -2070,3 +2070,136 @@ parseJSON (String "zar") = pure ZAR parseJSON (String "zmw") = pure ZMW parseJSON _ = pure UnknownCurrency + +------------------------------------------------------------------------------ +-- | BTC ReceiverObject +data BitcoinReceiver = BitcoinReceiver { + btcId :: BitcoinReceiverId + , btcObject :: Text + , btcCreated :: UTCTime + , btcLiveMode :: Bool + , btcActive :: Bool + , btcAmount :: Integer + , btcAmountReceived :: Integer + , btcBitcoinAmount :: Integer + , btcBitcoinAmountReceived :: Integer + , btcBitcoinUri :: Text + , btcCurrency :: Currency + , btcFilled :: Bool + , btcInboundAddress :: Text + , btcUncapturedFunds :: Bool + , btcDescription :: Maybe Text + , btcEmail :: Text + , btcMetadata :: MetaData + , btcRefundAddress :: Maybe Text + , btcTransactions :: Maybe Transactions + , btcPayment :: Maybe PaymentId + , btcCustomer :: Maybe CustomerId + } deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | FromJSON for BitcoinReceiverId +instance FromJSON BitcoinReceiver where + parseJSON (Object o) = + BitcoinReceiver <$> (BitcoinReceiverId <$> o .: "id") + <*> o .: "object" + <*> (fromSeconds <$> o .: "created") + <*> o .: "livemode" + <*> o .: "active" + <*> o .: "amount" + <*> o .: "amount_received" + <*> o .: "bitcoin_amount" + <*> o .: "bitcoin_amount_received" + <*> o .: "bitcoin_uri" + <*> o .: "currency" + <*> o .: "filled" + <*> o .: "inbound_address" + <*> o .: "uncaptured_funds" + <*> o .:? "description" + <*> o .: "email" + <*> (H.toList <$> o .: "metadata") + <*> o .:? "refund_address" + <*> o .:? "transactions" + <*> (fmap PaymentId <$> o .:? "payment") + <*> (fmap CustomerId <$> o .:? "customer") + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | Bitcoin Transactions +data Transactions = Transactions { + transactionsObject :: Text + , transactionsTotalCount :: Integer + , transactionsHasMore :: Bool + , transactionsURL :: Text + , transactions :: [BitcoinTransaction] + } deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Bitcoin Transactions data +instance FromJSON Transactions where + parseJSON (Object o) = + Transactions <$> o .: "object" + <*> o .: "total_count" + <*> o .: "has_more" + <*> o .: "url" + <*> o .: "data" + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | Bitcoin Transaction +data BitcoinTransaction = BitcoinTransaction { + btcTransactionId :: BitcoinTransactionId + , btcTransactionObject :: Text + , btcTransactionCreated :: UTCTime + , btcTransactionAmount :: Integer + , btcTransactionBitcoinAmount :: Integer + , btcTransactionCurrency :: Currency + , btcTransactionReceiver :: BitcoinReceiverId + } deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | FromJSON BitcoinTransaction +instance FromJSON BitcoinTransaction where + parseJSON (Object o) = + BitcoinTransaction <$> o .: "id" + <*> o .: "object" + <*> (fromSeconds <$> o .: "created") + <*> o .: "amount" + <*> o .: "bitcoin_amount" + <*> o .: "currency" + <*> o .: "receiver" + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | BitcoinTransactionId +newtype BitcoinTransactionId = + BitcoinTransactionId Text + deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | FromJSON BitcoinTransactionId +instance FromJSON BitcoinTransactionId where + parseJSON (String o) = pure $ BitcoinTransactionId o + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | BTC ReceiverId +newtype BitcoinReceiverId = BitcoinReceiverId Text + deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | FromJSON for BitcoinReceiverId +instance FromJSON BitcoinReceiverId where + parseJSON (String x) = pure $ BitcoinReceiverId x + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | BTC PaymentId +newtype PaymentId = PaymentId Text + deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | FromJSON for PaymentId +instance FromJSON PaymentId where + parseJSON (String x) = pure $ PaymentId x + parseJSON _ = mzero diff --git a/stripe-haskell.cabal b/stripe-haskell.cabal --- a/stripe-haskell.cabal +++ b/stripe-haskell.cabal @@ -1,5 +1,5 @@ name: stripe-haskell -version: 0.1.1.2 +version: 0.1.3.0 synopsis: Stripe API for Haskell license: MIT license-file: LICENSE @@ -112,9 +112,10 @@ , base >=4.6 && <4.8 , bytestring , either - , http-streams , hspec >= 2.1.4 + , http-streams , random + , random >= 1.1 , stripe-haskell , text , time @@ -132,6 +133,7 @@ , http-streams , io-streams , mtl >= 2.1.3.1 + , random >= 1.1 , text , time , transformers @@ -151,6 +153,7 @@ Web.Stripe.ApplicationFee Web.Stripe.ApplicationFeeRefund Web.Stripe.Balance + Web.Stripe.Bitcoin Web.Stripe.Card Web.Stripe.Charge Web.Stripe.Coupon diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -2,9 +2,8 @@ {-# LANGUAGE RecordWildCards #-} module Main where -import Test.Hspec (hspec) +import Test.Hspec (hspec,parallel) import Test.Config (getConfig) - import Test.Account (accountTests) import Test.ApplicationFee (applicationFeeTests) import Test.ApplicationFeeRefund (applicationFeeRefundTests) @@ -25,14 +24,16 @@ import Test.Transfer (transferTests) import Test.Raw (rawTest) import Test.Event (eventTests) +import Test.Bitcoin (bitcoinTests) ------------------------------------------------------------------------------ -- | Main test function entry point main :: IO () main = do config <- getConfig - hspec $ do + hspec $ parallel $ do rawTest config + bitcoinTests config chargeTests config refundTests config customerTests config