From da36176f8bde714e291b6fdb7d33987ba82b690b Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Mon, 2 Sep 2019 20:39:31 +0200 Subject: [PATCH 01/44] wrote some types --- stack.yaml.lock | 12 ++ stripe-core/src/Web/Stripe/PaymentIntent.hs | 148 ++++++++++++++++++++ stripe-core/src/Web/Stripe/Types.hs | 107 ++++++++++++++ 3 files changed, 267 insertions(+) create mode 100644 stack.yaml.lock create mode 100644 stripe-core/src/Web/Stripe/PaymentIntent.hs diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 0000000..89523f6 --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,12 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: [] +snapshots: +- completed: + size: 535471 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/9/5.yaml + sha256: 452763f820c6cf01f7c917c71dd4e172578d7e53a7763bce863b99f9a8bc843d + original: lts-9.5 diff --git a/stripe-core/src/Web/Stripe/PaymentIntent.hs b/stripe-core/src/Web/Stripe/PaymentIntent.hs new file mode 100644 index 0000000..a3c959b --- /dev/null +++ b/stripe-core/src/Web/Stripe/PaymentIntent.hs @@ -0,0 +1,148 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.PaymentIntent +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +-- +-- < https:/\/\stripe.com/docs/api#refunds > +-- +-- @ +-- {-\# LANGUAGE OverloadedStrings \#-} +-- import Web.Stripe +-- import Web.Stripe.Customer +-- import Web.Stripe.Charge +-- import Web.Stripe.PaymentIntent +-- +-- main :: IO () +-- main = do +-- let config = StripeConfig (StripeKey "secret_key") +-- credit = CardNumber "4242424242424242" +-- em = ExpMonth 12 +-- ey = ExpYear 2015 +-- cvc = CVC "123" +-- cardinfo = (mkNewCard credit em ey) { newCardCVC = Just cvc } +-- result <- stripe config $ createCustomer -&- cardinfo +-- case result of +-- (Left stripeError) -> print stripeError +-- (Right (Customer { customerId = cid })) -> do +-- result <- stripe config $ createCharge (Amount 100) USD -&- cid +-- case result of +-- (Left stripeError) -> print stripeError +-- (Right (Charge { chargeId = chid })) -> do +-- result <- stripe config $ createPaymentIntent chid +-- case result of +-- (Left stripeError) -> print stripeError +-- (Right refund) -> print refund +-- @ +module Web.Stripe.PaymentIntent + ( -- * API + CreatePaymentIntent + , createPaymentIntent + , GetPaymentIntent + , getPaymentIntent + , GetPaymentIntents + , getPaymentIntents + , UpdatePaymentIntent + , updatePaymentIntent + -- * Types + , Amount (..) + , Charge (..) + , ChargeId (..) + , EndingBefore (..) + , ExpandParams (..) + , PaymentIntent (..) + , PaymentIntentApplicationFee(..) + , PaymentIntentReason (..) + , PaymentIntentId (..) + , StripeList (..) + ) where + +import Web.Stripe.StripeRequest (Method (GET, POST), + StripeHasParam, StripeReturn, + StripeRequest (..), mkStripeRequest) +import Web.Stripe.Util (()) +import Web.Stripe.Types (Amount(..), Charge (..), ChargeId (..), + EndingBefore(..), Limit(..), + MetaData(..), PaymentIntent (..), + PaymentIntentApplicationFee(..), + PaymentIntentId (..), PaymentIntentReason(..), + StartingAfter(..), ExpandParams(..), + StripeList (..)) +import Web.Stripe.Types.Util (getChargeId) + +------------------------------------------------------------------------------ +-- | create a `PaymentIntent` +createPaymentIntent + :: ChargeId -- ^ `ChargeId` associated with the `Charge` to be refunded + -> StripeRequest CreatePaymentIntent +createPaymentIntent + chargeid = request + where request = mkStripeRequest POST url params + url = "charges" getChargeId chargeid "refunds" + params = [] + +data CreatePaymentIntent +type instance StripeReturn CreatePaymentIntent = PaymentIntent +instance StripeHasParam CreatePaymentIntent Amount +instance StripeHasParam CreatePaymentIntent PaymentIntentApplicationFee +instance StripeHasParam CreatePaymentIntent PaymentIntentReason +instance StripeHasParam CreatePaymentIntent MetaData + +------------------------------------------------------------------------------ +-- | Retrieve a `PaymentIntent` by `ChargeId` and `PaymentIntentId` +getPaymentIntent + :: ChargeId -- ^ `ChargeId` associated with the `PaymentIntent` to be retrieved + -> PaymentIntentId -- ^ `PaymentIntentId` associated with the `PaymentIntent` to be retrieved + -> StripeRequest GetPaymentIntent +getPaymentIntent + chargeid + (PaymentIntentId refundid) = request + where request = mkStripeRequest GET url params + url = "charges" getChargeId chargeid "refunds" refundid + params = [] + +data GetPaymentIntent +type instance StripeReturn GetPaymentIntent = PaymentIntent +instance StripeHasParam GetPaymentIntent ExpandParams + +------------------------------------------------------------------------------ +-- | Update a `PaymentIntent` by `ChargeId` and `PaymentIntentId` +updatePaymentIntent + :: ChargeId -- ^ `ChargeId` associated with the `Charge` to be updated + -> PaymentIntentId -- ^ `PaymentIntentId` associated with the `PaymentIntent` to be retrieved + -> StripeRequest UpdatePaymentIntent +updatePaymentIntent + chargeid + (PaymentIntentId refid) + = request + where request = mkStripeRequest POST url params + url = "charges" getChargeId chargeid "refunds" refid + params = [] + +data UpdatePaymentIntent +type instance StripeReturn UpdatePaymentIntent = PaymentIntent +instance StripeHasParam UpdatePaymentIntent MetaData + +------------------------------------------------------------------------------ +-- | Retrieve a lot of PaymentIntents by `ChargeId` +getPaymentIntents + :: ChargeId -- ^ `ChargeId` associated with the `PaymentIntents` to get + -> StripeRequest GetPaymentIntents +getPaymentIntents + chargeid = request + where request = mkStripeRequest GET url params + url = "charges" getChargeId chargeid "refunds" + params = [] + +data GetPaymentIntents +type instance StripeReturn GetPaymentIntents = StripeList PaymentIntent +instance StripeHasParam GetPaymentIntents ExpandParams +instance StripeHasParam GetPaymentIntents (EndingBefore PaymentIntentId) +instance StripeHasParam GetPaymentIntents Limit +instance StripeHasParam GetPaymentIntents (StartingAfter PaymentIntentId) diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index 98c30c4..3414398 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -1885,6 +1885,113 @@ instance FromJSON Event where return Event {..} parseJSON _ = mzero +------------------------------------------------------------------------------ +-- | `PaymentIntentId` for `PaymentIntent` +newtype PaymentIntentId = + PaymentIntentId Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | `PaymentIntent` Object +data PaymentIntent = PaymentIntent { + paymentIntentId :: PaymentIntentId + , paymentIntentAmount :: Int + , paymentIntentAmountCapturable :: Maybe Int + , paymentIntentAmountReceived :: Maybe Int + , paymentIntentApplication :: Maybe (Expandable ApplicationId) + , paymentIntentApplicationFeeAmount :: Maybe Int + , paymentIntentCanceledAt :: Maybe UTCTime + , paymentIntentCancellationReason :: Maybe CancellationReason + , paymentIntentCaptureMethod :: CaptureMethod + , paymentIntentCharges :: Maybe (StripeList Charge) + , paymentIntentClientSecret :: Maybe (Text) + , paymentIntentConfirmationMethod :: ConfirmationMethod + , paymentIntentCreated :: UTCTime + , paymentIntentCurrency :: Currency + , paymentIntentCustomer :: Maybe (Expandable CustomerId) + , paymentInventInvoice :: Maybe (Expandable InvoiceId) + , paymentIntentLastPaymentError :: Maybe TODO + , paymentIntentLiveMode :: Maybe Bool + , paymentIntentMetadata :: Maybe MetaData + , paymentIntentNextAction :: Maybe TOOD + , paymentIntentOnBehalfOf :: Maybe (Expandable AccountId) + , paymentIntentPaymentMethod :: Maybe (Expandable PaymentMethodId) + , paymentIntentPaymentOptions :: Maybe (Expandable PaymentMethodOptionsId) + , paymentIntentPaymentMethodTypes :: [Text] + , paymentIntentReceiptEmail :: Maybe ReceiptEmail + , paymentIntentReview :: Maybe (Expandable Review) + , paymentIntentSetupFutureUsage :: Maybe Text + , paymentIntentShipping :: Maybe TODO + , paymentIntentStatementDescriptor :: Maybe StatementDescription + , paymentIntentStatementDescriptorSuffix :: Maybe StatementDescription + , paymentIntentStatus :: PaymentIntentStatus + , paymentIntentTransferData :: Maybe TransferData + , paymentIntentTransferGroup :: Maybe Text + } deriving (Read, Show, Eq, Ord, Data, Typeable) + +data CancellationReason + = CancellationReasonDuplicate + | CancellationReasonFraudulent + | CancellationReasonRequestedByCustomer + | CancellationReasonAbandoned + | CancellationReasonFailedInvoice + | CancellationReasonVoidInvoice + | CancellationReasonAutomatic + deriving (Read, Show, Eq, Ord, Data, Typeable) + +data CaptureMethod + = CaptureMethodAutomatic + | CaptureMethodManual + deriving (Read, Show, Eq, Ord, Data, Typeable) + +data ConfirmationMethod + = ConfirmationMethodAutomatic + | ConfirmationMethodManual + deriving (Read, Show, Eq, Ord, Data, Typeable) + +data PaymentIntentStatus + = PaymentIntentStatusCanceled + | PaymentIntentStatusProcessing + | PaymentIntentStatusRequiresAction + | PaymentIntentStatusRequiresCapture + | PaymentIntentStatusRequiresConfirmation + | PaymentIntentStatusRequiresPaymentMethod + | PaymentIntentStatusSucceeded + deriving (Read, Show, Eq, Ord, Data, Typeable) + +newtype PaymentMethodId = + PaymentMethodId Text deriving (Read, Show, Eq, Ord, Data, Typeable) +data PaymentMethod = PaymentMethod { + paymentMethodId :: PaymentMethodId + , paymentMethodBillingDetails :: BillingDetails + , paymentMethodCard :: Maybe PaymentMethodCard + , paymentMethodCardPresent :: Maybe PaymentMethodCardPresent + , paymentMethodCreated :: UTCTime + , paymentMethodCustomer :: Maybe (Expandable CustomerId) + , paymentMethodLiveMode :: Bool + , paymentMethodType :: PaymentMethodType + } deriving (Read, Show, Eq, Ord, Data, Typeable) + +data PaymentMethodType + = PaymentMethodTypeCard + | PaymentMethodTypeCardPresent + +newtype PaymentMethodOptionsId = + PaymentMethodOptionsId Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | JSON Instance for `PaymentIntent` +instance FromJSON PaymentIntent where + parseJSON (Object o) = + PaymentIntent <$> (PaymentIntentId <$> o .: "id") + <*> o .: "amount" + <*> o .: "currency" + <*> (fromSeconds <$> o .: "created") + <*> o .: "object" + <*> o .: "charge" + <*> o .:? "balance_transaction" + <*> o .: "metadata" + parseJSON _ = mzero + ------------------------------------------------------------------------------ -- | Connect Application data ConnectApp = ConnectApp { From 48628b4016c1a0a5a7fa30ddb6fe737c2b09b727 Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Fri, 13 Sep 2019 19:30:05 +0200 Subject: [PATCH 02/44] a bunch of json instances --- stripe-core/src/Web/Stripe/Types.hs | 165 ++++++++++++++++++++-------- 1 file changed, 121 insertions(+), 44 deletions(-) diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index 3414398..e7f8cb4 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -1719,7 +1719,7 @@ data EventType = | TransferPaidEvent | TransferFailedEvent | PingEvent - | UnknownEvent + | UnknownEvent Text deriving (Read, Show, Eq, Ord, Data, Typeable) ------------------------------------------------------------------------------ @@ -1774,7 +1774,7 @@ instance FromJSON EventType where parseJSON (String "transfer.paid") = pure TransferPaidEvent parseJSON (String "transfer.failed") = pure TransferFailedEvent parseJSON (String "ping") = pure PingEvent - parseJSON _ = pure UnknownEvent + parseJSON (String t) = pure $ UnknownEvent t ------------------------------------------------------------------------------ -- | `EventId` of an `Event` @@ -1912,22 +1912,68 @@ data PaymentIntent = PaymentIntent { , paymentIntentLastPaymentError :: Maybe TODO , paymentIntentLiveMode :: Maybe Bool , paymentIntentMetadata :: Maybe MetaData - , paymentIntentNextAction :: Maybe TOOD + , paymentIntentNextAction :: Maybe TODO , paymentIntentOnBehalfOf :: Maybe (Expandable AccountId) , paymentIntentPaymentMethod :: Maybe (Expandable PaymentMethodId) , paymentIntentPaymentOptions :: Maybe (Expandable PaymentMethodOptionsId) , paymentIntentPaymentMethodTypes :: [Text] , paymentIntentReceiptEmail :: Maybe ReceiptEmail - , paymentIntentReview :: Maybe (Expandable Review) + , paymentIntentReview :: Maybe (Expandable TODO) , paymentIntentSetupFutureUsage :: Maybe Text , paymentIntentShipping :: Maybe TODO , paymentIntentStatementDescriptor :: Maybe StatementDescription , paymentIntentStatementDescriptorSuffix :: Maybe StatementDescription , paymentIntentStatus :: PaymentIntentStatus - , paymentIntentTransferData :: Maybe TransferData + , paymentIntentTransferData :: Maybe TODO , paymentIntentTransferGroup :: Maybe Text } deriving (Read, Show, Eq, Ord, Data, Typeable) +------------------------------------------------------------------------------ +-- | JSON Instance for `PaymentIntent` + +instance FromJSON PaymentIntent where + parseJSON = withObject "PaymentIntent" $ \o -> + PaymentIntent + <$> o .: "id" + <*> o .: "amount" + <*> o .: "amount_capturable" + <*> o .: "amount_received" + <*> o .: "application" + <*> o .: "application_fee_amount" + <*> o .: "canceled_at" + <*> o .: "cancellation_reason" + <*> o .: "capture_method" + <*> o .: "charges" + <*> o .: "client_secret" + <*> o .: "confirmation_method" + <*> o .: "created" + <*> o .: "currency" + <*> o .: "customer" + <*> o .: "invoice" + <*> o .: "last_payment_error" + <*> o .: "live_mode" + <*> o .: "metadata" + <*> o .: "next_action" + <*> o .: "on_behalf_of" + <*> o .: "payment_method" + <*> o .: "payment_options" + <*> o .: "payment_method_types" + <*> o .: "receipt_email" + <*> o .: "review" + <*> o .: "setup_future_usage" + <*> o .: "shipping" + <*> o .: "statement_descriptor" + <*> o .: "statement_descriptor_suffix" + <*> o .: "status" + <*> o .: "transfer_data" + <*> o .: "transfer_group" + +data TODO = TODO + deriving (Read, Show, Eq, Ord, Data, Typeable) + +instance FromJSON TODO where + parseJSON _ = pure TODO + data CancellationReason = CancellationReasonDuplicate | CancellationReasonFraudulent @@ -1938,16 +1984,38 @@ data CancellationReason | CancellationReasonAutomatic deriving (Read, Show, Eq, Ord, Data, Typeable) +instance FromJSON CancellationReason where + parseJSON = withText $ \t -> case t of + "duplicate" -> pure CancellationReasonDuplicate + "fraudulent" -> pure CancellationReasonFraudulent + "requestedByCustomer" -> pure CancellationReasonRequestedByCustomer + "abandoned" -> pure CancellationReasonAbandoned + "failedInvoice" -> pure CancellationReasonFailedInvoice + "voidInvoice" -> pure CancellationReasonVoidInvoice + "automatic" -> pure CancellationReasonAutomatic + _ -> fail $ "unknown CancellationReason: " <> t + + data CaptureMethod = CaptureMethodAutomatic | CaptureMethodManual deriving (Read, Show, Eq, Ord, Data, Typeable) +instance FromJSON CaptureMethod where + parseJSON = withText "CaptureMethod" $ \t -> case t of + "automatic" -> pure CaptureMethodAutomatic + "manual" -> pure CaptureMethodManual + data ConfirmationMethod = ConfirmationMethodAutomatic | ConfirmationMethodManual deriving (Read, Show, Eq, Ord, Data, Typeable) +instance FromJSON ConfirmationMethod where + parseJSON = withText "ConfirmationMethod" $ \t -> case t of + "automatic" -> pure ConfirmationMethodAutomatic + "manual" -> pure ConfirmationMethodManual + data PaymentIntentStatus = PaymentIntentStatusCanceled | PaymentIntentStatusProcessing @@ -1958,13 +2026,26 @@ data PaymentIntentStatus | PaymentIntentStatusSucceeded deriving (Read, Show, Eq, Ord, Data, Typeable) +instance FromJSON PaymentIntentStatus where + parseJSON = withText "PaymentIntentStatus" $ \t -> case t of + "canceled" -> pure PaymentIntentStatusCanceled + "processing" -> pure PaymentIntentStatusProcessing + "requiresAction" -> pure PaymentIntentStatusRequiresAction + "requiresCapture" -> pure PaymentIntentStatusRequiresCapture + "requiresConfirmation" -> pure PaymentIntentStatusRequiresConfirmation + "requiresPaymentMethod" -> pure PaymentIntentStatusRequiresPaymentMethod + "succeeded" -> pure PaymentIntentStatusSucceeded + _ -> fail $ "Unknown PaymentIntentStatus: " <> t + newtype PaymentMethodId = PaymentMethodId Text deriving (Read, Show, Eq, Ord, Data, Typeable) + + data PaymentMethod = PaymentMethod { paymentMethodId :: PaymentMethodId - , paymentMethodBillingDetails :: BillingDetails - , paymentMethodCard :: Maybe PaymentMethodCard - , paymentMethodCardPresent :: Maybe PaymentMethodCardPresent + , paymentMethodBillingDetails :: TODO + , paymentMethodCard :: Maybe TODO + , paymentMethodCardPresent :: Maybe TODO , paymentMethodCreated :: UTCTime , paymentMethodCustomer :: Maybe (Expandable CustomerId) , paymentMethodLiveMode :: Bool @@ -1974,23 +2055,19 @@ data PaymentMethod = PaymentMethod { data PaymentMethodType = PaymentMethodTypeCard | PaymentMethodTypeCardPresent + deriving (Read, Show, Eq, Ord, Data, Typeable) + +instance FromJSON PaymentMethodType where + parseJSON = withText "PaymentMethodType" $ \t -> case t of + "PaymentMethodTypeCard" -> pure PaymentMethodTypeCard + "PaymentMethodTypeCardPresent" -> pure PaymentMethodTypeCardPresent + _ -> fail $ "Unknown PaymentMethodType: " <> t + newtype PaymentMethodOptionsId = - PaymentMethodOptionsId Text deriving (Read, Show, Eq, Ord, Data, Typeable) + PaymentMethodOptionsId Text + deriving (Read, Show, Eq, Ord, Data, Typeable) ------------------------------------------------------------------------------- --- | JSON Instance for `PaymentIntent` -instance FromJSON PaymentIntent where - parseJSON (Object o) = - PaymentIntent <$> (PaymentIntentId <$> o .: "id") - <*> o .: "amount" - <*> o .: "currency" - <*> (fromSeconds <$> o .: "created") - <*> o .: "object" - <*> o .: "charge" - <*> o .:? "balance_transaction" - <*> o .: "metadata" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | Connect Application @@ -2489,7 +2566,7 @@ data BitcoinReceiver = BitcoinReceiver { , btcMetadata :: MetaData , btcRefundAddress :: Maybe Text , btcTransactions :: Maybe Transactions - , btcPayment :: Maybe PaymentId + , btcPayment :: Maybe PaymentId , btcCustomer :: Maybe CustomerId } deriving (Show, Eq) @@ -2498,23 +2575,23 @@ data BitcoinReceiver = BitcoinReceiver { 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" + <*> 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" <*> (MetaData . H.toList <$> o .: "metadata") - <*> o .:? "refund_address" + <*> o .:? "refund_address" <*> o .:? "transactions" <*> (fmap PaymentId <$> o .:? "payment") <*> (fmap CustomerId <$> o .:? "customer") @@ -2534,11 +2611,11 @@ data Transactions = Transactions { -- | Bitcoin Transactions data instance FromJSON Transactions where parseJSON (Object o) = - Transactions <$> o .: "object" - <*> o .: "total_count" - <*> o .: "has_more" - <*> o .: "url" - <*> o .: "data" + Transactions <$> o .: "object" + <*> o .: "total_count" + <*> o .: "has_more" + <*> o .: "url" + <*> o .: "data" parseJSON _ = mzero ------------------------------------------------------------------------------ From 3de99f6541c32f1f8932ab441d0f4e9d3937e111 Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Fri, 13 Sep 2019 22:36:04 +0200 Subject: [PATCH 03/44] More json --- stripe-core/src/Web/Stripe/PaymentIntent.hs | 15 ++-- stripe-core/src/Web/Stripe/Types.hs | 94 ++++++++++++--------- stripe-core/stripe-core.cabal | 1 + 3 files changed, 62 insertions(+), 48 deletions(-) diff --git a/stripe-core/src/Web/Stripe/PaymentIntent.hs b/stripe-core/src/Web/Stripe/PaymentIntent.hs index a3c959b..300d0bf 100644 --- a/stripe-core/src/Web/Stripe/PaymentIntent.hs +++ b/stripe-core/src/Web/Stripe/PaymentIntent.hs @@ -79,20 +79,19 @@ import Web.Stripe.Types.Util (getChargeId) ------------------------------------------------------------------------------ -- | create a `PaymentIntent` createPaymentIntent - :: ChargeId -- ^ `ChargeId` associated with the `Charge` to be refunded + :: Amount + -> Currency -> StripeRequest CreatePaymentIntent createPaymentIntent - chargeid = request + amount + currency = request where request = mkStripeRequest POST url params - url = "charges" getChargeId chargeid "refunds" - params = [] + url = "payment_intents" + params = toStripeParam amount $ + toStripeParam currency data CreatePaymentIntent type instance StripeReturn CreatePaymentIntent = PaymentIntent -instance StripeHasParam CreatePaymentIntent Amount -instance StripeHasParam CreatePaymentIntent PaymentIntentApplicationFee -instance StripeHasParam CreatePaymentIntent PaymentIntentReason -instance StripeHasParam CreatePaymentIntent MetaData ------------------------------------------------------------------------------ -- | Retrieve a `PaymentIntent` by `ChargeId` and `PaymentIntentId` diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index e7f8cb4..0432c04 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RecordWildCards #-} @@ -18,7 +19,7 @@ module Web.Stripe.Types where ------------------------------------------------------------------------------ import Control.Applicative (pure, (<$>), (<*>), (<|>)) import Control.Monad (mzero) -import Data.Aeson (FromJSON (parseJSON), ToJSON(..), +import Data.Aeson (FromJSON (parseJSON), ToJSON(..), withText, withObject, Value (String, Object, Bool), (.:), (.:?)) import Data.Aeson.Types (typeMismatch) @@ -26,7 +27,9 @@ import Data.Data (Data, Typeable) import qualified Data.HashMap.Strict as H import Data.Ratio ((%)) import Data.Text (Text) +import qualified Data.Text as T import Data.Time (UTCTime) +import Data.Monoid ((<>)) import Numeric (fromRat, showFFloat) import Text.Read (lexP, pfail) import qualified Text.Read as R @@ -51,11 +54,13 @@ deriving instance (Eq id, Eq (ExpandsTo id)) => Eq (Expandable id) deriving instance (Ord id, Ord (ExpandsTo id)) => Ord (Expandable id) type instance ExpandsTo AccountId = Account +type instance ExpandsTo ApplicationId = Application type instance ExpandsTo CardId = Card type instance ExpandsTo ChargeId = Charge type instance ExpandsTo CustomerId = Customer type instance ExpandsTo InvoiceId = Invoice type instance ExpandsTo InvoiceItemId = InvoiceItem +type instance ExpandsTo PaymentMethodId = PaymentMethod type instance ExpandsTo RecipientId = Recipient type instance ExpandsTo RecipientCardId = RecipientCard type instance ExpandsTo TransactionId = BalanceTransaction @@ -1413,7 +1418,7 @@ newtype ApplicationFeeAmount = ApplicationFeeAmount Integer ------------------------------------------------------------------------------ -- | `ApplicationId` object newtype ApplicationId = - ApplicationId Text deriving (Read, Show, Eq, Ord, Data, Typeable) + ApplicationId Text deriving (Read, Show, Eq, Ord, Data, Typeable, FromJSON) ------------------------------------------------------------------------------ -- | JSON Instance for `ApplicationFee` @@ -1775,6 +1780,7 @@ instance FromJSON EventType where parseJSON (String "transfer.failed") = pure TransferFailedEvent parseJSON (String "ping") = pure PingEvent parseJSON (String t) = pure $ UnknownEvent t + parseJSON _ = mempty ------------------------------------------------------------------------------ -- | `EventId` of an `Event` @@ -1914,11 +1920,11 @@ data PaymentIntent = PaymentIntent { , paymentIntentMetadata :: Maybe MetaData , paymentIntentNextAction :: Maybe TODO , paymentIntentOnBehalfOf :: Maybe (Expandable AccountId) - , paymentIntentPaymentMethod :: Maybe (Expandable PaymentMethodId) - , paymentIntentPaymentOptions :: Maybe (Expandable PaymentMethodOptionsId) + , paymentIntentPaymentMethod :: Maybe TODO + , paymentIntentPaymentOptions :: Maybe TODO , paymentIntentPaymentMethodTypes :: [Text] , paymentIntentReceiptEmail :: Maybe ReceiptEmail - , paymentIntentReview :: Maybe (Expandable TODO) + , paymentIntentReview :: Maybe TODO , paymentIntentSetupFutureUsage :: Maybe Text , paymentIntentShipping :: Maybe TODO , paymentIntentStatementDescriptor :: Maybe StatementDescription @@ -1934,39 +1940,39 @@ data PaymentIntent = PaymentIntent { instance FromJSON PaymentIntent where parseJSON = withObject "PaymentIntent" $ \o -> PaymentIntent - <$> o .: "id" + <$> (PaymentIntentId <$> o .: "id") <*> o .: "amount" - <*> o .: "amount_capturable" - <*> o .: "amount_received" - <*> o .: "application" - <*> o .: "application_fee_amount" - <*> o .: "canceled_at" - <*> o .: "cancellation_reason" + <*> o .:? "amount_capturable" + <*> o .:? "amount_received" + <*> o .:? "application" + <*> o .:? "application_fee_amount" + <*> o .:? "canceled_at" + <*> o .:? "cancellation_reason" <*> o .: "capture_method" - <*> o .: "charges" - <*> o .: "client_secret" + <*> o .:? "charges" + <*> o .:? "client_secret" <*> o .: "confirmation_method" <*> o .: "created" <*> o .: "currency" - <*> o .: "customer" - <*> o .: "invoice" - <*> o .: "last_payment_error" - <*> o .: "live_mode" - <*> o .: "metadata" - <*> o .: "next_action" - <*> o .: "on_behalf_of" - <*> o .: "payment_method" - <*> o .: "payment_options" + <*> o .:? "customer" + <*> o .:? "invoice" + <*> o .:? "last_payment_error" + <*> o .:? "live_mode" + <*> o .:? "metadata" + <*> o .:? "next_action" + <*> o .:? "on_behalf_of" + <*> o .:? "payment_method" + <*> o .:? "payment_options" <*> o .: "payment_method_types" - <*> o .: "receipt_email" - <*> o .: "review" - <*> o .: "setup_future_usage" - <*> o .: "shipping" - <*> o .: "statement_descriptor" - <*> o .: "statement_descriptor_suffix" + <*> (fmap ReceiptEmail <$> o .:? "receipt_email") + <*> o .:? "review" + <*> o .:? "setup_future_usage" + <*> o .:? "shipping" + <*> o .:? "statement_descriptor" + <*> o .:? "statement_descriptor_suffix" <*> o .: "status" - <*> o .: "transfer_data" - <*> o .: "transfer_group" + <*> o .:? "transfer_data" + <*> o .:? "transfer_group" data TODO = TODO deriving (Read, Show, Eq, Ord, Data, Typeable) @@ -1974,6 +1980,17 @@ data TODO = TODO instance FromJSON TODO where parseJSON _ = pure TODO +data Application = Application { + applicationId :: ApplicationId + , applicationName :: Maybe Text + } deriving (Read, Show, Eq, Ord, Data, Typeable) + +instance FromJSON Application where + parseJSON = withObject "Application" $ \o -> + Application + <$> ApplicationId <$> (o .: "id") + <*> o .:? "name" + data CancellationReason = CancellationReasonDuplicate | CancellationReasonFraudulent @@ -1985,7 +2002,7 @@ data CancellationReason deriving (Read, Show, Eq, Ord, Data, Typeable) instance FromJSON CancellationReason where - parseJSON = withText $ \t -> case t of + parseJSON = withText "CancellationReason" $ \t -> case t of "duplicate" -> pure CancellationReasonDuplicate "fraudulent" -> pure CancellationReasonFraudulent "requestedByCustomer" -> pure CancellationReasonRequestedByCustomer @@ -1993,7 +2010,7 @@ instance FromJSON CancellationReason where "failedInvoice" -> pure CancellationReasonFailedInvoice "voidInvoice" -> pure CancellationReasonVoidInvoice "automatic" -> pure CancellationReasonAutomatic - _ -> fail $ "unknown CancellationReason: " <> t + _ -> fail $ "unknown CancellationReason: " <> T.unpack t data CaptureMethod @@ -2005,6 +2022,7 @@ instance FromJSON CaptureMethod where parseJSON = withText "CaptureMethod" $ \t -> case t of "automatic" -> pure CaptureMethodAutomatic "manual" -> pure CaptureMethodManual + _ -> fail $ "Unknown CaptureMethod: " <> T.unpack t data ConfirmationMethod = ConfirmationMethodAutomatic @@ -2015,6 +2033,7 @@ instance FromJSON ConfirmationMethod where parseJSON = withText "ConfirmationMethod" $ \t -> case t of "automatic" -> pure ConfirmationMethodAutomatic "manual" -> pure ConfirmationMethodManual + _ -> fail $ "Unknown ConfirmationMethod: " <> T.unpack t data PaymentIntentStatus = PaymentIntentStatusCanceled @@ -2035,7 +2054,7 @@ instance FromJSON PaymentIntentStatus where "requiresConfirmation" -> pure PaymentIntentStatusRequiresConfirmation "requiresPaymentMethod" -> pure PaymentIntentStatusRequiresPaymentMethod "succeeded" -> pure PaymentIntentStatusSucceeded - _ -> fail $ "Unknown PaymentIntentStatus: " <> t + _ -> fail $ "Unknown PaymentIntentStatus: " <> T.unpack t newtype PaymentMethodId = PaymentMethodId Text deriving (Read, Show, Eq, Ord, Data, Typeable) @@ -2061,12 +2080,7 @@ instance FromJSON PaymentMethodType where parseJSON = withText "PaymentMethodType" $ \t -> case t of "PaymentMethodTypeCard" -> pure PaymentMethodTypeCard "PaymentMethodTypeCardPresent" -> pure PaymentMethodTypeCardPresent - _ -> fail $ "Unknown PaymentMethodType: " <> t - - -newtype PaymentMethodOptionsId = - PaymentMethodOptionsId Text - deriving (Read, Show, Eq, Ord, Data, Typeable) + _ -> fail $ "Unknown PaymentMethodType: " <> T.unpack t ------------------------------------------------------------------------------ diff --git a/stripe-core/stripe-core.cabal b/stripe-core/stripe-core.cabal index b54889d..4b7ce9f 100644 --- a/stripe-core/stripe-core.cabal +++ b/stripe-core/stripe-core.cabal @@ -47,6 +47,7 @@ library Web.Stripe.Event Web.Stripe.Invoice Web.Stripe.InvoiceItem + Web.Stripe.PaymentIntent Web.Stripe.Plan Web.Stripe.Recipient Web.Stripe.Refund From e05d004d5d45d55f4450cb026c2e07550d6735fe Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Sat, 14 Sep 2019 00:31:08 +0200 Subject: [PATCH 04/44] some completed api --- stripe-core/src/Web/Stripe/PaymentIntent.hs | 34 ++++++++------------- stripe-core/src/Web/Stripe/StripeRequest.hs | 8 +++-- stripe-core/src/Web/Stripe/Types.hs | 2 +- 3 files changed, 20 insertions(+), 24 deletions(-) diff --git a/stripe-core/src/Web/Stripe/PaymentIntent.hs b/stripe-core/src/Web/Stripe/PaymentIntent.hs index 300d0bf..12d4dcc 100644 --- a/stripe-core/src/Web/Stripe/PaymentIntent.hs +++ b/stripe-core/src/Web/Stripe/PaymentIntent.hs @@ -57,21 +57,18 @@ module Web.Stripe.PaymentIntent , EndingBefore (..) , ExpandParams (..) , PaymentIntent (..) - , PaymentIntentApplicationFee(..) - , PaymentIntentReason (..) , PaymentIntentId (..) , StripeList (..) ) where import Web.Stripe.StripeRequest (Method (GET, POST), StripeHasParam, StripeReturn, - StripeRequest (..), mkStripeRequest) + StripeRequest (..), toStripeParam, mkStripeRequest) import Web.Stripe.Util (()) -import Web.Stripe.Types (Amount(..), Charge (..), ChargeId (..), +import Web.Stripe.Types (Amount(..), Charge (..), ChargeId (..), Currency(..), EndingBefore(..), Limit(..), MetaData(..), PaymentIntent (..), - PaymentIntentApplicationFee(..), - PaymentIntentId (..), PaymentIntentReason(..), + PaymentIntentId (..), StartingAfter(..), ExpandParams(..), StripeList (..)) import Web.Stripe.Types.Util (getChargeId) @@ -88,7 +85,8 @@ createPaymentIntent where request = mkStripeRequest POST url params url = "payment_intents" params = toStripeParam amount $ - toStripeParam currency + toStripeParam currency $ + [] data CreatePaymentIntent type instance StripeReturn CreatePaymentIntent = PaymentIntent @@ -96,14 +94,12 @@ type instance StripeReturn CreatePaymentIntent = PaymentIntent ------------------------------------------------------------------------------ -- | Retrieve a `PaymentIntent` by `ChargeId` and `PaymentIntentId` getPaymentIntent - :: ChargeId -- ^ `ChargeId` associated with the `PaymentIntent` to be retrieved - -> PaymentIntentId -- ^ `PaymentIntentId` associated with the `PaymentIntent` to be retrieved + :: PaymentIntentId -- ^ `PaymentIntentId` associated with the `PaymentIntent` to be retrieved -> StripeRequest GetPaymentIntent getPaymentIntent - chargeid - (PaymentIntentId refundid) = request + (PaymentIntentId paymentIntentid) = request where request = mkStripeRequest GET url params - url = "charges" getChargeId chargeid "refunds" refundid + url = "payment_intents" paymentIntentid "refunds" params = [] data GetPaymentIntent @@ -113,15 +109,13 @@ instance StripeHasParam GetPaymentIntent ExpandParams ------------------------------------------------------------------------------ -- | Update a `PaymentIntent` by `ChargeId` and `PaymentIntentId` updatePaymentIntent - :: ChargeId -- ^ `ChargeId` associated with the `Charge` to be updated - -> PaymentIntentId -- ^ `PaymentIntentId` associated with the `PaymentIntent` to be retrieved + :: PaymentIntentId -- ^ `PaymentIntentId` associated with the `PaymentIntent` to be retrieved -> StripeRequest UpdatePaymentIntent updatePaymentIntent - chargeid - (PaymentIntentId refid) + (PaymentIntentId paymentIntentid) = request where request = mkStripeRequest POST url params - url = "charges" getChargeId chargeid "refunds" refid + url = "payment_intents" paymentIntentid params = [] data UpdatePaymentIntent @@ -131,12 +125,10 @@ instance StripeHasParam UpdatePaymentIntent MetaData ------------------------------------------------------------------------------ -- | Retrieve a lot of PaymentIntents by `ChargeId` getPaymentIntents - :: ChargeId -- ^ `ChargeId` associated with the `PaymentIntents` to get - -> StripeRequest GetPaymentIntents + :: StripeRequest GetPaymentIntents getPaymentIntents - chargeid = request where request = mkStripeRequest GET url params - url = "charges" getChargeId chargeid "refunds" + url = "payment_intents" params = [] data GetPaymentIntents diff --git a/stripe-core/src/Web/Stripe/StripeRequest.hs b/stripe-core/src/Web/Stripe/StripeRequest.hs index ac27b89..78fca24 100644 --- a/stripe-core/src/Web/Stripe/StripeRequest.hs +++ b/stripe-core/src/Web/Stripe/StripeRequest.hs @@ -58,7 +58,7 @@ import Web.Stripe.Types (AccountBalance(..), AccountNumber(..), IntervalCount(..), InvoiceId(..), InvoiceItemId(..), InvoiceLineItemId(..), - IsVerified(..), MetaData(..), PlanId(..), + IsVerified(..), MetaData(..), PaymentIntentId(..), PlanId(..), PlanName(..), Prorate(..), Limit(..), MaxRedemptions(..), Name(..), NewBankAccount(..), NewCard(..), @@ -68,7 +68,7 @@ import Web.Stripe.Types (AccountBalance(..), AccountNumber(..), RefundApplicationFee(..), RefundReason(..), RoutingNumber(..), StartingAfter(..), StatementDescription(..), Source(..), - SubscriptionId(..), TaxID(..), + SubscriptionId(..), TaxID(..), TaxPercent(..), TimeRange(..), TokenId(..), TransactionId(..), TransactionType(..), TransferId(..), @@ -318,6 +318,10 @@ instance ToStripeParam NewCard where , ("card[address_zip]", (\(AddressZip x) -> x) <$> newCardAddressZip ) ]) ++) +instance ToStripeParam PaymentIntentId where + toStripeParam (PaymentIntentId rid) = + (("payment_intent", Text.encodeUtf8 rid) :) + instance ToStripeParam (Param Text Text) where toStripeParam (Param (k,v)) = ((Text.encodeUtf8 k, Text.encodeUtf8 v) :) diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index 0432c04..e58269d 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -1894,7 +1894,7 @@ instance FromJSON Event where ------------------------------------------------------------------------------ -- | `PaymentIntentId` for `PaymentIntent` newtype PaymentIntentId = - PaymentIntentId Text deriving (Read, Show, Eq, Ord, Data, Typeable) + PaymentIntentId { getPaymentIntentId :: Text } deriving (Read, Show, Eq, Ord, Data, Typeable) ------------------------------------------------------------------------------ -- | `PaymentIntent` Object From 23b37b207a6838019875d85e0ee6db62e091cd72 Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Sat, 14 Sep 2019 01:03:43 +0200 Subject: [PATCH 05/44] little bit of cleanup --- stripe-core/src/Web/Stripe/PaymentIntent.hs | 87 ++++++++++++--------- 1 file changed, 52 insertions(+), 35 deletions(-) diff --git a/stripe-core/src/Web/Stripe/PaymentIntent.hs b/stripe-core/src/Web/Stripe/PaymentIntent.hs index 12d4dcc..bb0bec9 100644 --- a/stripe-core/src/Web/Stripe/PaymentIntent.hs +++ b/stripe-core/src/Web/Stripe/PaymentIntent.hs @@ -9,47 +9,22 @@ -- Maintainer : djohnson.m@gmail.com -- Stability : experimental -- Portability : POSIX --- --- < https:/\/\stripe.com/docs/api#refunds > --- --- @ --- {-\# LANGUAGE OverloadedStrings \#-} --- import Web.Stripe --- import Web.Stripe.Customer --- import Web.Stripe.Charge --- import Web.Stripe.PaymentIntent --- --- main :: IO () --- main = do --- let config = StripeConfig (StripeKey "secret_key") --- credit = CardNumber "4242424242424242" --- em = ExpMonth 12 --- ey = ExpYear 2015 --- cvc = CVC "123" --- cardinfo = (mkNewCard credit em ey) { newCardCVC = Just cvc } --- result <- stripe config $ createCustomer -&- cardinfo --- case result of --- (Left stripeError) -> print stripeError --- (Right (Customer { customerId = cid })) -> do --- result <- stripe config $ createCharge (Amount 100) USD -&- cid --- case result of --- (Left stripeError) -> print stripeError --- (Right (Charge { chargeId = chid })) -> do --- result <- stripe config $ createPaymentIntent chid --- case result of --- (Left stripeError) -> print stripeError --- (Right refund) -> print refund --- @ module Web.Stripe.PaymentIntent ( -- * API CreatePaymentIntent , createPaymentIntent , GetPaymentIntent , getPaymentIntent - , GetPaymentIntents - , getPaymentIntents , UpdatePaymentIntent , updatePaymentIntent + , ConfirmPaymentIntent + , confirmPaymentIntent + , CapturePaymentIntent + , capturePaymentIntent + , CancelPaymentIntent + , cancelPaymentIntent + , GetPaymentIntents + , getPaymentIntents -- * Types , Amount (..) , Charge (..) @@ -71,7 +46,6 @@ import Web.Stripe.Types (Amount(..), Charge (..), ChargeId ( PaymentIntentId (..), StartingAfter(..), ExpandParams(..), StripeList (..)) -import Web.Stripe.Types.Util (getChargeId) ------------------------------------------------------------------------------ -- | create a `PaymentIntent` @@ -122,11 +96,54 @@ data UpdatePaymentIntent type instance StripeReturn UpdatePaymentIntent = PaymentIntent instance StripeHasParam UpdatePaymentIntent MetaData +confirmPaymentIntent + :: PaymentIntentId + -> StripeRequest ConfirmPaymentIntent +confirmPaymentIntent + (PaymentIntentId paymentIntentid) + = request + where request = mkStripeRequest POST url params + url = "payment_intents" paymentIntentid "confirm" + params = [] + +data ConfirmPaymentIntent +type instance StripeReturn ConfirmPaymentIntent = PaymentIntent +instance StripeHasParam ConfirmPaymentIntent MetaData + +capturePaymentIntent + :: PaymentIntentId + -> StripeRequest CapturePaymentIntent +capturePaymentIntent + (PaymentIntentId paymentIntentid) + = request + where request = mkStripeRequest POST url params + url = "payment_intents" paymentIntentid "capture" + params = [] + +data CapturePaymentIntent +type instance StripeReturn CapturePaymentIntent = PaymentIntent +instance StripeHasParam CapturePaymentIntent MetaData + +cancelPaymentIntent + :: PaymentIntentId + -> StripeRequest CancelPaymentIntent +cancelPaymentIntent + (PaymentIntentId paymentIntentid) + = request + where request = mkStripeRequest POST url params + url = "payment_intents" paymentIntentid "cancel" + params = [] + +data CancelPaymentIntent +type instance StripeReturn CancelPaymentIntent = PaymentIntent +instance StripeHasParam CancelPaymentIntent MetaData + ------------------------------------------------------------------------------ --- | Retrieve a lot of PaymentIntents by `ChargeId` +-- | Retrieve a list of PaymentIntents getPaymentIntents :: StripeRequest GetPaymentIntents getPaymentIntents + = request where request = mkStripeRequest GET url params url = "payment_intents" params = [] From 5870ac5b3286658a9faccb60d8245f9cfe65973d Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Mon, 23 Sep 2019 16:44:19 +0200 Subject: [PATCH 06/44] started on sessions --- stripe-core/src/Web/Stripe/Session.hs | 71 +++++++++++++++++++++++++++ stripe-core/src/Web/Stripe/Types.hs | 9 ++++ stripe-core/stripe-core.cabal | 1 + 3 files changed, 81 insertions(+) create mode 100644 stripe-core/src/Web/Stripe/Session.hs diff --git a/stripe-core/src/Web/Stripe/Session.hs b/stripe-core/src/Web/Stripe/Session.hs new file mode 100644 index 0000000..3fd8cd2 --- /dev/null +++ b/stripe-core/src/Web/Stripe/Session.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.Session +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +module Web.Stripe.Session + ( -- * API + CreateSession + , createSession + , GetSession + , getSession + -- * Types + , Amount (..) + , Charge (..) + , ChargeId (..) + , EndingBefore (..) + , ExpandParams (..) + , Session (..) + , SessionId (..) + , StripeList (..) + ) where + +import Web.Stripe.StripeRequest (Method (GET, POST), + StripeHasParam, StripeReturn, + StripeRequest (..), toStripeParam, mkStripeRequest) +import Web.Stripe.Util (()) +import Web.Stripe.Types (Amount(..), Charge (..), ChargeId (..), Currency(..), + EndingBefore(..), Limit(..), + MetaData(..), Session (..), + SessionId (..), + StartingAfter(..), ExpandParams(..), + StripeList (..)) + +------------------------------------------------------------------------------ +-- | create a `Session` +createSession + :: Amount + -> Currency + -> StripeRequest CreateSession +createSession + amount + currency = request + where request = mkStripeRequest POST url params + url = "checkout" "sessions" + params = toStripeParam amount $ + toStripeParam currency $ + [] + +data CreateSession +type instance StripeReturn CreateSession = Session + +------------------------------------------------------------------------------ +-- | Retrieve a `Session` by `ChargeId` and `SessionId` +getSession + :: SessionId -- ^ `SessionId` associated with the `Session` to be retrieved + -> StripeRequest GetSession +getSession + (SessionId sessionid) = request + where request = mkStripeRequest GET url params + url = "checkout" "sessions" sessionid + params = [] + +data GetSession +type instance StripeReturn GetSession = Session +instance StripeHasParam GetSession ExpandParams diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index e58269d..c62f8b5 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -548,6 +548,15 @@ instance FromJSON SubscriptionId where parseJSON (String x) = pure (SubscriptionId x) parseJSON _ = mzero + +data Session = Session { + sessionId :: SessionId + +} deriving (Read, Show, Eq, Ord, Data, Typeable) + +newtype SessionId = SessionId { getSessionId :: Text } + deriving (Read, Show, Eq, Ord, Data, Typeable) + ------------------------------------------------------------------------------ -- | Subscription Object data Subscription = Subscription { diff --git a/stripe-core/stripe-core.cabal b/stripe-core/stripe-core.cabal index 4b7ce9f..a1fedf4 100644 --- a/stripe-core/stripe-core.cabal +++ b/stripe-core/stripe-core.cabal @@ -51,6 +51,7 @@ library Web.Stripe.Plan Web.Stripe.Recipient Web.Stripe.Refund + Web.Stripe.Sessions Web.Stripe.StripeRequest Web.Stripe.Subscription Web.Stripe.Token From 083b07795b94cd05d6d739af5470adea6419718b Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Tue, 24 Sep 2019 13:25:36 +0200 Subject: [PATCH 07/44] some more on sessions --- stripe-core/src/Web/Stripe/Session.hs | 17 ++++++++++------- stripe-core/src/Web/Stripe/StripeRequest.hs | 14 +++++++++++++- stripe-core/src/Web/Stripe/Types.hs | 19 +++++++++++++++++++ stripe-core/stripe-core.cabal | 2 +- 4 files changed, 43 insertions(+), 9 deletions(-) diff --git a/stripe-core/src/Web/Stripe/Session.hs b/stripe-core/src/Web/Stripe/Session.hs index 3fd8cd2..197b13a 100644 --- a/stripe-core/src/Web/Stripe/Session.hs +++ b/stripe-core/src/Web/Stripe/Session.hs @@ -33,27 +33,30 @@ import Web.Stripe.Util (()) import Web.Stripe.Types (Amount(..), Charge (..), ChargeId (..), Currency(..), EndingBefore(..), Limit(..), MetaData(..), Session (..), - SessionId (..), + SessionId (..), SuccessUrl(..), CancelUrl(..), LineItems(..), LineItem(..), CustomerId(..), StartingAfter(..), ExpandParams(..), StripeList (..)) ------------------------------------------------------------------------------ -- | create a `Session` createSession - :: Amount - -> Currency + :: SuccessUrl -- ^ Success url + -> CancelUrl -- ^ Cancel url -> StripeRequest CreateSession createSession - amount - currency = request + successUrl + cancelUrl = request where request = mkStripeRequest POST url params url = "checkout" "sessions" - params = toStripeParam amount $ - toStripeParam currency $ + params = toStripeParam successUrl $ + toStripeParam cancelUrl $ + (("payment_method_types[]", "card") :) $ [] data CreateSession type instance StripeReturn CreateSession = Session +instance StripeHasParam CreateSession LineItems +instance StripeHasParam CreateSession CustomerId ------------------------------------------------------------------------------ -- | Retrieve a `Session` by `ChargeId` and `SessionId` diff --git a/stripe-core/src/Web/Stripe/StripeRequest.hs b/stripe-core/src/Web/Stripe/StripeRequest.hs index 78fca24..d3173f5 100644 --- a/stripe-core/src/Web/Stripe/StripeRequest.hs +++ b/stripe-core/src/Web/Stripe/StripeRequest.hs @@ -72,7 +72,7 @@ import Web.Stripe.Types (AccountBalance(..), AccountNumber(..), TaxPercent(..), TimeRange(..), TokenId(..), TransactionId(..), TransactionType(..), TransferId(..), - TransferStatus(..), TrialEnd(..), + TransferStatus(..), TrialEnd(..), SuccessUrl(..), CancelUrl(..), LineItems(..), LineItem(..), TrialPeriodDays(..)) import Web.Stripe.Util (toBytestring, toExpandable,toMetaData, toSeconds, getParams, toText) @@ -431,6 +431,18 @@ instance ToStripeParam TrialPeriodDays where toStripeParam (TrialPeriodDays days) = (("trial_period_days", toBytestring days) :) +instance ToStripeParam SuccessUrl where + toStripeParam (SucessUrl url) = + (("success_url", toBytestring url) :) + +instance ToStripeParam CancelUrl where + toStripeParam (CancelUrl url) = + (("cancel_url", toBytestring url) :) + +instance ToStripeParam LineItems where + toStripeParam (LineItems is) = + (("line_items", toBytestring is) :) + instance ToStripeParam MetaData where toStripeParam (MetaData kvs) = (toMetaData kvs ++) diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index c62f8b5..8a6f827 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -557,6 +557,25 @@ data Session = Session { newtype SessionId = SessionId { getSessionId :: Text } deriving (Read, Show, Eq, Ord, Data, Typeable) +newtype SuccessUrl = SucessUrl { getSuccessUrl :: Text } + deriving (Read, Show, Eq, Ord, Data, Typeable) +newtype CancelUrl = CancelUrl { getCancelUrl :: Text } + deriving (Read, Show, Eq, Ord, Data, Typeable) + +newtype LineItems = LineItems { getLineItems :: [LineItem] } + deriving (Read, Show, Eq, Ord, Data, Typeable) + +data LineItem = LineItem + { lineItemAmount :: Amount + , lineItemCurrency :: Currency + , lineItemName :: Text + , lineItemQuantity :: Int + , lineItemDescription :: Maybe Text + , lineItemImages :: Maybe [TODO] + } + deriving (Read, Show, Eq, Ord, Data, Typeable) + + ------------------------------------------------------------------------------ -- | Subscription Object data Subscription = Subscription { diff --git a/stripe-core/stripe-core.cabal b/stripe-core/stripe-core.cabal index a1fedf4..377dc4b 100644 --- a/stripe-core/stripe-core.cabal +++ b/stripe-core/stripe-core.cabal @@ -51,7 +51,7 @@ library Web.Stripe.Plan Web.Stripe.Recipient Web.Stripe.Refund - Web.Stripe.Sessions + Web.Stripe.Session Web.Stripe.StripeRequest Web.Stripe.Subscription Web.Stripe.Token From 2341b2ad0513930746831e3ddc76925c474573c2 Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Tue, 24 Sep 2019 13:39:14 +0200 Subject: [PATCH 08/44] more about sessions --- stripe-core/src/Web/Stripe/StripeRequest.hs | 4 ++-- stripe-core/src/Web/Stripe/Types.hs | 4 ++++ 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/stripe-core/src/Web/Stripe/StripeRequest.hs b/stripe-core/src/Web/Stripe/StripeRequest.hs index d3173f5..a9ea390 100644 --- a/stripe-core/src/Web/Stripe/StripeRequest.hs +++ b/stripe-core/src/Web/Stripe/StripeRequest.hs @@ -433,11 +433,11 @@ instance ToStripeParam TrialPeriodDays where instance ToStripeParam SuccessUrl where toStripeParam (SucessUrl url) = - (("success_url", toBytestring url) :) + (("success_url", Text.encodeUtf8 url) :) instance ToStripeParam CancelUrl where toStripeParam (CancelUrl url) = - (("cancel_url", toBytestring url) :) + (("cancel_url", Text.encodeUtf8 url) :) instance ToStripeParam LineItems where toStripeParam (LineItems is) = diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index 8a6f827..35cb194 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -554,6 +554,10 @@ data Session = Session { } deriving (Read, Show, Eq, Ord, Data, Typeable) +instance FromJSON Session where + parseJSON = withObject "Session" $ \o -> + Session <$> (SessionId <$> o .: "id") + newtype SessionId = SessionId { getSessionId :: Text } deriving (Read, Show, Eq, Ord, Data, Typeable) From a9a1ace50c1506f8e0f57035c9642de86696e62d Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Wed, 25 Sep 2019 12:34:02 +0200 Subject: [PATCH 09/44] managed to actually create a session --- stripe-core/src/Web/Stripe/Session.hs | 5 +++++ stripe-core/src/Web/Stripe/StripeRequest.hs | 17 +++++++++++++++-- stripe-core/src/Web/Stripe/Util.hs | 10 ++++++++++ 3 files changed, 30 insertions(+), 2 deletions(-) diff --git a/stripe-core/src/Web/Stripe/Session.hs b/stripe-core/src/Web/Stripe/Session.hs index 197b13a..80ec25f 100644 --- a/stripe-core/src/Web/Stripe/Session.hs +++ b/stripe-core/src/Web/Stripe/Session.hs @@ -16,7 +16,12 @@ module Web.Stripe.Session , GetSession , getSession -- * Types + , SessionId(..) + , SuccessUrl(..) + , CancelUrl(..) , Amount (..) + , LineItems(..) + , LineItem(..) , Charge (..) , ChargeId (..) , EndingBefore (..) diff --git a/stripe-core/src/Web/Stripe/StripeRequest.hs b/stripe-core/src/Web/Stripe/StripeRequest.hs index a9ea390..1b8d4c8 100644 --- a/stripe-core/src/Web/Stripe/StripeRequest.hs +++ b/stripe-core/src/Web/Stripe/StripeRequest.hs @@ -74,7 +74,7 @@ import Web.Stripe.Types (AccountBalance(..), AccountNumber(..), TransactionType(..), TransferId(..), TransferStatus(..), TrialEnd(..), SuccessUrl(..), CancelUrl(..), LineItems(..), LineItem(..), TrialPeriodDays(..)) -import Web.Stripe.Util (toBytestring, toExpandable,toMetaData, +import Web.Stripe.Util (toBytestring, toExpandable,toMetaData, encodeList, toSeconds, getParams, toText) ------------------------------------------------------------------------------ @@ -441,7 +441,20 @@ instance ToStripeParam CancelUrl where instance ToStripeParam LineItems where toStripeParam (LineItems is) = - (("line_items", toBytestring is) :) + encodeListStripeParam "line_items" is + +encodeListStripeParam :: ToStripeParam a => Text -> [a] -> ([(ByteString, ByteString)] -> [(ByteString, ByteString)]) +encodeListStripeParam name items = ((encodeList name items $ (\a -> toStripeParam a [])) ++) + +instance ToStripeParam LineItem where + toStripeParam LineItem{..} = + ((getParams + [ ("amount", Just $ (\(Amount i) -> toText i) $ lineItemAmount) + , ("currency", Just $ toText lineItemCurrency) + , ("name", Just lineItemName) + , ("quantity", Just $ toText lineItemQuantity) + , ("description", lineItemDescription) + ]) ++) instance ToStripeParam MetaData where toStripeParam (MetaData kvs) = diff --git a/stripe-core/src/Web/Stripe/Util.hs b/stripe-core/src/Web/Stripe/Util.hs index fa51707..5852931 100644 --- a/stripe-core/src/Web/Stripe/Util.hs +++ b/stripe-core/src/Web/Stripe/Util.hs @@ -14,6 +14,7 @@ module Web.Stripe.Util , toTextLower , getParams , toBytestring + , encodeList , () , toMetaData , toExpandable @@ -92,6 +93,15 @@ getParams xs = [ (x, T.encodeUtf8 y) | (x, Just y) <- xs ] toBytestring :: Show a => a -> ByteString toBytestring = B8.pack . show +------------------------------------------------------------------------------ +-- | EncodeList +encodeList :: Text -> [a] -> (a -> [(ByteString, ByteString)]) -> [(ByteString, ByteString)] +encodeList name items func = + concat $ map (uncurry go) $ zip [0..] $ map func items + where + go :: Int -> [(ByteString, ByteString)] -> [(ByteString, ByteString)] + go i = map $ \(key, val) -> (T.encodeUtf8 name <> "[" <> toBytestring i <> "][" <> key <> "]", val) + ------------------------------------------------------------------------------ -- | To MetaData toMetaData :: [(Text, Text)] -> [(ByteString, ByteString)] From 0ea6581c56cc67935e1ec58e8e141ad479fce0ff Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Mon, 30 Sep 2019 23:41:09 +0200 Subject: [PATCH 10/44] Tried to figure out events --- stripe-core/src/Web/Stripe/Client.hs | 15 ++++++++------- stripe-core/src/Web/Stripe/Error.hs | 4 +++- .../src/Web/Stripe/Client/HttpClient.hs | 2 +- 3 files changed, 12 insertions(+), 9 deletions(-) diff --git a/stripe-core/src/Web/Stripe/Client.hs b/stripe-core/src/Web/Stripe/Client.hs index 93fc4da..13092e4 100644 --- a/stripe-core/src/Web/Stripe/Client.hs +++ b/stripe-core/src/Web/Stripe/Client.hs @@ -93,17 +93,17 @@ handleStream handleStream decodeValue statusCode r = case statusCode of 200 -> case r of - Error message -> parseFail message + Error message -> parseFail message Nothing (Success value) -> case decodeValue value of - (Error message) -> parseFail message + (Error message) -> parseFail message (Just value) (Success a) -> (Right a) code | code >= 400 -> case r of - Error message -> parseFail message + Error message -> parseFail message Nothing (Success value) -> case fromJSON value of - (Error message) -> parseFail message + (Error message) -> parseFail message (Just value) (Success stripeError) -> Left $ setErrorHTTP code stripeError _ -> unknownCode @@ -119,16 +119,17 @@ attemptDecode code = code == 200 || code >= 400 -- | lift a parser error to be a StripeError parseFail :: String -- ^ error message + -> Maybe Value -> Either StripeError a -parseFail errorMessage = - Left $ StripeError ParseFailure (T.pack errorMessage) Nothing Nothing Nothing +parseFail errorMessage mval = + Left $ StripeError ParseFailure (T.pack errorMessage) Nothing Nothing Nothing mval ------------------------------------------------------------------------------ -- | `StripeError` to return when we don't know what to do with the -- received HTTP status code. unknownCode :: Either StripeError a unknownCode = - Left $ StripeError UnknownErrorType mempty Nothing Nothing Nothing + Left $ StripeError UnknownErrorType mempty Nothing Nothing Nothing Nothing ------------------------------------------------------------------------------ -- | set the `errorHTTP` field of the `StripeError` based on the HTTP diff --git a/stripe-core/src/Web/Stripe/Error.hs b/stripe-core/src/Web/Stripe/Error.hs index a76c105..2326b63 100644 --- a/stripe-core/src/Web/Stripe/Error.hs +++ b/stripe-core/src/Web/Stripe/Error.hs @@ -69,6 +69,7 @@ data StripeError = StripeError { , errorCode :: Maybe StripeErrorCode , errorParam :: Maybe Text , errorHTTP :: Maybe StripeErrorHTTPCode + , errorValue :: Maybe Value } deriving (Show, Typeable) instance Exception StripeError @@ -109,5 +110,6 @@ instance FromJSON StripeError where msg <- e .: "message" code <- fmap toErrorCode <$> e .:? "code" param <- e .:? "param" - return $ StripeError typ msg code param Nothing + value <- e .:? "value" + return $ StripeError typ msg code param Nothing value parseJSON _ = mzero diff --git a/stripe-http-client/src/Web/Stripe/Client/HttpClient.hs b/stripe-http-client/src/Web/Stripe/Client/HttpClient.hs index 7b0927d..c47f9da 100644 --- a/stripe-http-client/src/Web/Stripe/Client/HttpClient.hs +++ b/stripe-http-client/src/Web/Stripe/Client/HttpClient.hs @@ -113,7 +113,7 @@ callAPI man fromJSON' config stripeRequest = do else do case A.eitherDecode (Http.responseBody res) of - Left e -> pure $ parseFail e + Left e -> pure $ parseFail e Nothing Right a -> pure $ handleStream fromJSON' status $ return a where mkStripeRequest = From 4ff99693b01602d2c6556f57669ab54b8d0474e1 Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Tue, 1 Oct 2019 00:36:13 +0200 Subject: [PATCH 11/44] Got rid of 'mzero --- stripe-core/src/Web/Stripe/Types.hs | 363 +++++++++++----------------- 1 file changed, 136 insertions(+), 227 deletions(-) diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index 35cb194..6627743 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -18,7 +18,6 @@ module Web.Stripe.Types where ------------------------------------------------------------------------------ import Control.Applicative (pure, (<$>), (<*>), (<|>)) -import Control.Monad (mzero) import Data.Aeson (FromJSON (parseJSON), ToJSON(..), withText, withObject, Value (String, Object, Bool), (.:), (.:?)) @@ -110,13 +109,7 @@ newtype Date = Date UTCTime -- | `ChargeId` associated with a `Charge` newtype ChargeId = ChargeId Text - deriving (Read, Show, Eq, Ord, Data, Typeable) - ------------------------------------------------------------------------------- --- | JSON Instance for `ChargeId` -instance FromJSON ChargeId where - parseJSON (String x) = pure $ ChargeId x - parseJSON _ = mzero + deriving (Read, Show, Eq, Ord, Data, Typeable, FromJSON) ------------------------------------------------------------------------------ -- | `StatementDescription` to be added to a `Charge` @@ -157,7 +150,7 @@ data Charge = Charge { ------------------------------------------------------------------------------ -- | JSON Instance for `Charge` instance FromJSON Charge where - parseJSON (Object o) = + parseJSON = withObject "Charge" $ \o -> Charge <$> (ChargeId <$> o .: "id") <*> o .: "object" <*> (fromSeconds <$> o .: "created") @@ -181,7 +174,6 @@ instance FromJSON Charge where <*> o .:? "statement_description" <*> o .:? "receipt_email" <*> o .:? "receipt_number" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | Capture for `Charge` @@ -209,7 +201,7 @@ data Refund = Refund { ------------------------------------------------------------------------------ -- | JSON Instance for `Refund` instance FromJSON Refund where - parseJSON (Object o) = + parseJSON = withObject "Refund" $ \o -> Refund <$> (RefundId <$> o .: "id") <*> o .: "amount" <*> o .: "currency" @@ -218,7 +210,6 @@ instance FromJSON Refund where <*> o .: "charge" <*> o .:? "balance_transaction" <*> o .: "metadata" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `RefundApplicationFee` @@ -238,13 +229,7 @@ data RefundReason -- | `CustomerId` for a `Customer` newtype CustomerId = CustomerId Text - deriving (Read, Show, Eq, Ord, Data, Typeable) - ------------------------------------------------------------------------------- --- | JSON Instance for `CustomerId` -instance FromJSON CustomerId where - parseJSON (String x) = pure (CustomerId x) - parseJSON _ = mzero + deriving (Read, Show, Eq, Ord, Data, Typeable, FromJSON) ------------------------------------------------------------------------------ -- | `Customer` object @@ -271,8 +256,8 @@ data Customer = Customer { ------------------------------------------------------------------------------ -- | JSON Instance for `Customer` instance FromJSON Customer where - parseJSON (Object o) - = (DeletedCustomer + parseJSON = withObject "Customer" $ \o -> + (DeletedCustomer <$> o .: "deleted" <*> (CustomerId <$> o .: "id")) <|> (Customer @@ -290,7 +275,6 @@ instance FromJSON Customer where <*> o .:? "currency" <*> o .:? "default_card" <*> o .: "metadata") - parseJSON o = typeMismatch "Customer" o ------------------------------------------------------------------------------ -- | AccountBalance for a `Customer` @@ -300,24 +284,12 @@ newtype AccountBalance = AccountBalance Int ------------------------------------------------------------------------------ -- | CardId for a `Customer` newtype CardId = CardId Text - deriving (Eq, Ord, Read, Show, Data, Typeable) + deriving (Eq, Ord, Read, Show, Data, Typeable, FromJSON) ------------------------------------------------------------------------------ -- | CardId for a `Recipient` newtype RecipientCardId = RecipientCardId Text - deriving (Eq, Ord, Read, Show, Data, Typeable) - ------------------------------------------------------------------------------- --- | JSON Instance for `CardId` -instance FromJSON CardId where - parseJSON (String x) = pure $ CardId x - parseJSON _ = mzero - ------------------------------------------------------------------------------- --- | JSON Instance for `RecipientCardId` -instance FromJSON RecipientCardId where - parseJSON (String x) = pure $ RecipientCardId x - parseJSON _ = mzero + deriving (Eq, Ord, Read, Show, Data, Typeable, FromJSON) ------------------------------------------------------------------------------ -- | Number associated with a `Card` @@ -378,13 +350,14 @@ data Brand = Visa ------------------------------------------------------------------------------ -- | JSON Instance for `Brand` instance FromJSON Brand where - parseJSON (String "American Express") = pure AMEX - parseJSON (String "MasterCard") = pure MasterCard - parseJSON (String "Discover") = pure Discover - parseJSON (String "JCB") = pure JCB - parseJSON (String "Visa") = pure Visa - parseJSON (String "DinersClub") = pure DinersClub - parseJSON _ = mzero + parseJSON = withText "Brand" $ \t -> case t of + "American Express" -> pure AMEX + "MasterCard" -> pure MasterCard + "Discover" -> pure Discover + "JCB" -> pure JCB + "Visa" -> pure Visa + "DinersClub" -> pure DinersClub + _ -> fail $ "Unknown brand: " <> T.unpack t ------------------------------------------------------------------------------ -- | `Card` Object @@ -439,7 +412,7 @@ data RecipientCard = RecipientCard { ------------------------------------------------------------------------------ -- | JSON Instance for `Card` instance FromJSON Card where - parseJSON (Object o) = + parseJSON = withObject "Card" $ \o -> Card <$> (CardId <$> o .: "id") <*> o .: "object" <*> o .: "last4" @@ -461,12 +434,11 @@ instance FromJSON Card where <*> o .:? "address_zip_check" <*> o .:? "customer" <*> o .: "metadata" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | JSON Instance for `RecipientCard` instance FromJSON RecipientCard where - parseJSON (Object o) = + parseJSON = withObject "RecipientCard" $ \o -> RecipientCard <$> (RecipientCardId <$> o .: "id") <*> o .: "last4" @@ -487,7 +459,6 @@ instance FromJSON RecipientCard where <*> o .:? "address_line1_check" <*> o .:? "address_zip_check" <*> o .:? "recipient" - parseJSON _ = mzero ------------------------------------------------------------------------------ @@ -540,13 +511,7 @@ data DefaultCard = DefaultCard { getDefaultCard :: CardId } ------------------------------------------------------------------------------ -- | `SubscriptionId` for a `Subscription` newtype SubscriptionId = SubscriptionId { getSubscriptionId :: Text } - deriving (Read, Show, Eq, Ord, Data, Typeable) - ------------------------------------------------------------------------------- --- | JSON Instance for `SubscriptionId` -instance FromJSON SubscriptionId where - parseJSON (String x) = pure (SubscriptionId x) - parseJSON _ = mzero + deriving (Read, Show, Eq, Ord, Data, Typeable, FromJSON) data Session = Session { @@ -606,7 +571,7 @@ data Subscription = Subscription { ------------------------------------------------------------------------------ -- | JSON Instance for `Subscription` instance FromJSON Subscription where - parseJSON (Object o) = + parseJSON = withObject "Subscription" $ \o -> Subscription <$> (SubscriptionId <$> o .: "id") <*> o .: "plan" <*> o .: "object" @@ -625,7 +590,6 @@ instance FromJSON Subscription where <*> o .:? "discount" <*> o .: "metadata" <*> o .:? "tax_percent" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | Status of a `Subscription` @@ -640,12 +604,13 @@ data SubscriptionStatus = ------------------------------------------------------------------------------ -- | JSON Instance for `SubscriptionStatus` instance FromJSON SubscriptionStatus where - parseJSON (String "trialing") = pure Trialing - parseJSON (String "active") = pure Active - parseJSON (String "past_due") = pure PastDue - parseJSON (String "canceled") = pure Canceled - parseJSON (String "unpaid") = pure UnPaid - parseJSON _ = mzero + parseJSON = withText "SubscriptionStatus" $ \t -> case t of + "trialing" -> pure Trialing + "active" -> pure Active + "past_due" -> pure PastDue + "canceled" -> pure Canceled + "unpaid" -> pure UnPaid + _ -> fail $ "Unknown SubscriptionStatus: " <> T.unpack t ------------------------------------------------------------------------------ -- | `TaxPercent` for a `Subscription` @@ -676,7 +641,7 @@ data Plan = Plan { ------------------------------------------------------------------------------ -- | JSON Instance for `Plan` instance FromJSON Plan where - parseJSON (Object o) = + parseJSON = withObject "Plan" $ \o -> Plan <$> o .: "interval" <*> o .: "name" <*> (fromSeconds <$> o .: "created") @@ -689,7 +654,6 @@ instance FromJSON Plan where <*> o .:? "trial_period_days" <*> o .: "metadata" <*> o .:? "statement_description" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `TrialPeriod` for a Plan @@ -707,11 +671,12 @@ data Interval = Day | Week | Month | Year deriving (Eq, Ord, Data, Typeable) ------------------------------------------------------------------------------ -- | JSON Instance for `Interval` instance FromJSON Interval where - parseJSON (String "day") = pure Day - parseJSON (String "week") = pure Week - parseJSON (String "month") = pure Month - parseJSON (String "year") = pure Year - parseJSON _ = mzero + parseJSON = withText "Interval" $ \t -> case t of + "day" -> pure Day + "week" -> pure Week + "month" -> pure Month + "year" -> pure Year + _ -> fail $ "Unknown Interval: " <> T.unpack t ------------------------------------------------------------------------------ -- | `Show` instance for `Interval` @@ -758,11 +723,11 @@ instance Read Duration where ------------------------------------------------------------------------------ -- | JSON Instance for `Duration` instance FromJSON Duration where - parseJSON (String x) - | x == "forever" = pure Forever - | x == "once" = pure Once - | x == "repeating" = pure Repeating - parseJSON _ = mzero + parseJSON = withText "Duration" $ \t -> case t of + "forever" -> pure Forever + "once" -> pure Once + "repeating" -> pure Repeating + _ -> fail $ "Unknown Duration: " <> T.unpack t ------------------------------------------------------------------------------ -- | `Coupon` Object @@ -785,7 +750,7 @@ data Coupon = Coupon { ------------------------------------------------------------------------------ -- | JSON Instance for `Coupon` instance FromJSON Coupon where - parseJSON (Object o) = + parseJSON = withObject "Coupon" $ \o -> Coupon <$> (CouponId <$> o .: "id") <*> (fromSeconds <$> o .: "created") <*> o .: "percent_off" @@ -799,7 +764,6 @@ instance FromJSON Coupon where <*> o .:? "duration_in_months" <*> o .: "valid" <*> o .: "metadata" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `CouponId` for a `Coupon` @@ -854,31 +818,24 @@ data Discount = Discount { ------------------------------------------------------------------------------ -- | JSON Instance for `Discount` instance FromJSON Discount where - parseJSON (Object o) = + parseJSON = withObject "Discount" $ \o -> Discount <$> o .: "coupon" <*> (fromSeconds <$> o .: "start") <*> (fmap fromSeconds <$> o .:? "end") <*> o .: "customer" <*> o .: "object" <*> (fmap SubscriptionId <$> o .:? "subscription") - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `Invoice` for a `Coupon` newtype InvoiceId = InvoiceId Text - deriving (Read, Show, Eq, Ord, Data, Typeable) - ------------------------------------------------------------------------------- --- | JSON Instance for `InvoiceId` -instance FromJSON InvoiceId where - parseJSON (String x) = pure $ InvoiceId x - parseJSON _ = mzero + deriving (Read, Show, Eq, Ord, Data, Typeable, FromJSON) ------------------------------------------------------------------------------ -- | `Invoice` Object data Invoice = Invoice { - invoiceDate :: UTCTime + invoiceDate :: Maybe UTCTime , invoiceId :: Maybe InvoiceId -- ^ If upcoming no ID will exist , invoicePeriodStart :: UTCTime , invoicePeriodEnd :: UTCTime @@ -911,8 +868,8 @@ data Invoice = Invoice { ------------------------------------------------------------------------------ -- | JSON Instance for `Invoice` instance FromJSON Invoice where - parseJSON (Object o) = - Invoice <$> (fromSeconds <$> o .: "date") + parseJSON = withObject "Invoice" $ \o -> + Invoice <$> (fmap fromSeconds <$> o .:? "date") <*> (fmap InvoiceId <$> o .:? "id") <*> (fromSeconds <$> o .: "period_start") <*> (fromSeconds <$> o .: "period_end") @@ -940,7 +897,6 @@ instance FromJSON Invoice where <*> o .:? "statement_description" <*> o .:? "description" <*> o .: "metadata" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `InvoiceItemId` for `InvoiceItem` @@ -953,7 +909,7 @@ newtype InvoiceItemId data InvoiceItem = InvoiceItem { invoiceItemObject :: Text , invoiceItemId :: InvoiceItemId - , invoiceItemDate :: UTCTime + , invoiceItemDate :: Maybe UTCTime , invoiceItemAmount :: Int , invoiceItemLiveMode :: Bool , invoiceItemProration :: Bool @@ -969,10 +925,10 @@ data InvoiceItem = InvoiceItem { ------------------------------------------------------------------------------ -- | JSON Instance for `InvoiceItem` instance FromJSON InvoiceItem where - parseJSON (Object o) = + parseJSON = withObject "InvoiceItem" $ \o -> InvoiceItem <$> o .: "object" <*> (InvoiceItemId <$> o .: "id") - <*> (fromSeconds <$> o .: "date") + <*> (fmap fromSeconds <$> o .:? "date") <*> o .: "amount" <*> o .: "livemode" <*> o .: "proration" @@ -983,7 +939,6 @@ instance FromJSON InvoiceItem where <*> (fmap Quantity <$> o .:? "quantity") <*> o .:? "subscription" <*> o .: "metadata" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `InvoiceLineItemId` for an `InvoiceLineItem` @@ -1000,9 +955,10 @@ data InvoiceLineItemType ------------------------------------------------------------------------------ -- | JSON Instance for `InvoiceLineItemType` instance FromJSON InvoiceLineItemType where - parseJSON (String "invoiceitem") = pure InvoiceItemType - parseJSON (String "subscription") = pure SubscriptionItemType - parseJSON _ = mzero + parseJSON = withText "InvoiceLineItemType" $ \t -> case t of + "invoiceitem" -> pure InvoiceItemType + "subscription" -> pure SubscriptionItemType + _ -> fail $ "Unknown InvoiceLineItemType: " <> T.unpack t ------------------------------------------------------------------------------ -- | `InvoiceLineItem` Object @@ -1031,15 +987,14 @@ data Period = Period { ------------------------------------------------------------------------------ -- | JSON Instance for `Period` instance FromJSON Period where - parseJSON (Object o) = + parseJSON = withObject "Period" $ \o -> Period <$> (fromSeconds <$> o .: "start") <*> (fromSeconds <$> o .: "end") - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | JSON Instance for `InvoiceLineItem` instance FromJSON InvoiceLineItem where - parseJSON (Object o) = + parseJSON = withObject "InvoiceLineItem" $ \o -> InvoiceLineItem <$> (InvoiceLineItemId <$> o .: "id") <*> o .: "object" <*> o .: "type" @@ -1052,7 +1007,6 @@ instance FromJSON InvoiceLineItem where <*> o .:? "plan" <*> o .:? "description" <*> o .: "metadata" - parseJSON _ = mzero ------------------------------------------------------------------------------ @@ -1082,14 +1036,15 @@ data DisputeStatus ------------------------------------------------------------------------------ -- | JSON Instance for `DisputeReason` instance FromJSON DisputeReason where - parseJSON (String "duplicate") = pure Duplicate - parseJSON (String "fraudulent") = pure Fraudulent - parseJSON (String "subscription_canceled") = pure SubscriptionCanceled - parseJSON (String "product_unacceptable") = pure ProductUnacceptable - parseJSON (String "product_not_received") = pure ProductNotReceived - parseJSON (String "credit_not_processed") = pure CreditNotProcessed - parseJSON (String "general") = pure General - parseJSON _ = mzero + parseJSON = withText "DisputeReason" $ \t -> case t of + "duplicate" -> pure Duplicate + "fraudulent" -> pure Fraudulent + "subscription_canceled" -> pure SubscriptionCanceled + "product_unacceptable" -> pure ProductUnacceptable + "product_not_received" -> pure ProductNotReceived + "credit_not_processed" -> pure CreditNotProcessed + "general" -> pure General + _ -> fail $ "Unknown DisputeReason: " <> T.unpack t ------------------------------------------------------------------------------ -- | Reason of a `Dispute` @@ -1107,14 +1062,15 @@ data DisputeReason ------------------------------------------------------------------------------ -- | JSON Instance for `DisputeStatus` instance FromJSON DisputeStatus where - parseJSON (String "needs_response") = pure NeedsResponse - parseJSON (String "warning_needs_response") = pure WarningNeedsResponse - parseJSON (String "warning_under_review") = pure WarningUnderReview - parseJSON (String "under_review") = pure UnderReview - parseJSON (String "charge_refunded") = pure ChargeRefunded - parseJSON (String "won") = pure Won - parseJSON (String "lost") = pure Lost - parseJSON _ = mzero + parseJSON = withText "DisputeStatus" $ \t -> case t of + "needs_response" -> pure NeedsResponse + "warning_needs_response" -> pure WarningNeedsResponse + "warning_under_review" -> pure WarningUnderReview + "under_review" -> pure UnderReview + "charge_refunded" -> pure ChargeRefunded + "won" -> pure Won + "lost" -> pure Lost + _ -> fail $ "Unknown DisputeStatus: " <> T.unpack t ------------------------------------------------------------------------------ -- | `Dispute` Object @@ -1141,7 +1097,7 @@ newtype Evidence = Evidence Text deriving (Read, Show, Eq, Ord, Data, Typeable) ------------------------------------------------------------------------------ -- | JSON Instance for `Dispute` instance FromJSON Dispute where - parseJSON (Object o) = + parseJSON = withObject "Dispute" $ \o -> Dispute <$> o .: "charge" <*> o .: "amount" <*> (fromSeconds <$> o .: "created") @@ -1155,7 +1111,6 @@ instance FromJSON Dispute where <*> (fromSeconds <$> o .: "evidence_due_by") <*> (fmap Evidence <$> o .:? "evidence") <*> o .: "metadata" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `TransferId` @@ -1167,6 +1122,7 @@ newtype TransferId = data TransferStatus = TransferPaid | TransferPending + | TransferInTransit | TransferCanceled | TransferFailed deriving (Read, Show, Eq, Ord, Data, Typeable) @@ -1181,17 +1137,20 @@ data TransferType = ------------------------------------------------------------------------------ -- | JSON Instance for `TransferType` instance FromJSON TransferType where - parseJSON (String "card") = pure CardTransfer - parseJSON (String "bank_account") = pure BankAccountTransfer - parseJSON _ = mzero + parseJSON = withText "TransferType" $ \t -> case t of + "card" -> pure CardTransfer + "bank_account" -> pure BankAccountTransfer + _ -> fail $ "Unknown TransferType: " <> T.unpack t ------------------------------------------------------------------------------ -- | JSON Instance for `TransferStatus` instance FromJSON TransferStatus where - parseJSON (String "paid") = pure TransferPaid - parseJSON (String "pending") = pure TransferPending - parseJSON (String "canceled") = pure TransferCanceled - parseJSON _ = mzero + parseJSON = withText "TransferStatus" $ \t -> case t of + "paid" -> pure TransferPaid + "pending" -> pure TransferPending + "in_transit" -> pure TransferInTransit + "canceled" -> pure TransferCanceled + _ -> fail $ "Unknown TransferStatus: " <> T.unpack t ------------------------------------------------------------------------------ -- | `Transfer` Object @@ -1199,7 +1158,7 @@ data Transfer = Transfer { transferId :: TransferId , transferObject :: Text , transferCreated :: UTCTime - , transferDate :: UTCTime + , transferDate :: Maybe UTCTime , transferLiveMode :: Bool , transferAmount :: Int , transferCurrency :: Currency @@ -1218,11 +1177,11 @@ data Transfer = Transfer { ------------------------------------------------------------------------------ -- | JSON Instance for `Transfer` instance FromJSON Transfer where - parseJSON (Object o) = + parseJSON = withObject "Transfer" $ \o -> Transfer <$> (TransferId <$> o .: "id") <*> o .: "object" <*> (fromSeconds <$> o .: "created") - <*> (fromSeconds <$> o .: "date") + <*> (fmap fromSeconds <$> o .:? "date") <*> o .: "livemode" <*> o .: "amount" <*> o .: "currency" @@ -1236,7 +1195,6 @@ instance FromJSON Transfer where <*> o .:? "statement_description" <*> o .:? "recipient" <*> o .: "metadata" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `BankAccount` Object @@ -1254,7 +1212,7 @@ data BankAccount = BankAccount { ------------------------------------------------------------------------------ -- | `BankAccount` JSON Instance instance FromJSON BankAccount where - parseJSON (Object o) = + parseJSON = withObject "BankAccount" $ \o -> BankAccount <$> (BankAccountId <$> o .: "id") <*> o .: "object" <*> o .: "last4" @@ -1263,7 +1221,6 @@ instance FromJSON BankAccount where <*> o .:? "status" <*> o .:? "fingerprint" <*> o .: "bank_name" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `BankAccountId` for `BankAccount` @@ -1279,11 +1236,12 @@ data BankAccountStatus = ------------------------------------------------------------------------------ -- | `BankAccountStatus` JSON instance instance FromJSON BankAccountStatus where - parseJSON (String "new") = pure $ New - parseJSON (String "validated") = pure Validated - parseJSON (String "verified") = pure Verified - parseJSON (String "errored") = pure Errored - parseJSON _ = mzero + parseJSON = withText "BankAccountStatus" $ \t -> case t of + "new" -> pure $ New + "validated" -> pure Validated + "verified" -> pure Verified + "errored" -> pure Errored + _ -> fail $ "Unknown BankAccountStatus: " <> T.unpack t ------------------------------------------------------------------------------ -- | Routing Number for Bank Account @@ -1328,13 +1286,7 @@ type MiddleInitial = Char -- | `RecipientId` for a `Recipient` newtype RecipientId = RecipientId Text - deriving (Read, Show, Eq, Ord, Data, Typeable) - ------------------------------------------------------------------------------- --- | JSON Instance for `RecipientId` -instance FromJSON RecipientId where - parseJSON (String x) = pure $ RecipientId x - parseJSON _ = mzero + deriving (Read, Show, Eq, Ord, Data, Typeable, FromJSON) ------------------------------------------------------------------------------ -- | `TaxID` @@ -1366,9 +1318,10 @@ instance Read RecipientType where ------------------------------------------------------------------------------ -- | JSON Instance for `RecipientType` instance FromJSON RecipientType where - parseJSON (String "individual") = pure Individual - parseJSON (String "corporation") = pure Corporation - parseJSON _ = mzero + parseJSON = withText "RecipientType" $ \t -> case t of + "individual" -> pure Individual + "corporation" -> pure Corporation + _ -> fail $ "Unknown RecipientType: " <> T.unpack t ------------------------------------------------------------------------------ -- | Recipient Object @@ -1393,7 +1346,7 @@ data Recipient = Recipient { ------------------------------------------------------------------------------ -- | JSON Instance for `Recipient` instance FromJSON Recipient where - parseJSON (Object o) = + parseJSON = withObject "Recipient" $ \o -> (Recipient <$> (RecipientId <$> o .: "id") <*> o .: "object" <*> (fromSeconds <$> o .: "created") @@ -1411,8 +1364,6 @@ instance FromJSON Recipient where <$> o .:? "deleted" <*> (RecipientId <$> o .: "id") - parseJSON _ = mzero - ------------------------------------------------------------------------------ -- | `PlanId` for a `Plan` newtype ApplicationFeeId = ApplicationFeeId Text deriving (Read, Show, Eq, Ord, Data, Typeable) @@ -1455,7 +1406,7 @@ newtype ApplicationId = ------------------------------------------------------------------------------ -- | JSON Instance for `ApplicationFee` instance FromJSON ApplicationFee where - parseJSON (Object o) = + parseJSON = withObject "ApplicationFee" $ \o -> ApplicationFee <$> (ApplicationFeeId <$> o .: "id") <*> o .: "object" <*> (fromSeconds <$> o .: "created") @@ -1470,7 +1421,6 @@ instance FromJSON ApplicationFee where <*> (ApplicationId <$> o .: "application") <*> o .: "charge" <*> o .: "metadata" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `FeeId` for objects with Fees @@ -1494,7 +1444,8 @@ data ApplicationFeeRefund = ApplicationFeeRefund { ------------------------------------------------------------------------------ -- | JSON Instance for `ApplicationFeeRefund` instance FromJSON ApplicationFeeRefund where - parseJSON (Object o) = ApplicationFeeRefund + parseJSON = withObject "ApplicationFeeRefund" $ \o -> + ApplicationFeeRefund <$> (RefundId <$> o .: "id") <*> o .: "amount" <*> o .: "currency" @@ -1503,19 +1454,12 @@ instance FromJSON ApplicationFeeRefund where <*> o .:? "balance_transaction" <*> (FeeId <$> o .: "fee") <*> o .: "metadata" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `AccountId` of an `Account` newtype AccountId = AccountId Text - deriving (Read, Show, Eq, Ord, Data, Typeable) - ------------------------------------------------------------------------------- --- | JSON Instance for `AccountId` -instance FromJSON AccountId where - parseJSON (String aid) = pure $ AccountId aid - parseJSON _ = mzero + deriving (Read, Show, Eq, Ord, Data, Typeable, FromJSON) ------------------------------------------------------------------------------ -- | `Account` Object @@ -1541,7 +1485,7 @@ data Account = Account { ------------------------------------------------------------------------------ -- | JSON Instance for `Account` instance FromJSON Account where - parseJSON (Object o) = + parseJSON = withObject "Account" $ \o -> Account <$> (AccountId <$> o .: "id") <*> (Email <$> o .: "email") <*> o .:? "statement_descriptor" @@ -1558,7 +1502,6 @@ instance FromJSON Account where <*> o .:? "business_url" <*> o .:? "business_logo" <*> o .:? "support_phone" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `Balance` Object @@ -1572,12 +1515,11 @@ data Balance = Balance { ------------------------------------------------------------------------------ -- | JSON Instance for `Balance` instance FromJSON Balance where - parseJSON (Object o) = + parseJSON = withObject "Balance" $ \o -> Balance <$> o .: "pending" <*> o .: "available" <*> o .: "livemode" <*> o .: "object" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `BalanceAmount` Object @@ -1589,10 +1531,9 @@ data BalanceAmount = BalanceAmount { ------------------------------------------------------------------------------ -- | JSON Instance for `BalanceAmount` instance FromJSON BalanceAmount where - parseJSON (Object o) = + parseJSON = withObject "BalanceAmount" $ \o -> BalanceAmount <$> o .: "amount" <*> o .: "currency" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `BalanceTransaction` Object @@ -1615,7 +1556,7 @@ data BalanceTransaction = BalanceTransaction { ------------------------------------------------------------------------------ -- | JSON Instance for `BalanceTransaction` instance FromJSON BalanceTransaction where - parseJSON (Object o) = + parseJSON = withObject "BalanceTransaction" $ \o -> BalanceTransaction <$> (TransactionId <$> o .: "id") <*> o .: "object" <*> o .: "amount" @@ -1629,18 +1570,11 @@ instance FromJSON BalanceTransaction where <*> o .: "fee_details" <*> o .: "source" <*> o .:? "description" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `TransactionId` of a `Transaction` newtype TransactionId = TransactionId Text - deriving (Read, Show, Eq, Ord, Data, Typeable) - ------------------------------------------------------------------------------- --- | JSON Instance for `TransactionId` -instance FromJSON TransactionId where - parseJSON (String x) = pure (TransactionId x) - parseJSON _ = mzero + deriving (Read, Show, Eq, Ord, Data, Typeable, FromJSON) ------------------------------------------------------------------------------ -- | `FeeDetails` Object @@ -1655,13 +1589,12 @@ data FeeDetails = FeeDetails { ------------------------------------------------------------------------------ -- | JSON Instance for `FeeDetails` instance FromJSON FeeDetails where - parseJSON (Object o) = + parseJSON = withObject "FeeDetails" $ \o -> FeeDetails <$> o .: "amount" <*> o .: "currency" <*> o .: "type" <*> o .: "description" <*> o .:? "application" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `Source` used for filtering `Balance` transactions. It should contain @@ -1683,15 +1616,16 @@ data TransactionType deriving (Read, Show, Eq, Ord, Data, Typeable) instance FromJSON TransactionType where - parseJSON (String "charge") = pure ChargeTxn - parseJSON (String "refund") = pure RefundTxn - parseJSON (String "adjustment") = pure AdjustmentTxn - parseJSON (String "application_fee") = pure ApplicationFeeTxn - parseJSON (String "application_fee_refund") = pure ApplicationFeeRefundTxn - parseJSON (String "transfer") = pure TransferTxn - parseJSON (String "transfer_cancel") = pure TransferCancelTxn - parseJSON (String "transfer_failure") = pure TransferFailureTxn - parseJSON _ = mzero + parseJSON = withText "TransactionType" $ \t -> case t of + "charge" -> pure ChargeTxn + "refund" -> pure RefundTxn + "adjustment" -> pure AdjustmentTxn + "application_fee" -> pure ApplicationFeeTxn + "application_fee_refund" -> pure ApplicationFeeRefundTxn + "transfer" -> pure TransferTxn + "transfer_cancel" -> pure TransferCancelTxn + "transfer_failure" -> pure TransferFailureTxn + _ -> fail $ "Unknown TransactionType: " <> T.unpack t instance ToJSON TransactionType where toJSON ChargeTxn = String "charge" @@ -1857,7 +1791,7 @@ data Event = Event { ------------------------------------------------------------------------------ -- | JSON Instance for `Event` instance FromJSON Event where - parseJSON (Object o) = do + parseJSON = withObject "Event" $ \o -> do eventId <- fmap EventId <$> o .:? "id" eventCreated <- fromSeconds <$> o .: "created" eventLiveMode <- o .: "livemode" @@ -1921,7 +1855,6 @@ instance FromJSON Event where eventPendingWebHooks <- o .: "pending_webhooks" eventRequest <- o .:? "request" return Event {..} - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `PaymentIntentId` for `PaymentIntent` @@ -2126,11 +2059,10 @@ data ConnectApp = ConnectApp { ------------------------------------------------------------------------------ -- | Connect Application JSON instance instance FromJSON ConnectApp where - parseJSON (Object o) = + parseJSON = withObject "ConnectApp" $ \o -> ConnectApp <$> o .:? "id" <*> o .: "object" <*> o .: "name" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `TokenId` of a `Token` @@ -2147,9 +2079,10 @@ data TokenType = TokenCard ------------------------------------------------------------------------------ -- | JSON Instance for `TokenType` instance FromJSON TokenType where - parseJSON (String "bank_account") = pure TokenBankAccount - parseJSON (String "card") = pure TokenCard - parseJSON _ = mzero + parseJSON = withText "TokenType" $ \t -> case t of + "bank_account" -> pure TokenBankAccount + "card" -> pure TokenCard + _ -> fail $ "Unknown TokenType: " <> T.unpack t ------------------------------------------------------------------------------ -- | `Token` Object @@ -2166,7 +2099,7 @@ data Token a = Token { ------------------------------------------------------------------------------ -- | JSON Instance for `Token` instance FromJSON a => FromJSON (Token a) where - parseJSON (Object o) = do + parseJSON = withObject "Token" $ \o -> do tokenId <- TokenId <$> o .: "id" Bool tokenLiveMode <- o .: "livemode" tokenCreated <- fromSeconds <$> o .: "created" @@ -2181,9 +2114,8 @@ instance FromJSON a => FromJSON (Token a) where case typ of "bank_account" -> o .: "bank_account" "card" -> o .: "card" - _ -> mzero + _ -> fail $ "Unknown TokenData type: " <> T.unpack typ return Token {..} - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | Generic handling of Stripe JSON arrays @@ -2198,13 +2130,12 @@ data StripeList a = StripeList { ------------------------------------------------------------------------------ -- | JSON Instance for `StripeList` instance FromJSON a => FromJSON (StripeList a) where - parseJSON (Object o) = + parseJSON = withObject "StripeList" $ \o -> StripeList <$> o .: "data" <*> o .: "url" <*> o .: "object" <*> o .:? "total_count" <*> o .: "has_more" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | Pagination Option for `StripeList` @@ -2231,10 +2162,9 @@ data StripeDeleteResult = StripeDeleteResult { ------------------------------------------------------------------------------ -- | JSON Instance for `StripeDeleteResult` instance FromJSON StripeDeleteResult where - parseJSON (Object o) = + parseJSON = withObject "StripeDeleteResult" $ \o -> StripeDeleteResult <$> o .: "deleted" <*> o .:? "id" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | Type of MetaData for use on `Stripe` objects @@ -2619,7 +2549,7 @@ data BitcoinReceiver = BitcoinReceiver { ------------------------------------------------------------------------------ -- | FromJSON for BitcoinReceiverId instance FromJSON BitcoinReceiver where - parseJSON (Object o) = + parseJSON = withObject "BitcoinReceiver" $ \o -> BitcoinReceiver <$> (BitcoinReceiverId <$> o .: "id") <*> o .: "object" <*> (fromSeconds <$> o .: "created") @@ -2641,7 +2571,6 @@ instance FromJSON BitcoinReceiver where <*> o .:? "transactions" <*> (fmap PaymentId <$> o .:? "payment") <*> (fmap CustomerId <$> o .:? "customer") - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | Bitcoin Transactions @@ -2656,13 +2585,12 @@ data Transactions = Transactions { ------------------------------------------------------------------------------ -- | Bitcoin Transactions data instance FromJSON Transactions where - parseJSON (Object o) = + parseJSON = withObject "Transactions" $ \o -> Transactions <$> o .: "object" <*> o .: "total_count" <*> o .: "has_more" <*> o .: "url" <*> o .: "data" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | Bitcoin Transaction @@ -2679,7 +2607,7 @@ data BitcoinTransaction = BitcoinTransaction { ------------------------------------------------------------------------------ -- | FromJSON BitcoinTransaction instance FromJSON BitcoinTransaction where - parseJSON (Object o) = + parseJSON = withObject "BitcoinTransaction" $ \o -> BitcoinTransaction <$> o .: "id" <*> o .: "object" <*> (fromSeconds <$> o .: "created") @@ -2687,41 +2615,22 @@ instance FromJSON BitcoinTransaction where <*> 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 + deriving (Show, Eq, FromJSON) ------------------------------------------------------------------------------ -- | BTC ReceiverId newtype BitcoinReceiverId = BitcoinReceiverId Text - deriving (Show, Eq) - ------------------------------------------------------------------------------- --- | FromJSON for BitcoinReceiverId -instance FromJSON BitcoinReceiverId where - parseJSON (String x) = pure $ BitcoinReceiverId x - parseJSON _ = mzero + deriving (Show, Eq, FromJSON) ------------------------------------------------------------------------------ -- | BTC PaymentId newtype PaymentId = PaymentId Text - deriving (Show, Eq) - ------------------------------------------------------------------------------- --- | FromJSON for PaymentId -instance FromJSON PaymentId where - parseJSON (String x) = pure $ PaymentId x - parseJSON _ = mzero + deriving (Show, Eq, FromJSON) ------------------------------------------------------------------------------ -- | Show an amount accounting for zero currencies From b8a44d634e16a8d18ce2bfe6ba717c9927af3c6d Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Tue, 1 Oct 2019 01:47:28 +0200 Subject: [PATCH 12/44] managed to fetch a payment intent --- stripe-core/src/Web/Stripe/Event.hs | 4 +- stripe-core/src/Web/Stripe/PaymentIntent.hs | 2 +- stripe-core/src/Web/Stripe/StripeRequest.hs | 8 +- stripe-core/src/Web/Stripe/Types.hs | 199 +++++++++++++------- 4 files changed, 143 insertions(+), 70 deletions(-) diff --git a/stripe-core/src/Web/Stripe/Event.hs b/stripe-core/src/Web/Stripe/Event.hs index 6ca6f5b..33a4cdf 100644 --- a/stripe-core/src/Web/Stripe/Event.hs +++ b/stripe-core/src/Web/Stripe/Event.hs @@ -50,7 +50,7 @@ import Web.Stripe.StripeRequest (Method (GET), import Web.Stripe.Util (()) import Web.Stripe.Types (Created(..), Event (..), EventId (..), Limit, - EventData(..), + EventData(..), ExpandParams(..), EventType(..), StripeList (..), Limit(..), StartingAfter(..), EndingBefore(..)) @@ -84,4 +84,4 @@ instance StripeHasParam GetEvents Created instance StripeHasParam GetEvents (EndingBefore EventId) instance StripeHasParam GetEvents Limit instance StripeHasParam GetEvents (StartingAfter EventId) --- instance StripeHasParam GetEvents EventType -- FIXME +instance StripeHasParam GetEvents EventType diff --git a/stripe-core/src/Web/Stripe/PaymentIntent.hs b/stripe-core/src/Web/Stripe/PaymentIntent.hs index bb0bec9..3cf6645 100644 --- a/stripe-core/src/Web/Stripe/PaymentIntent.hs +++ b/stripe-core/src/Web/Stripe/PaymentIntent.hs @@ -73,7 +73,7 @@ getPaymentIntent getPaymentIntent (PaymentIntentId paymentIntentid) = request where request = mkStripeRequest GET url params - url = "payment_intents" paymentIntentid "refunds" + url = "payment_intents" paymentIntentid params = [] data GetPaymentIntent diff --git a/stripe-core/src/Web/Stripe/StripeRequest.hs b/stripe-core/src/Web/Stripe/StripeRequest.hs index 1b8d4c8..562a14a 100644 --- a/stripe-core/src/Web/Stripe/StripeRequest.hs +++ b/stripe-core/src/Web/Stripe/StripeRequest.hs @@ -51,7 +51,7 @@ import Web.Stripe.Types (AccountBalance(..), AccountNumber(..), CustomerId(..), CVC(..), Date(..), DefaultCard(..), Description(..), Duration(..), DurationInMonths(..), - Email(..), EndingBefore(..), EventId(..), + Email(..), EndingBefore(..), EventId(..), EventType(..), Evidence(..), Expandable(..), ExpandParams(..), ExpMonth(..), ExpYear(..), Forgiven(..), Interval(..), @@ -73,7 +73,7 @@ import Web.Stripe.Types (AccountBalance(..), AccountNumber(..), TokenId(..), TransactionId(..), TransactionType(..), TransferId(..), TransferStatus(..), TrialEnd(..), SuccessUrl(..), CancelUrl(..), LineItems(..), LineItem(..), - TrialPeriodDays(..)) + TrialPeriodDays(..), eventTypeText) import Web.Stripe.Util (toBytestring, toExpandable,toMetaData, encodeList, toSeconds, getParams, toText) @@ -238,6 +238,10 @@ instance ToStripeParam EventId where toStripeParam (EventId eid) = (("event", Text.encodeUtf8 eid) :) +instance ToStripeParam EventType where + toStripeParam et = + (("type", Text.encodeUtf8 (eventTypeText et)) :) + instance ToStripeParam Evidence where toStripeParam (Evidence txt) = (("evidence", Text.encodeUtf8 txt) :) diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index 6627743..aa743a4 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -19,9 +19,8 @@ module Web.Stripe.Types where ------------------------------------------------------------------------------ import Control.Applicative (pure, (<$>), (<*>), (<|>)) import Data.Aeson (FromJSON (parseJSON), ToJSON(..), withText, withObject, - Value (String, Object, Bool), (.:), + Value (String, Bool), (.:), (.:?)) -import Data.Aeson.Types (typeMismatch) import Data.Data (Data, Typeable) import qualified Data.HashMap.Strict as H import Data.Ratio ((%)) @@ -63,6 +62,7 @@ type instance ExpandsTo PaymentMethodId = PaymentMethod type instance ExpandsTo RecipientId = Recipient type instance ExpandsTo RecipientCardId = RecipientCard type instance ExpandsTo TransactionId = BalanceTransaction +type instance ExpandsTo PaymentIntentId = PaymentIntent ------------------------------------------------------------------------------ -- | JSON Instance for `Expandable` @@ -516,20 +516,29 @@ newtype SubscriptionId = SubscriptionId { getSubscriptionId :: Text } data Session = Session { sessionId :: SessionId - + , sessionCancelUrl :: CancelUrl + , sessionSuccessUrl :: SuccessUrl + , sessionLivemode :: Bool + , sessionPaymentIntent :: Expandable PaymentIntentId + , sessionCustomer :: Expandable CustomerId } deriving (Read, Show, Eq, Ord, Data, Typeable) instance FromJSON Session where parseJSON = withObject "Session" $ \o -> Session <$> (SessionId <$> o .: "id") + <*> o .: "cancel_url" + <*> o .: "success_url" + <*> o .: "livemode" + <*> o .: "payment_intent" + <*> o .: "customer" newtype SessionId = SessionId { getSessionId :: Text } deriving (Read, Show, Eq, Ord, Data, Typeable) newtype SuccessUrl = SucessUrl { getSuccessUrl :: Text } - deriving (Read, Show, Eq, Ord, Data, Typeable) + deriving (Read, Show, Eq, Ord, Data, Typeable, FromJSON) newtype CancelUrl = CancelUrl { getCancelUrl :: Text } - deriving (Read, Show, Eq, Ord, Data, Typeable) + deriving (Read, Show, Eq, Ord, Data, Typeable, FromJSON) newtype LineItems = LineItems { getLineItems :: [LineItem] } deriving (Read, Show, Eq, Ord, Data, Typeable) @@ -1668,6 +1677,7 @@ data EventType = | CustomerDiscountCreatedEvent | CustomerDiscountUpdatedEvent | CustomerDiscountDeletedEvent + | CheckoutSessionCompletedEvent | InvoiceCreatedEvent | InvoiceUpdatedEvent | InvoicePaymentSucceededEvent @@ -1696,57 +1706,114 @@ data EventType = ------------------------------------------------------------------------------ -- | Event Types JSON Instance instance FromJSON EventType where - parseJSON (String "account.updated") = pure AccountUpdatedEvent - parseJSON (String "account.application.deauthorized") = pure AccountApplicationDeauthorizedEvent - parseJSON (String "application_fee.created") = pure ApplicationFeeCreatedEvent - parseJSON (String "application_fee.refunded") = pure ApplicationFeeRefundedEvent - parseJSON (String "balance.available") = pure BalanceAvailableEvent - parseJSON (String "charge.succeeded") = pure ChargeSucceededEvent - parseJSON (String "charge.failed") = pure ChargeFailedEvent - parseJSON (String "charge.refunded") = pure ChargeRefundedEvent - parseJSON (String "charge.captured") = pure ChargeCapturedEvent - parseJSON (String "charge.updated") = pure ChargeUpdatedEvent - parseJSON (String "charge.dispute.created") = pure ChargeDisputeCreatedEvent - parseJSON (String "charge.dispute.updated") = pure ChargeDisputeUpdatedEvent - parseJSON (String "charge.dispute.closed") = pure ChargeDisputeClosedEvent - parseJSON (String "charge.dispute.funds_withdrawn") = pure ChargeDisputeFundsWithdrawnEvent - parseJSON (String "charge.dispute.funds_reinstated") = pure ChargeDisputeFundsReinstatedEvent - parseJSON (String "customer.created") = pure CustomerCreatedEvent - parseJSON (String "customer.updated") = pure CustomerUpdatedEvent - parseJSON (String "customer.deleted") = pure CustomerDeletedEvent - parseJSON (String "customer.card.created") = pure CustomerCardCreatedEvent - parseJSON (String "customer.card.updated") = pure CustomerCardUpdatedEvent - parseJSON (String "customer.card.deleted") = pure CustomerCardDeletedEvent - parseJSON (String "customer.subscription.created") = pure CustomerSubscriptionCreatedEvent - parseJSON (String "customer.subscription.updated") = pure CustomerSubscriptionUpdatedEvent - parseJSON (String "customer.subscription.deleted") = pure CustomerSubscriptionDeletedEvent - parseJSON (String "customer.subscription.trial_will_end") = pure CustomerSubscriptionTrialWillEndEvent - parseJSON (String "customer.discount.created") = pure CustomerDiscountCreatedEvent - parseJSON (String "customer.discount.updated") = pure CustomerDiscountUpdatedEvent - parseJSON (String "invoice.created") = pure InvoiceCreatedEvent - parseJSON (String "invoice.updated") = pure InvoiceUpdatedEvent - parseJSON (String "invoice.payment_succeeded") = pure InvoicePaymentSucceededEvent - parseJSON (String "invoice.payment_failed") = pure InvoicePaymentFailedEvent - parseJSON (String "invoiceitem.created") = pure InvoiceItemCreatedEvent - parseJSON (String "invoiceitem.updated") = pure InvoiceItemUpdatedEvent - parseJSON (String "invoiceitem.deleted") = pure InvoiceItemDeletedEvent - parseJSON (String "plan.created") = pure PlanCreatedEvent - parseJSON (String "plan.updated") = pure PlanUpdatedEvent - parseJSON (String "plan.deleted") = pure PlanDeletedEvent - parseJSON (String "coupon.created") = pure CouponCreatedEvent - parseJSON (String "coupon.updated") = pure CouponUpdatedEvent - parseJSON (String "coupon.deleted") = pure CouponDeletedEvent - parseJSON (String "recipient.created") = pure RecipientCreatedEvent - parseJSON (String "recipient.updated") = pure RecipientUpdatedEvent - parseJSON (String "recipient.deleted") = pure RecipientDeletedEvent - parseJSON (String "transfer.created") = pure TransferCreatedEvent - parseJSON (String "transfer.updated") = pure TransferUpdatedEvent - parseJSON (String "transfer.canceled") = pure TransferCanceledEvent - parseJSON (String "transfer.paid") = pure TransferPaidEvent - parseJSON (String "transfer.failed") = pure TransferFailedEvent - parseJSON (String "ping") = pure PingEvent - parseJSON (String t) = pure $ UnknownEvent t - parseJSON _ = mempty + parseJSON = withText "EventType" $ \t -> case t of + "account.updated" -> pure AccountUpdatedEvent + "account.application.deauthorized" -> pure AccountApplicationDeauthorizedEvent + "application_fee.created" -> pure ApplicationFeeCreatedEvent + "application_fee.refunded" -> pure ApplicationFeeRefundedEvent + "balance.available" -> pure BalanceAvailableEvent + "charge.succeeded" -> pure ChargeSucceededEvent + "charge.failed" -> pure ChargeFailedEvent + "charge.refunded" -> pure ChargeRefundedEvent + "charge.captured" -> pure ChargeCapturedEvent + "charge.updated" -> pure ChargeUpdatedEvent + "charge.dispute.created" -> pure ChargeDisputeCreatedEvent + "charge.dispute.updated" -> pure ChargeDisputeUpdatedEvent + "charge.dispute.closed" -> pure ChargeDisputeClosedEvent + "charge.dispute.funds_withdrawn" -> pure ChargeDisputeFundsWithdrawnEvent + "charge.dispute.funds_reinstated" -> pure ChargeDisputeFundsReinstatedEvent + "customer.created" -> pure CustomerCreatedEvent + "customer.updated" -> pure CustomerUpdatedEvent + "customer.deleted" -> pure CustomerDeletedEvent + "customer.card.created" -> pure CustomerCardCreatedEvent + "customer.card.updated" -> pure CustomerCardUpdatedEvent + "customer.card.deleted" -> pure CustomerCardDeletedEvent + "customer.subscription.created" -> pure CustomerSubscriptionCreatedEvent + "customer.subscription.updated" -> pure CustomerSubscriptionUpdatedEvent + "customer.subscription.deleted" -> pure CustomerSubscriptionDeletedEvent + "checkout.session.completed" -> pure CheckoutSessionCompletedEvent + "customer.subscription.trial_will_end" -> pure CustomerSubscriptionTrialWillEndEvent + "customer.discount.created" -> pure CustomerDiscountCreatedEvent + "customer.discount.updated" -> pure CustomerDiscountUpdatedEvent + "invoice.created" -> pure InvoiceCreatedEvent + "invoice.updated" -> pure InvoiceUpdatedEvent + "invoice.payment_succeeded" -> pure InvoicePaymentSucceededEvent + "invoice.payment_failed" -> pure InvoicePaymentFailedEvent + "invoiceitem.created" -> pure InvoiceItemCreatedEvent + "invoiceitem.updated" -> pure InvoiceItemUpdatedEvent + "invoiceitem.deleted" -> pure InvoiceItemDeletedEvent + "plan.created" -> pure PlanCreatedEvent + "plan.updated" -> pure PlanUpdatedEvent + "plan.deleted" -> pure PlanDeletedEvent + "coupon.created" -> pure CouponCreatedEvent + "coupon.updated" -> pure CouponUpdatedEvent + "coupon.deleted" -> pure CouponDeletedEvent + "recipient.created" -> pure RecipientCreatedEvent + "recipient.updated" -> pure RecipientUpdatedEvent + "recipient.deleted" -> pure RecipientDeletedEvent + "transfer.created" -> pure TransferCreatedEvent + "transfer.updated" -> pure TransferUpdatedEvent + "transfer.canceled" -> pure TransferCanceledEvent + "transfer.paid" -> pure TransferPaidEvent + "transfer.failed" -> pure TransferFailedEvent + "ping" -> pure PingEvent + _ -> pure $ UnknownEvent t + + +eventTypeText :: EventType -> Text +eventTypeText et = case et of + AccountUpdatedEvent -> "account.updated" + AccountApplicationDeauthorizedEvent -> "account.application.deauthorized" + ApplicationFeeCreatedEvent -> "application_fee.created" + ApplicationFeeRefundedEvent -> "application_fee.refunded" + BalanceAvailableEvent -> "balance.available" + ChargeSucceededEvent -> "charge.succeeded" + ChargeFailedEvent -> "charge.failed" + ChargeRefundedEvent -> "charge.refunded" + ChargeCapturedEvent -> "charge.captured" + ChargeUpdatedEvent -> "charge.updated" + ChargeDisputeCreatedEvent -> "charge.dispute.created" + ChargeDisputeUpdatedEvent -> "charge.dispute.updated" + ChargeDisputeClosedEvent -> "charge.dispute.closed" + ChargeDisputeFundsWithdrawnEvent -> "charge.dispute.funds_withdrawn" + ChargeDisputeFundsReinstatedEvent -> "charge.dispute.funds_reinstated" + CustomerCreatedEvent -> "customer.created" + CustomerUpdatedEvent -> "customer.updated" + CustomerDeletedEvent -> "customer.deleted" + CustomerCardCreatedEvent -> "customer.card.created" + CustomerCardUpdatedEvent -> "customer.card.updated" + CustomerCardDeletedEvent -> "customer.card.deleted" + CustomerSubscriptionCreatedEvent -> "customer.subscription.created" + CustomerSubscriptionUpdatedEvent -> "customer.subscription.updated" + CustomerSubscriptionDeletedEvent -> "customer.subscription.deleted" + CustomerSubscriptionTrialWillEndEvent -> "customer.subscription.trial_will_end" + CustomerDiscountCreatedEvent -> "customer.discount.created" + CustomerDiscountUpdatedEvent -> "customer.discount.updated" + CustomerDiscountDeletedEvent -> "customer.discount.deleted" + CheckoutSessionCompletedEvent -> "checkout.session.completed" + InvoiceCreatedEvent -> "invoice.created" + InvoiceUpdatedEvent -> "invoice.updated" + InvoicePaymentSucceededEvent -> "invoice.payment_succeeded" + InvoicePaymentFailedEvent -> "invoice.payment_failed" + InvoiceItemCreatedEvent -> "invoiceitem.created" + InvoiceItemUpdatedEvent -> "invoiceitem.updated" + InvoiceItemDeletedEvent -> "invoiceitem.deleted" + PlanCreatedEvent -> "plan.created" + PlanUpdatedEvent -> "plan.updated" + PlanDeletedEvent -> "plan.deleted" + CouponCreatedEvent -> "coupon.created" + CouponUpdatedEvent -> "coupon.updated" + CouponDeletedEvent -> "coupon.deleted" + RecipientCreatedEvent -> "recipient.created" + RecipientUpdatedEvent -> "recipient.updated" + RecipientDeletedEvent -> "recipient.deleted" + TransferCreatedEvent -> "transfer.created" + TransferUpdatedEvent -> "transfer.updated" + TransferCanceledEvent -> "transfer.canceled" + TransferPaidEvent -> "transfer.paid" + TransferFailedEvent -> "transfer.failed" + PingEvent -> "ping" + UnknownEvent t -> t ------------------------------------------------------------------------------ -- | `EventId` of an `Event` @@ -1771,9 +1838,10 @@ data EventData = | SubscriptionEvent Subscription | DiscountEvent Discount | InvoiceItemEvent InvoiceItem - | UnknownEventData + | CheckoutEvent Session + | UnknownEventData Value | Ping - deriving (Read, Show, Eq, Ord, Data, Typeable) + deriving (Read, Show, Eq, Data, Typeable) ------------------------------------------------------------------------------ -- | `Event` Object @@ -1786,7 +1854,7 @@ data Event = Event { , eventObject :: Text , eventPendingWebHooks :: Int , eventRequest :: Maybe Text -} deriving (Read, Show, Eq, Ord, Data, Typeable) +} deriving (Read, Show, Eq, Data, Typeable) ------------------------------------------------------------------------------ -- | JSON Instance for `Event` @@ -1797,8 +1865,8 @@ instance FromJSON Event where eventLiveMode <- o .: "livemode" eventType <- o .: "type" String etype <- o .: "type" - obj <- o .: "data" - eventData <- + dataVal <- o .: "data" + eventData <- flip (withObject "EventData") dataVal $ \obj -> case etype of "account.updated" -> AccountEvent <$> obj .: "object" "account.application.deauthorized" -> AccountApplicationEvent <$> obj .: "object" @@ -1828,6 +1896,7 @@ instance FromJSON Event where "customer.discount.created" -> DiscountEvent <$> obj .: "object" "customer.discount.updated" -> DiscountEvent <$> obj .: "object" "customer.discount.deleted" -> DiscountEvent <$> obj .: "object" + "checkout.session.completed" -> CheckoutEvent <$> obj .: "object" "invoice.created" -> InvoiceEvent <$> obj .: "object" "invoice.updated" -> InvoiceEvent <$> obj .: "object" "invoice.payment_succeeded" -> InvoiceEvent <$> obj .: "object" @@ -1850,7 +1919,7 @@ instance FromJSON Event where "transfer.paid" -> TransferEvent <$> obj .: "object" "transfer.failed" -> TransferEvent <$> obj .: "object" "ping" -> pure Ping - _ -> pure UnknownEventData + _ -> pure $ UnknownEventData dataVal eventObject <- o .: "object" eventPendingWebHooks <- o .: "pending_webhooks" eventRequest <- o .:? "request" @@ -1859,7 +1928,7 @@ instance FromJSON Event where ------------------------------------------------------------------------------ -- | `PaymentIntentId` for `PaymentIntent` newtype PaymentIntentId = - PaymentIntentId { getPaymentIntentId :: Text } deriving (Read, Show, Eq, Ord, Data, Typeable) + PaymentIntentId { getPaymentIntentId :: Text } deriving (Read, Show, Eq, Ord, Data, Typeable, FromJSON) ------------------------------------------------------------------------------ -- | `PaymentIntent` Object @@ -1911,13 +1980,13 @@ instance FromJSON PaymentIntent where <*> o .:? "amount_received" <*> o .:? "application" <*> o .:? "application_fee_amount" - <*> o .:? "canceled_at" + <*> (fmap fromSeconds <$> o .:? "canceled_at") <*> o .:? "cancellation_reason" <*> o .: "capture_method" <*> o .:? "charges" <*> o .:? "client_secret" <*> o .: "confirmation_method" - <*> o .: "created" + <*> (fromSeconds <$> o .: "created") <*> o .: "currency" <*> o .:? "customer" <*> o .:? "invoice" From b14fd6351147830c1f139c552f3a169893ac5e64 Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Wed, 2 Oct 2019 00:11:36 +0200 Subject: [PATCH 13/44] intermediary commit --- stripe-core/src/Web/Stripe/Types.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index aa743a4..6a61b57 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -533,7 +533,7 @@ instance FromJSON Session where <*> o .: "customer" newtype SessionId = SessionId { getSessionId :: Text } - deriving (Read, Show, Eq, Ord, Data, Typeable) + deriving (Read, Show, Eq, Ord, Data, Typeable, FromJSON ) newtype SuccessUrl = SucessUrl { getSuccessUrl :: Text } deriving (Read, Show, Eq, Ord, Data, Typeable, FromJSON) @@ -1817,7 +1817,7 @@ eventTypeText et = case et of ------------------------------------------------------------------------------ -- | `EventId` of an `Event` -newtype EventId = EventId Text deriving (Read, Show, Eq, Ord, Data, Typeable) +newtype EventId = EventId Text deriving (Read, Show, Eq, Ord, Data, Typeable, FromJSON) ------------------------------------------------------------------------------ -- | EventData From c562c890a51a58a72174fc7388d5f5113f286be0 Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Wed, 2 Oct 2019 22:55:32 +0200 Subject: [PATCH 14/44] intermediate commmit --- stripe-core/src/Web/Stripe/Session.hs | 6 +++++- stripe-core/src/Web/Stripe/StripeRequest.hs | 10 +++++++++- stripe-core/src/Web/Stripe/Types.hs | 10 ++++++++-- 3 files changed, 22 insertions(+), 4 deletions(-) diff --git a/stripe-core/src/Web/Stripe/Session.hs b/stripe-core/src/Web/Stripe/Session.hs index 80ec25f..b32221a 100644 --- a/stripe-core/src/Web/Stripe/Session.hs +++ b/stripe-core/src/Web/Stripe/Session.hs @@ -19,6 +19,8 @@ module Web.Stripe.Session , SessionId(..) , SuccessUrl(..) , CancelUrl(..) + , ClientReferenceId(..) + , CustomerEmail(..) , Amount (..) , LineItems(..) , LineItem(..) @@ -38,7 +40,7 @@ import Web.Stripe.Util (()) import Web.Stripe.Types (Amount(..), Charge (..), ChargeId (..), Currency(..), EndingBefore(..), Limit(..), MetaData(..), Session (..), - SessionId (..), SuccessUrl(..), CancelUrl(..), LineItems(..), LineItem(..), CustomerId(..), + SessionId (..), SuccessUrl(..), CancelUrl(..), LineItems(..), LineItem(..), CustomerId(..), CustomerEmail(..), ClientReferenceId(..), StartingAfter(..), ExpandParams(..), StripeList (..)) @@ -62,6 +64,8 @@ data CreateSession type instance StripeReturn CreateSession = Session instance StripeHasParam CreateSession LineItems instance StripeHasParam CreateSession CustomerId +instance StripeHasParam CreateSession ClientReferenceId +instance StripeHasParam CreateSession CustomerEmail ------------------------------------------------------------------------------ -- | Retrieve a `Session` by `ChargeId` and `SessionId` diff --git a/stripe-core/src/Web/Stripe/StripeRequest.hs b/stripe-core/src/Web/Stripe/StripeRequest.hs index 562a14a..307b652 100644 --- a/stripe-core/src/Web/Stripe/StripeRequest.hs +++ b/stripe-core/src/Web/Stripe/StripeRequest.hs @@ -48,7 +48,7 @@ import Web.Stripe.Types (AccountBalance(..), AccountNumber(..), Capture(..), ChargeId(..), Closed(..), CouponId(..), Country(..), Created(..), Currency(..), - CustomerId(..), CVC(..), Date(..), + CustomerId(..), CustomerEmail(..), ClientReferenceId(..), CVC(..), Date(..), DefaultCard(..), Description(..), Duration(..), DurationInMonths(..), Email(..), EndingBefore(..), EventId(..), EventType(..), @@ -202,6 +202,14 @@ instance ToStripeParam CustomerId where toStripeParam (CustomerId cid) = (("customer", Text.encodeUtf8 cid) :) +instance ToStripeParam ClientReferenceId where + toStripeParam (ClientReferenceId cid) = + (("client_reference_id", Text.encodeUtf8 cid) :) + +instance ToStripeParam CustomerEmail where + toStripeParam (CustomerEmail cid) = + (("customer_email", Text.encodeUtf8 cid) :) + instance ToStripeParam CouponId where toStripeParam (CouponId cid) = (("coupon", Text.encodeUtf8 cid) :) diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index 6a61b57..11786f9 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -543,6 +543,12 @@ newtype CancelUrl = CancelUrl { getCancelUrl :: Text } newtype LineItems = LineItems { getLineItems :: [LineItem] } deriving (Read, Show, Eq, Ord, Data, Typeable) +newtype ClientReferenceId = ClientReferenceId { getClientReferenceId :: Text } + deriving (Read, Show, Eq, Ord, Data, Typeable, FromJSON) + +newtype CustomerEmail = CustomerEmail { getCustomerEmail :: Text } + deriving (Read, Show, Eq, Ord, Data, Typeable, FromJSON) + data LineItem = LineItem { lineItemAmount :: Amount , lineItemCurrency :: Currency @@ -1846,7 +1852,7 @@ data EventData = ------------------------------------------------------------------------------ -- | `Event` Object data Event = Event { - eventId :: Maybe EventId + eventId :: EventId , eventCreated :: UTCTime , eventLiveMode :: Bool , eventType :: EventType @@ -1860,7 +1866,7 @@ data Event = Event { -- | JSON Instance for `Event` instance FromJSON Event where parseJSON = withObject "Event" $ \o -> do - eventId <- fmap EventId <$> o .:? "id" + eventId <- EventId <$> o .: "id" eventCreated <- fromSeconds <$> o .: "created" eventLiveMode <- o .: "livemode" eventType <- o .: "type" From ab23e8d5a7232d81d818095fad3fd361fbd485dd Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Thu, 3 Oct 2019 19:27:38 +0200 Subject: [PATCH 15/44] some more about sessions --- stripe-core/src/Web/Stripe/Session.hs | 1 + stripe-core/src/Web/Stripe/Types.hs | 18 ++++++++++++------ 2 files changed, 13 insertions(+), 6 deletions(-) diff --git a/stripe-core/src/Web/Stripe/Session.hs b/stripe-core/src/Web/Stripe/Session.hs index b32221a..54cc304 100644 --- a/stripe-core/src/Web/Stripe/Session.hs +++ b/stripe-core/src/Web/Stripe/Session.hs @@ -66,6 +66,7 @@ instance StripeHasParam CreateSession LineItems instance StripeHasParam CreateSession CustomerId instance StripeHasParam CreateSession ClientReferenceId instance StripeHasParam CreateSession CustomerEmail +instance StripeHasParam CreateSession ExpandParams ------------------------------------------------------------------------------ -- | Retrieve a `Session` by `ChargeId` and `SessionId` diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index 11786f9..c81b94c 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -520,7 +520,9 @@ data Session = Session { , sessionSuccessUrl :: SuccessUrl , sessionLivemode :: Bool , sessionPaymentIntent :: Expandable PaymentIntentId - , sessionCustomer :: Expandable CustomerId + , sessionCustomer :: Maybe (Expandable CustomerId) + , sessionClientReferenceId :: Maybe ClientReferenceId + , sessionCustomerEmail :: Maybe CustomerEmail } deriving (Read, Show, Eq, Ord, Data, Typeable) instance FromJSON Session where @@ -530,7 +532,9 @@ instance FromJSON Session where <*> o .: "success_url" <*> o .: "livemode" <*> o .: "payment_intent" - <*> o .: "customer" + <*> o .:? "customer" + <*> o .:? "client_reference_id" + <*> o .:? "customer_email" newtype SessionId = SessionId { getSessionId :: Text } deriving (Read, Show, Eq, Ord, Data, Typeable, FromJSON ) @@ -2081,6 +2085,7 @@ data PaymentIntentStatus | PaymentIntentStatusRequiresAction | PaymentIntentStatusRequiresCapture | PaymentIntentStatusRequiresConfirmation + | PaymentIntentStatusRequiresSource | PaymentIntentStatusRequiresPaymentMethod | PaymentIntentStatusSucceeded deriving (Read, Show, Eq, Ord, Data, Typeable) @@ -2089,10 +2094,11 @@ instance FromJSON PaymentIntentStatus where parseJSON = withText "PaymentIntentStatus" $ \t -> case t of "canceled" -> pure PaymentIntentStatusCanceled "processing" -> pure PaymentIntentStatusProcessing - "requiresAction" -> pure PaymentIntentStatusRequiresAction - "requiresCapture" -> pure PaymentIntentStatusRequiresCapture - "requiresConfirmation" -> pure PaymentIntentStatusRequiresConfirmation - "requiresPaymentMethod" -> pure PaymentIntentStatusRequiresPaymentMethod + "requires_action" -> pure PaymentIntentStatusRequiresAction + "requires_capture" -> pure PaymentIntentStatusRequiresCapture + "requires_confirmation" -> pure PaymentIntentStatusRequiresConfirmation + "requires_payment_method" -> pure PaymentIntentStatusRequiresPaymentMethod + "requires_source" -> pure PaymentIntentStatusRequiresSource "succeeded" -> pure PaymentIntentStatusSucceeded _ -> fail $ "Unknown PaymentIntentStatus: " <> T.unpack t From 7ced8cef1e932d3fb222dfb3c79c25595cdc82ab Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Thu, 2 Jan 2020 04:17:57 +0100 Subject: [PATCH 16/44] a bit more sophisticated sessions --- stripe-core/src/Web/Stripe/Event.hs | 2 +- stripe-core/src/Web/Stripe/Session.hs | 12 +++--- stripe-core/src/Web/Stripe/Types.hs | 55 +++++++++++++++++++++++---- 3 files changed, 55 insertions(+), 14 deletions(-) diff --git a/stripe-core/src/Web/Stripe/Event.hs b/stripe-core/src/Web/Stripe/Event.hs index 33a4cdf..c4f5922 100644 --- a/stripe-core/src/Web/Stripe/Event.hs +++ b/stripe-core/src/Web/Stripe/Event.hs @@ -50,7 +50,7 @@ import Web.Stripe.StripeRequest (Method (GET), import Web.Stripe.Util (()) import Web.Stripe.Types (Created(..), Event (..), EventId (..), Limit, - EventData(..), ExpandParams(..), + EventData(..), EventType(..), StripeList (..), Limit(..), StartingAfter(..), EndingBefore(..)) diff --git a/stripe-core/src/Web/Stripe/Session.hs b/stripe-core/src/Web/Stripe/Session.hs index 54cc304..316f8e8 100644 --- a/stripe-core/src/Web/Stripe/Session.hs +++ b/stripe-core/src/Web/Stripe/Session.hs @@ -16,7 +16,6 @@ module Web.Stripe.Session , GetSession , getSession -- * Types - , SessionId(..) , SuccessUrl(..) , CancelUrl(..) , ClientReferenceId(..) @@ -30,6 +29,7 @@ module Web.Stripe.Session , ExpandParams (..) , Session (..) , SessionId (..) + , SessionData (..) , StripeList (..) ) where @@ -37,11 +37,11 @@ import Web.Stripe.StripeRequest (Method (GET, POST), StripeHasParam, StripeReturn, StripeRequest (..), toStripeParam, mkStripeRequest) import Web.Stripe.Util (()) -import Web.Stripe.Types (Amount(..), Charge (..), ChargeId (..), Currency(..), - EndingBefore(..), Limit(..), - MetaData(..), Session (..), - SessionId (..), SuccessUrl(..), CancelUrl(..), LineItems(..), LineItem(..), CustomerId(..), CustomerEmail(..), ClientReferenceId(..), - StartingAfter(..), ExpandParams(..), +import Web.Stripe.Types (Amount(..), Charge (..), ChargeId (..), + EndingBefore(..), + Session (..), + SessionId (..), SuccessUrl(..), CancelUrl(..), LineItems(..), LineItem(..), CustomerId(..), CustomerEmail(..), ClientReferenceId(..), SessionData(..), + ExpandParams(..), StripeList (..)) ------------------------------------------------------------------------------ diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index c81b94c..20324ff 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -58,11 +58,12 @@ type instance ExpandsTo ChargeId = Charge type instance ExpandsTo CustomerId = Customer type instance ExpandsTo InvoiceId = Invoice type instance ExpandsTo InvoiceItemId = InvoiceItem +type instance ExpandsTo PaymentIntentId = PaymentIntent type instance ExpandsTo PaymentMethodId = PaymentMethod -type instance ExpandsTo RecipientId = Recipient type instance ExpandsTo RecipientCardId = RecipientCard +type instance ExpandsTo RecipientId = Recipient +type instance ExpandsTo SubscriptionId = Subscription type instance ExpandsTo TransactionId = BalanceTransaction -type instance ExpandsTo PaymentIntentId = PaymentIntent ------------------------------------------------------------------------------ -- | JSON Instance for `Expandable` @@ -519,22 +520,62 @@ data Session = Session { , sessionCancelUrl :: CancelUrl , sessionSuccessUrl :: SuccessUrl , sessionLivemode :: Bool - , sessionPaymentIntent :: Expandable PaymentIntentId - , sessionCustomer :: Maybe (Expandable CustomerId) , sessionClientReferenceId :: Maybe ClientReferenceId , sessionCustomerEmail :: Maybe CustomerEmail + , sessionBillingAddressCollection :: Maybe TODO + , sessionDisplayItems :: Maybe [TODO] + , sessionLocale :: Maybe TODO + , sessionPaymentMethodTypes :: Maybe [Text] + , sessionSubmitType :: Maybe TODO + , sessionData :: SessionData } deriving (Read, Show, Eq, Ord, Data, Typeable) +data SessionMode + = SessionModePayment + | SessionModeSetup + | SessionModeSubscription + | UnknownSessionMode Text + deriving (Show, Read, Eq, Ord, Data, Typeable) + +parseSessionMode :: Text -> SessionMode +parseSessionMode t = + case t of + "payment" -> SessionModePayment + "setup" -> SessionModeSetup + "subscription" -> SessionModeSubscription + _ -> UnknownSessionMode t + +instance FromJSON SessionMode where + parseJSON = withText "SessionMode" $ pure . parseSessionMode + +data SessionData + = SessionPayment (Expandable CustomerId) (Expandable PaymentIntentId) + | SessionSetup TODO + | SessionSubscription (Expandable CustomerId) (Expandable SubscriptionId) + | UnknownSession Text + deriving (Show, Read, Eq, Ord, Data, Typeable) + + instance FromJSON Session where - parseJSON = withObject "Session" $ \o -> + parseJSON = withObject "Session" $ \o -> do + mode <- o .: "mode" + sessionData <- case mode of + SessionModePayment -> SessionPayment <$> o .: "customer" <*> o .: "payment_intent" + SessionModeSetup -> pure $ SessionSetup TODO + SessionModeSubscription -> SessionSubscription <$> o .: "customer" <*> o .: "subscription" + UnknownSessionMode t -> pure $ UnknownSession t Session <$> (SessionId <$> o .: "id") <*> o .: "cancel_url" <*> o .: "success_url" <*> o .: "livemode" - <*> o .: "payment_intent" - <*> o .:? "customer" <*> o .:? "client_reference_id" <*> o .:? "customer_email" + <*> o .:? "billing_address_collection" + <*> o .:? "display_items" + <*> o .:? "locale" + <*> o .:? "payment_method_types" + <*> o .:? "submit_type" + <*> pure sessionData newtype SessionId = SessionId { getSessionId :: Text } deriving (Read, Show, Eq, Ord, Data, Typeable, FromJSON ) From 80b4911b763abc38a876f51f119beb2d3ce7c2c4 Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Fri, 19 Jun 2020 15:51:32 +0200 Subject: [PATCH 17/44] more on payment intents --- stripe-core/src/Web/Stripe/PaymentIntent.hs | 11 ++++++-- stripe-core/src/Web/Stripe/StripeRequest.hs | 11 +++++++- stripe-core/src/Web/Stripe/Types.hs | 31 +++++++++++++++++++++ 3 files changed, 49 insertions(+), 4 deletions(-) diff --git a/stripe-core/src/Web/Stripe/PaymentIntent.hs b/stripe-core/src/Web/Stripe/PaymentIntent.hs index 3cf6645..358593d 100644 --- a/stripe-core/src/Web/Stripe/PaymentIntent.hs +++ b/stripe-core/src/Web/Stripe/PaymentIntent.hs @@ -33,6 +33,8 @@ module Web.Stripe.PaymentIntent , ExpandParams (..) , PaymentIntent (..) , PaymentIntentId (..) + , PaymentMethodTypes (..) + , PaymentMethodType (..) , StripeList (..) ) where @@ -40,10 +42,10 @@ import Web.Stripe.StripeRequest (Method (GET, POST), StripeHasParam, StripeReturn, StripeRequest (..), toStripeParam, mkStripeRequest) import Web.Stripe.Util (()) -import Web.Stripe.Types (Amount(..), Charge (..), ChargeId (..), Currency(..), +import Web.Stripe.Types (Amount(..), Charge (..), ChargeId (..), Currency(..), CustomerId(..), EndingBefore(..), Limit(..), - MetaData(..), PaymentIntent (..), - PaymentIntentId (..), + MetaData(..), PaymentIntent (..), PaymentMethodTypes(..), PaymentMethodType(..), + PaymentIntentId (..), ReceiptEmail(..), StartingAfter(..), ExpandParams(..), StripeList (..)) @@ -64,6 +66,9 @@ createPaymentIntent data CreatePaymentIntent type instance StripeReturn CreatePaymentIntent = PaymentIntent +instance StripeHasParam CreatePaymentIntent CustomerId +instance StripeHasParam CreatePaymentIntent ReceiptEmail +instance StripeHasParam CreatePaymentIntent PaymentMethodTypes ------------------------------------------------------------------------------ -- | Retrieve a `PaymentIntent` by `ChargeId` and `PaymentIntentId` diff --git a/stripe-core/src/Web/Stripe/StripeRequest.hs b/stripe-core/src/Web/Stripe/StripeRequest.hs index 307b652..361616f 100644 --- a/stripe-core/src/Web/Stripe/StripeRequest.hs +++ b/stripe-core/src/Web/Stripe/StripeRequest.hs @@ -58,7 +58,7 @@ import Web.Stripe.Types (AccountBalance(..), AccountNumber(..), IntervalCount(..), InvoiceId(..), InvoiceItemId(..), InvoiceLineItemId(..), - IsVerified(..), MetaData(..), PaymentIntentId(..), PlanId(..), + IsVerified(..), MetaData(..), PaymentIntentId(..), PaymentMethodTypes(..), PaymentMethodType(..), PlanId(..), PlanName(..), Prorate(..), Limit(..), MaxRedemptions(..), Name(..), NewBankAccount(..), NewCard(..), @@ -455,6 +455,14 @@ instance ToStripeParam LineItems where toStripeParam (LineItems is) = encodeListStripeParam "line_items" is +instance ToStripeParam PaymentMethodTypes where + toStripeParam (PaymentMethodTypes pmts) = + let t pmt = case pmt of + PaymentMethodTypeCard -> "card" + PaymentMethodTypeCardPresent -> "card_present" + PaymentMethodTypeSepaDebit -> "sepa_debit" + in ((map (\pmt-> ("payment_method_types[]", t pmt)) pmts) ++) + encodeListStripeParam :: ToStripeParam a => Text -> [a] -> ([(ByteString, ByteString)] -> [(ByteString, ByteString)]) encodeListStripeParam name items = ((encodeList name items $ (\a -> toStripeParam a [])) ++) @@ -468,6 +476,7 @@ instance ToStripeParam LineItem where , ("description", lineItemDescription) ]) ++) + instance ToStripeParam MetaData where toStripeParam (MetaData kvs) = (toMetaData kvs ++) diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index 20324ff..9cccbd7 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -1736,6 +1736,12 @@ data EventType = | InvoiceItemCreatedEvent | InvoiceItemUpdatedEvent | InvoiceItemDeletedEvent + | PaymentIntentAmountCapturableUpdated + | PaymentIntentCanceled + | PaymentIntentCreated + | PaymentIntentPaymentFailed + | PaymentIntentProcessing + | PaymentIntentSucceeded | PlanCreatedEvent | PlanUpdatedEvent | PlanDeletedEvent @@ -1793,6 +1799,12 @@ instance FromJSON EventType where "invoiceitem.created" -> pure InvoiceItemCreatedEvent "invoiceitem.updated" -> pure InvoiceItemUpdatedEvent "invoiceitem.deleted" -> pure InvoiceItemDeletedEvent + "payment_intent.amount_capturable_updated" -> pure PaymentIntentAmountCapturableUpdated + "payment_intent.canceled" -> pure PaymentIntentCanceled + "payment_intent.created" -> pure PaymentIntentCreated + "payment_intent.payment_failed" -> pure PaymentIntentPaymentFailed + "payment_intent.processing" -> pure PaymentIntentProcessing + "payment_intent.succeeded" -> pure PaymentIntentSucceeded "plan.created" -> pure PlanCreatedEvent "plan.updated" -> pure PlanUpdatedEvent "plan.deleted" -> pure PlanDeletedEvent @@ -1849,6 +1861,12 @@ eventTypeText et = case et of InvoiceItemCreatedEvent -> "invoiceitem.created" InvoiceItemUpdatedEvent -> "invoiceitem.updated" InvoiceItemDeletedEvent -> "invoiceitem.deleted" + PaymentIntentAmountCapturableUpdated -> "payment_intent.amount_capturable_updated" + PaymentIntentCanceled -> "payment_intent.canceled" + PaymentIntentCreated -> "payment_intent.created" + PaymentIntentPaymentFailed -> "payment_intent.payment_failed" + PaymentIntentProcessing -> "payment_intent.processing" + PaymentIntentSucceeded -> "payment_intent.succeeded" PlanCreatedEvent -> "plan.created" PlanUpdatedEvent -> "plan.updated" PlanDeletedEvent -> "plan.deleted" @@ -1889,6 +1907,7 @@ data EventData = | SubscriptionEvent Subscription | DiscountEvent Discount | InvoiceItemEvent InvoiceItem + | PaymentIntentEvent PaymentIntent | CheckoutEvent Session | UnknownEventData Value | Ping @@ -1955,6 +1974,12 @@ instance FromJSON Event where "invoiceitem.created" -> InvoiceItemEvent <$> obj .: "object" "invoiceitem.updated" -> InvoiceItemEvent <$> obj .: "object" "invoiceitem.deleted" -> InvoiceItemEvent <$> obj .: "object" + "payment_intent.amount_capturable_updated" -> PaymentIntentEvent <$> obj .: "object" + "payment_intent.canceled" -> PaymentIntentEvent <$> obj .: "object" + "payment_intent.created" -> PaymentIntentEvent <$> obj .: "object" + "payment_intent.payment_failed" -> PaymentIntentEvent <$> obj .: "object" + "payment_intent.processing" -> PaymentIntentEvent <$> obj .: "object" + "payment_intent.succeeded" -> PaymentIntentEvent <$> obj .: "object" "plan.created" -> PlanEvent <$> obj .: "object" "plan.updated" -> PlanEvent <$> obj .: "object" "plan.deleted" -> PlanEvent <$> obj .: "object" @@ -2161,12 +2186,14 @@ data PaymentMethod = PaymentMethod { data PaymentMethodType = PaymentMethodTypeCard | PaymentMethodTypeCardPresent + | PaymentMethodTypeSepaDebit deriving (Read, Show, Eq, Ord, Data, Typeable) instance FromJSON PaymentMethodType where parseJSON = withText "PaymentMethodType" $ \t -> case t of "PaymentMethodTypeCard" -> pure PaymentMethodTypeCard "PaymentMethodTypeCardPresent" -> pure PaymentMethodTypeCardPresent + "PaymentMethodTypeSepaDebit" -> pure PaymentMethodTypeSepaDebit _ -> fail $ "Unknown PaymentMethodType: " <> T.unpack t @@ -2355,6 +2382,10 @@ newtype Email = Email Text deriving (Read, Show, Eq, Ord, Data, Typeable) -- | `Email` to send receipt to newtype ReceiptEmail = ReceiptEmail Text deriving (Read, Show, Eq, Ord, Data, Typeable) +------------------------------------------------------------------------------ +-- | `Email` to send receipt to +newtype PaymentMethodTypes = PaymentMethodTypes [PaymentMethodType] deriving (Read, Show, Eq, Ord, Data, Typeable) + ------------------------------------------------------------------------------ -- | Stripe supports 138 currencies data Currency = From 65fb8b62d4eb2899885de6e28fc5d712eecaf9b2 Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Thu, 16 Jul 2020 03:21:04 +0200 Subject: [PATCH 18/44] more payment methods for sessions --- stripe-core/src/Web/Stripe/Session.hs | 10 +++++++--- stripe-core/src/Web/Stripe/StripeRequest.hs | 7 +++++++ stripe-core/src/Web/Stripe/Types.hs | 17 +++++++++++++++-- 3 files changed, 29 insertions(+), 5 deletions(-) diff --git a/stripe-core/src/Web/Stripe/Session.hs b/stripe-core/src/Web/Stripe/Session.hs index 316f8e8..7310f37 100644 --- a/stripe-core/src/Web/Stripe/Session.hs +++ b/stripe-core/src/Web/Stripe/Session.hs @@ -31,6 +31,7 @@ module Web.Stripe.Session , SessionId (..) , SessionData (..) , StripeList (..) + , PaymentMethodTypes(..) ) where import Web.Stripe.StripeRequest (Method (GET, POST), @@ -40,7 +41,7 @@ import Web.Stripe.Util (()) import Web.Stripe.Types (Amount(..), Charge (..), ChargeId (..), EndingBefore(..), Session (..), - SessionId (..), SuccessUrl(..), CancelUrl(..), LineItems(..), LineItem(..), CustomerId(..), CustomerEmail(..), ClientReferenceId(..), SessionData(..), + SessionId (..), SuccessUrl(..), CancelUrl(..), LineItems(..), LineItem(..), CustomerId(..), CustomerEmail(..), ClientReferenceId(..), SessionData(..), PaymentMethodTypes(..), ExpandParams(..), StripeList (..)) @@ -49,15 +50,17 @@ import Web.Stripe.Types (Amount(..), Charge (..), ChargeId ( createSession :: SuccessUrl -- ^ Success url -> CancelUrl -- ^ Cancel url + -> PaymentMethodTypes -> StripeRequest CreateSession createSession successUrl - cancelUrl = request + cancelUrl + paymentMethodTypes = request where request = mkStripeRequest POST url params url = "checkout" "sessions" params = toStripeParam successUrl $ toStripeParam cancelUrl $ - (("payment_method_types[]", "card") :) $ + toStripeParam paymentMethodTypes $ [] data CreateSession @@ -66,6 +69,7 @@ instance StripeHasParam CreateSession LineItems instance StripeHasParam CreateSession CustomerId instance StripeHasParam CreateSession ClientReferenceId instance StripeHasParam CreateSession CustomerEmail +instance StripeHasParam CreateSession PaymentMethodTypes instance StripeHasParam CreateSession ExpandParams ------------------------------------------------------------------------------ diff --git a/stripe-core/src/Web/Stripe/StripeRequest.hs b/stripe-core/src/Web/Stripe/StripeRequest.hs index 361616f..930576d 100644 --- a/stripe-core/src/Web/Stripe/StripeRequest.hs +++ b/stripe-core/src/Web/Stripe/StripeRequest.hs @@ -460,6 +460,13 @@ instance ToStripeParam PaymentMethodTypes where let t pmt = case pmt of PaymentMethodTypeCard -> "card" PaymentMethodTypeCardPresent -> "card_present" + PaymentMethodTypeIdeal -> "ideal" + PaymentMethodTypeFPX -> "fpx" + PaymentMethodTypeBacsDebit -> "bacs_debit" + PaymentMethodTypeBancontact -> "bancontact" + PaymentMethodTypeGiropay -> "giropay" + PaymentMethodTypeP24 -> "p24" + PaymentMethodTypeEPS -> "eps" PaymentMethodTypeSepaDebit -> "sepa_debit" in ((map (\pmt-> ("payment_method_types[]", t pmt)) pmts) ++) diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index 9cccbd7..915dd5c 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -549,7 +549,7 @@ instance FromJSON SessionMode where parseJSON = withText "SessionMode" $ pure . parseSessionMode data SessionData - = SessionPayment (Expandable CustomerId) (Expandable PaymentIntentId) + = SessionPayment (Maybe (Expandable CustomerId)) (Expandable PaymentIntentId) | SessionSetup TODO | SessionSubscription (Expandable CustomerId) (Expandable SubscriptionId) | UnknownSession Text @@ -560,7 +560,7 @@ instance FromJSON Session where parseJSON = withObject "Session" $ \o -> do mode <- o .: "mode" sessionData <- case mode of - SessionModePayment -> SessionPayment <$> o .: "customer" <*> o .: "payment_intent" + SessionModePayment -> SessionPayment <$> o .:? "customer" <*> o .: "payment_intent" SessionModeSetup -> pure $ SessionSetup TODO SessionModeSubscription -> SessionSubscription <$> o .: "customer" <*> o .: "subscription" UnknownSessionMode t -> pure $ UnknownSession t @@ -2186,6 +2186,13 @@ data PaymentMethod = PaymentMethod { data PaymentMethodType = PaymentMethodTypeCard | PaymentMethodTypeCardPresent + | PaymentMethodTypeIdeal + | PaymentMethodTypeFPX + | PaymentMethodTypeBacsDebit + | PaymentMethodTypeBancontact + | PaymentMethodTypeGiropay + | PaymentMethodTypeP24 + | PaymentMethodTypeEPS | PaymentMethodTypeSepaDebit deriving (Read, Show, Eq, Ord, Data, Typeable) @@ -2193,6 +2200,12 @@ instance FromJSON PaymentMethodType where parseJSON = withText "PaymentMethodType" $ \t -> case t of "PaymentMethodTypeCard" -> pure PaymentMethodTypeCard "PaymentMethodTypeCardPresent" -> pure PaymentMethodTypeCardPresent + "PaymentMethodTypeIdeal" -> pure PaymentMethodTypeIdeal + "PaymentMethodTypeFPX" -> pure PaymentMethodTypeFPX + "PaymentMethodTypeBacsDebit" -> pure PaymentMethodTypeBacsDebit + "PaymentMethodTypeBancontact" -> pure PaymentMethodTypeBancontact + "PaymentMethodTypeGiropay" -> pure PaymentMethodTypeGiropay + "PaymentMethodTypeP24" -> pure PaymentMethodTypeP24 "PaymentMethodTypeSepaDebit" -> pure PaymentMethodTypeSepaDebit _ -> fail $ "Unknown PaymentMethodType: " <> T.unpack t From f12a74ffde4de40e079179878c413bee14303792 Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Mon, 21 Dec 2020 12:29:43 -0500 Subject: [PATCH 19/44] Fix missing imports (lost in merge) --- stripe-core/src/Web/Stripe/Types.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index 32789d1..8b452e3 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -6,6 +6,7 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} ------------------------------------------------------------------------------ -- | @@ -26,12 +27,15 @@ import Data.Aeson , Value(Bool, Object, String) , (.:) , (.:?) + , withObject + , withText ) import Data.Aeson.Types (typeMismatch) import Data.Data (Data, Typeable) import qualified Data.HashMap.Strict as H import Data.Ratio ((%)) import Data.Text (Text) +import qualified Data.Text as T import Data.Time (UTCTime) import Numeric (fromRat, showFFloat) import Text.Read (lexP, pfail) From d5d0fd625f4e843f81c8a2f240502cf0abcbb10f Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Mon, 21 Dec 2020 13:45:44 -0500 Subject: [PATCH 20/44] 'cards' fields now called 'sources' --- stripe-core/src/Web/Stripe/Types.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index 8b452e3..5cea5e7 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -281,9 +281,9 @@ instance FromJSON Customer where <*> o .:? "subscriptions" <*> o .:? "discount" <*> o .: "account_balance" - <*> o .: "cards" + <*> o .: "sources" <*> o .:? "currency" - <*> o .:? "default_card" + <*> o .:? "default_source" <*> o .: "metadata") ------------------------------------------------------------------------------ @@ -1431,8 +1431,8 @@ instance FromJSON Recipient where <*> o .: "name" <*> o .: "verified" <*> o .:? "active_account" - <*> o .: "cards" - <*> o .:? "default_card" + <*> o .: "sources" + <*> o .:? "default_source" ) <|> DeletedRecipient <$> o .:? "deleted" From 4b94850ffce966087f8615ed9fba3afde0bf1c66 Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Mon, 21 Dec 2020 13:46:01 -0500 Subject: [PATCH 21/44] Remove application fee metadata field --- stripe-core/src/Web/Stripe/Types.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index 5cea5e7..ca9ef85 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -1458,7 +1458,6 @@ data ApplicationFee = ApplicationFee { , applicationFeeAccountId :: Expandable AccountId , applicationFeeApplicationId :: ApplicationId , applicationFeeChargeId :: Expandable ChargeId - , applicationFeeMetaData :: MetaData } deriving (Read, Show, Eq, Ord, Data, Typeable) ------------------------------------------------------------------------------ @@ -1494,7 +1493,6 @@ instance FromJSON ApplicationFee where <*> o .: "account" <*> (ApplicationId <$> o .: "application") <*> o .: "charge" - <*> o .: "metadata" ------------------------------------------------------------------------------ -- | `FeeId` for objects with Fees From 1db862ff541968bea61a52de4ccbb3f81d538a29 Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Mon, 21 Dec 2020 19:46:36 -0500 Subject: [PATCH 22/44] Add PaymentIntent PaymentMethodId params --- stripe-core/src/Web/Stripe/PaymentIntent.hs | 12 ++- stripe-core/src/Web/Stripe/StripeRequest.hs | 6 +- stripe-tests/stripe-tests.cabal | 1 + .../tests/Web/Stripe/Test/AllTests.hs | 2 + .../tests/Web/Stripe/Test/PaymentIntent.hs | 92 +++++++++++++++++++ 5 files changed, 109 insertions(+), 4 deletions(-) create mode 100644 stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs diff --git a/stripe-core/src/Web/Stripe/PaymentIntent.hs b/stripe-core/src/Web/Stripe/PaymentIntent.hs index 358593d..18a062f 100644 --- a/stripe-core/src/Web/Stripe/PaymentIntent.hs +++ b/stripe-core/src/Web/Stripe/PaymentIntent.hs @@ -27,27 +27,31 @@ module Web.Stripe.PaymentIntent , getPaymentIntents -- * Types , Amount (..) + , CardId (..) , Charge (..) , ChargeId (..) + , Currency (..) , EndingBefore (..) , ExpandParams (..) , PaymentIntent (..) , PaymentIntentId (..) + , PaymentMethodId (..) , PaymentMethodTypes (..) , PaymentMethodType (..) , StripeList (..) + , Token (..) ) where import Web.Stripe.StripeRequest (Method (GET, POST), StripeHasParam, StripeReturn, StripeRequest (..), toStripeParam, mkStripeRequest) import Web.Stripe.Util (()) -import Web.Stripe.Types (Amount(..), Charge (..), ChargeId (..), Currency(..), CustomerId(..), +import Web.Stripe.Types (Amount(..), Charge (..), CardId (..), ChargeId (..), Currency(..), CustomerId(..), EndingBefore(..), Limit(..), - MetaData(..), PaymentIntent (..), PaymentMethodTypes(..), PaymentMethodType(..), + MetaData(..), PaymentIntent (..), PaymentMethodId (..), PaymentMethodTypes(..), PaymentMethodType(..), PaymentIntentId (..), ReceiptEmail(..), StartingAfter(..), ExpandParams(..), - StripeList (..)) + StripeList (..), Token (..)) ------------------------------------------------------------------------------ -- | create a `PaymentIntent` @@ -100,6 +104,7 @@ updatePaymentIntent data UpdatePaymentIntent type instance StripeReturn UpdatePaymentIntent = PaymentIntent instance StripeHasParam UpdatePaymentIntent MetaData +instance StripeHasParam UpdatePaymentIntent PaymentMethodId confirmPaymentIntent :: PaymentIntentId @@ -114,6 +119,7 @@ confirmPaymentIntent data ConfirmPaymentIntent type instance StripeReturn ConfirmPaymentIntent = PaymentIntent instance StripeHasParam ConfirmPaymentIntent MetaData +instance StripeHasParam ConfirmPaymentIntent PaymentMethodId capturePaymentIntent :: PaymentIntentId diff --git a/stripe-core/src/Web/Stripe/StripeRequest.hs b/stripe-core/src/Web/Stripe/StripeRequest.hs index 930576d..121cc6b 100644 --- a/stripe-core/src/Web/Stripe/StripeRequest.hs +++ b/stripe-core/src/Web/Stripe/StripeRequest.hs @@ -58,7 +58,7 @@ import Web.Stripe.Types (AccountBalance(..), AccountNumber(..), IntervalCount(..), InvoiceId(..), InvoiceItemId(..), InvoiceLineItemId(..), - IsVerified(..), MetaData(..), PaymentIntentId(..), PaymentMethodTypes(..), PaymentMethodType(..), PlanId(..), + IsVerified(..), MetaData(..), PaymentIntentId(..), PaymentMethodId(..), PaymentMethodTypes(..), PaymentMethodType(..), PlanId(..), PlanName(..), Prorate(..), Limit(..), MaxRedemptions(..), Name(..), NewBankAccount(..), NewCard(..), @@ -455,6 +455,10 @@ instance ToStripeParam LineItems where toStripeParam (LineItems is) = encodeListStripeParam "line_items" is +instance ToStripeParam PaymentMethodId where + toStripeParam (PaymentMethodId pid) = + (("payment_method", Text.encodeUtf8 pid) :) + instance ToStripeParam PaymentMethodTypes where toStripeParam (PaymentMethodTypes pmts) = let t pmt = case pmt of diff --git a/stripe-tests/stripe-tests.cabal b/stripe-tests/stripe-tests.cabal index 35d64dc..9f9d8d9 100644 --- a/stripe-tests/stripe-tests.cabal +++ b/stripe-tests/stripe-tests.cabal @@ -52,6 +52,7 @@ library Web.Stripe.Test.Event Web.Stripe.Test.Invoice Web.Stripe.Test.InvoiceItem + Web.Stripe.Test.PaymentIntent Web.Stripe.Test.Plan Web.Stripe.Test.Prelude Web.Stripe.Test.Recipient diff --git a/stripe-tests/tests/Web/Stripe/Test/AllTests.hs b/stripe-tests/tests/Web/Stripe/Test/AllTests.hs index 8f5bced..9facbd7 100644 --- a/stripe-tests/tests/Web/Stripe/Test/AllTests.hs +++ b/stripe-tests/tests/Web/Stripe/Test/AllTests.hs @@ -18,6 +18,7 @@ import Web.Stripe.Test.Discount (discountTests) import Web.Stripe.Test.Dispute (disputeTests) import Web.Stripe.Test.Invoice (invoiceTests) import Web.Stripe.Test.InvoiceItem (invoiceItemTests) +import Web.Stripe.Test.PaymentIntent (paymentIntentTests) import Web.Stripe.Test.Plan (planTests) import Web.Stripe.Test.Recipient (recipientTests) import Web.Stripe.Test.Refund (refundTests) @@ -54,5 +55,6 @@ allTests stripe' = do balanceTests stripe tokenTests stripe eventTests stripe + paymentIntentTests stripe diff --git a/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs b/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs new file mode 100644 index 0000000..8d37cf6 --- /dev/null +++ b/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RebindableSyntax #-} +{-# LANGUAGE RankNTypes #-} +module Web.Stripe.Test.PaymentIntent where + +import Data.Either (Either(..), isRight) +import Test.Hspec +import Web.Stripe.Test.Util (makePlanId) +import Web.Stripe.Test.Prelude + +import Web.Stripe.PaymentIntent +import Web.Stripe.Card +import Web.Stripe.Customer +import Web.Stripe.Token + +paymentIntentTests :: StripeSpec +paymentIntentTests stripe = do + describe "Payment intent tests" $ do + it "Succesfully creates a PaymentIntent" $ do + result <- stripe $ do + paymentIntent <- createPaymentIntent (Amount 100) USD + void $ cancelPaymentIntent (paymentIntentId paymentIntent) + return paymentIntent + result `shouldSatisfy` isRight + it "Successfully updates a PaymentIntent" $ do + result <- stripe $ do + paymentIntent <- createPaymentIntent (Amount 100) USD + updatedPaymentIntent <- updatePaymentIntent (paymentIntentId paymentIntent) + void $ cancelPaymentIntent (paymentIntentId paymentIntent) + return updatedPaymentIntent + result `shouldSatisfy` isRight + it "Successfully cancels a PaymentIntent" $ do + result <- stripe $ do + paymentIntent <- createPaymentIntent (Amount 100) USD + cancelledPaymentIntent <- cancelPaymentIntent (paymentIntentId paymentIntent) + return cancelledPaymentIntent + result `shouldSatisfy` isRight + it "Successfully gets a PaymentIntent"$ do + result <- stripe $ do + paymentIntent <- createPaymentIntent (Amount 100) USD + paymentIntent' <- getPaymentIntent (paymentIntentId paymentIntent) + void $ cancelPaymentIntent (paymentIntentId paymentIntent) + return paymentIntent' + result `shouldSatisfy` isRight + it "Successfully confirms a PaymentIntent"$ do + result <- stripe $ do + Customer { customerId = cid } <- createCustomer + paymentIntent <- createPaymentIntent (Amount 100) USD -&- cid + Token { tokenId = tkid } <- createCardToken (Just cardinfo) + Card { cardId = CardId cardid } <- createCustomerCardByToken cid tkid + confirmedPaymentIntent <- + confirmPaymentIntent (paymentIntentId paymentIntent) -&- (PaymentMethodId cardid) + void $ deleteCustomer cid + return confirmedPaymentIntent + result `shouldSatisfy` isRight + {- need to do a separate authorization and capture to test this + https://stripe.com/docs/payments/capture-later + it "Successfully captures a PaymentIntent"$ do + result <- stripe $ do + Customer { customerId = cid } <- createCustomer + paymentIntent <- createPaymentIntent (Amount 100) USD -&- cid + Token { tokenId = tkid } <- createCardToken (Just cardinfo) + Card { cardId = CardId cardid } <- createCustomerCardByToken cid tkid + capturedPaymentIntent <- capturePaymentIntent (paymentIntentId paymentIntent) + void $ deleteCustomer cid + return capturedPaymentIntent + result `shouldSatisfy` isRight -} + it "Successfully gets all PaymentIntents"$ do + result <- stripe $ do + paymentIntents <- getPaymentIntents + return paymentIntents + result `shouldSatisfy` isRight + + where + cardinfo = (mkNewCard credit em ey) { newCardCVC = Just cvc } + debitinfo = (mkNewCard debit em ey) { newCardCVC = Just cvc } + credit = CardNumber "4242424242424242" + debit = CardNumber "4000056655665556" + em = ExpMonth 12 + ey = ExpYear 2020 + cvc = CVC "123" + country = Country "US" + routingnumber = RoutingNumber "110000000" + accountnumber = AccountNumber "000123456789" + name = Name "David Johnson" + cardname = Name "cardName" + cardcity = AddressCity "Chicago" + cardcountry = AddressCountry "US" + cardaddressOne = AddressLine1 "123 Fake Street" + cardaddressTwo = AddressLine2 "456 Fake Street" + cardaddressState = AddressState "IL" + cardzip = AddressZip "60610" \ No newline at end of file From f599dff24c186cd91407249c0f58eb561d604ccc Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Mon, 21 Dec 2020 19:46:36 -0500 Subject: [PATCH 23/44] Add PaymentIntent PaymentMethodId params --- stripe-core/src/Web/Stripe/PaymentIntent.hs | 12 ++- stripe-core/src/Web/Stripe/StripeRequest.hs | 6 +- stripe-tests/stripe-tests.cabal | 1 + .../tests/Web/Stripe/Test/AllTests.hs | 2 + .../tests/Web/Stripe/Test/PaymentIntent.hs | 79 +++++++++++++++++++ 5 files changed, 96 insertions(+), 4 deletions(-) create mode 100644 stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs diff --git a/stripe-core/src/Web/Stripe/PaymentIntent.hs b/stripe-core/src/Web/Stripe/PaymentIntent.hs index 358593d..18a062f 100644 --- a/stripe-core/src/Web/Stripe/PaymentIntent.hs +++ b/stripe-core/src/Web/Stripe/PaymentIntent.hs @@ -27,27 +27,31 @@ module Web.Stripe.PaymentIntent , getPaymentIntents -- * Types , Amount (..) + , CardId (..) , Charge (..) , ChargeId (..) + , Currency (..) , EndingBefore (..) , ExpandParams (..) , PaymentIntent (..) , PaymentIntentId (..) + , PaymentMethodId (..) , PaymentMethodTypes (..) , PaymentMethodType (..) , StripeList (..) + , Token (..) ) where import Web.Stripe.StripeRequest (Method (GET, POST), StripeHasParam, StripeReturn, StripeRequest (..), toStripeParam, mkStripeRequest) import Web.Stripe.Util (()) -import Web.Stripe.Types (Amount(..), Charge (..), ChargeId (..), Currency(..), CustomerId(..), +import Web.Stripe.Types (Amount(..), Charge (..), CardId (..), ChargeId (..), Currency(..), CustomerId(..), EndingBefore(..), Limit(..), - MetaData(..), PaymentIntent (..), PaymentMethodTypes(..), PaymentMethodType(..), + MetaData(..), PaymentIntent (..), PaymentMethodId (..), PaymentMethodTypes(..), PaymentMethodType(..), PaymentIntentId (..), ReceiptEmail(..), StartingAfter(..), ExpandParams(..), - StripeList (..)) + StripeList (..), Token (..)) ------------------------------------------------------------------------------ -- | create a `PaymentIntent` @@ -100,6 +104,7 @@ updatePaymentIntent data UpdatePaymentIntent type instance StripeReturn UpdatePaymentIntent = PaymentIntent instance StripeHasParam UpdatePaymentIntent MetaData +instance StripeHasParam UpdatePaymentIntent PaymentMethodId confirmPaymentIntent :: PaymentIntentId @@ -114,6 +119,7 @@ confirmPaymentIntent data ConfirmPaymentIntent type instance StripeReturn ConfirmPaymentIntent = PaymentIntent instance StripeHasParam ConfirmPaymentIntent MetaData +instance StripeHasParam ConfirmPaymentIntent PaymentMethodId capturePaymentIntent :: PaymentIntentId diff --git a/stripe-core/src/Web/Stripe/StripeRequest.hs b/stripe-core/src/Web/Stripe/StripeRequest.hs index 930576d..121cc6b 100644 --- a/stripe-core/src/Web/Stripe/StripeRequest.hs +++ b/stripe-core/src/Web/Stripe/StripeRequest.hs @@ -58,7 +58,7 @@ import Web.Stripe.Types (AccountBalance(..), AccountNumber(..), IntervalCount(..), InvoiceId(..), InvoiceItemId(..), InvoiceLineItemId(..), - IsVerified(..), MetaData(..), PaymentIntentId(..), PaymentMethodTypes(..), PaymentMethodType(..), PlanId(..), + IsVerified(..), MetaData(..), PaymentIntentId(..), PaymentMethodId(..), PaymentMethodTypes(..), PaymentMethodType(..), PlanId(..), PlanName(..), Prorate(..), Limit(..), MaxRedemptions(..), Name(..), NewBankAccount(..), NewCard(..), @@ -455,6 +455,10 @@ instance ToStripeParam LineItems where toStripeParam (LineItems is) = encodeListStripeParam "line_items" is +instance ToStripeParam PaymentMethodId where + toStripeParam (PaymentMethodId pid) = + (("payment_method", Text.encodeUtf8 pid) :) + instance ToStripeParam PaymentMethodTypes where toStripeParam (PaymentMethodTypes pmts) = let t pmt = case pmt of diff --git a/stripe-tests/stripe-tests.cabal b/stripe-tests/stripe-tests.cabal index 35d64dc..9f9d8d9 100644 --- a/stripe-tests/stripe-tests.cabal +++ b/stripe-tests/stripe-tests.cabal @@ -52,6 +52,7 @@ library Web.Stripe.Test.Event Web.Stripe.Test.Invoice Web.Stripe.Test.InvoiceItem + Web.Stripe.Test.PaymentIntent Web.Stripe.Test.Plan Web.Stripe.Test.Prelude Web.Stripe.Test.Recipient diff --git a/stripe-tests/tests/Web/Stripe/Test/AllTests.hs b/stripe-tests/tests/Web/Stripe/Test/AllTests.hs index 8f5bced..9facbd7 100644 --- a/stripe-tests/tests/Web/Stripe/Test/AllTests.hs +++ b/stripe-tests/tests/Web/Stripe/Test/AllTests.hs @@ -18,6 +18,7 @@ import Web.Stripe.Test.Discount (discountTests) import Web.Stripe.Test.Dispute (disputeTests) import Web.Stripe.Test.Invoice (invoiceTests) import Web.Stripe.Test.InvoiceItem (invoiceItemTests) +import Web.Stripe.Test.PaymentIntent (paymentIntentTests) import Web.Stripe.Test.Plan (planTests) import Web.Stripe.Test.Recipient (recipientTests) import Web.Stripe.Test.Refund (refundTests) @@ -54,5 +55,6 @@ allTests stripe' = do balanceTests stripe tokenTests stripe eventTests stripe + paymentIntentTests stripe diff --git a/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs b/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs new file mode 100644 index 0000000..3c9a0d0 --- /dev/null +++ b/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RebindableSyntax #-} +{-# LANGUAGE RankNTypes #-} +module Web.Stripe.Test.PaymentIntent where + +import Data.Either (Either(..), isRight) +import Test.Hspec +import Web.Stripe.Test.Util (makePlanId) +import Web.Stripe.Test.Prelude + +import Web.Stripe.PaymentIntent +import Web.Stripe.Card +import Web.Stripe.Customer +import Web.Stripe.Token + +paymentIntentTests :: StripeSpec +paymentIntentTests stripe = do + describe "Payment intent tests" $ do + it "Succesfully creates a PaymentIntent" $ do + result <- stripe $ do + paymentIntent <- createPaymentIntent (Amount 100) USD + void $ cancelPaymentIntent (paymentIntentId paymentIntent) + return paymentIntent + result `shouldSatisfy` isRight + it "Successfully updates a PaymentIntent" $ do + result <- stripe $ do + paymentIntent <- createPaymentIntent (Amount 100) USD + updatedPaymentIntent <- updatePaymentIntent (paymentIntentId paymentIntent) + void $ cancelPaymentIntent (paymentIntentId paymentIntent) + return updatedPaymentIntent + result `shouldSatisfy` isRight + it "Successfully cancels a PaymentIntent" $ do + result <- stripe $ do + paymentIntent <- createPaymentIntent (Amount 100) USD + cancelledPaymentIntent <- cancelPaymentIntent (paymentIntentId paymentIntent) + return cancelledPaymentIntent + result `shouldSatisfy` isRight + it "Successfully gets a PaymentIntent"$ do + result <- stripe $ do + paymentIntent <- createPaymentIntent (Amount 100) USD + paymentIntent' <- getPaymentIntent (paymentIntentId paymentIntent) + void $ cancelPaymentIntent (paymentIntentId paymentIntent) + return paymentIntent' + result `shouldSatisfy` isRight + it "Successfully confirms a PaymentIntent"$ do + result <- stripe $ do + Customer { customerId = cid } <- createCustomer + paymentIntent <- createPaymentIntent (Amount 100) USD -&- cid + Token { tokenId = tkid } <- createCardToken (Just cardinfo) + Card { cardId = CardId cardid } <- createCustomerCardByToken cid tkid + confirmedPaymentIntent <- + confirmPaymentIntent (paymentIntentId paymentIntent) -&- (PaymentMethodId cardid) + void $ deleteCustomer cid + return confirmedPaymentIntent + result `shouldSatisfy` isRight + {- need to do a separate authorization and capture to test this + https://stripe.com/docs/payments/capture-later + it "Successfully captures a PaymentIntent"$ do + result <- stripe $ do + Customer { customerId = cid } <- createCustomer + paymentIntent <- createPaymentIntent (Amount 100) USD -&- cid + Token { tokenId = tkid } <- createCardToken (Just cardinfo) + Card { cardId = CardId cardid } <- createCustomerCardByToken cid tkid + capturedPaymentIntent <- capturePaymentIntent (paymentIntentId paymentIntent) + void $ deleteCustomer cid + return capturedPaymentIntent + result `shouldSatisfy` isRight -} + it "Successfully gets all PaymentIntents"$ do + result <- stripe $ do + paymentIntents <- getPaymentIntents + return paymentIntents + result `shouldSatisfy` isRight + + where + cardinfo = (mkNewCard credit em ey) { newCardCVC = Just cvc } + credit = CardNumber "4242424242424242" + em = ExpMonth 12 + ey = ExpYear 2020 + cvc = CVC "123" \ No newline at end of file From ec544e912ef1ff0e43ee8ce80bdd4b0b5ae5973f Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Tue, 22 Dec 2020 10:27:41 -0500 Subject: [PATCH 24/44] Add SetupFutureUsage --- stripe-core/src/Web/Stripe/PaymentIntent.hs | 8 +++++--- stripe-core/src/Web/Stripe/StripeRequest.hs | 8 +++++++- stripe-core/src/Web/Stripe/Types.hs | 11 ++++++++++- stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs | 2 +- 4 files changed, 23 insertions(+), 6 deletions(-) diff --git a/stripe-core/src/Web/Stripe/PaymentIntent.hs b/stripe-core/src/Web/Stripe/PaymentIntent.hs index 18a062f..bdc06ac 100644 --- a/stripe-core/src/Web/Stripe/PaymentIntent.hs +++ b/stripe-core/src/Web/Stripe/PaymentIntent.hs @@ -36,8 +36,9 @@ module Web.Stripe.PaymentIntent , PaymentIntent (..) , PaymentIntentId (..) , PaymentMethodId (..) - , PaymentMethodTypes (..) - , PaymentMethodType (..) + , PaymentMethodTypes (..) + , PaymentMethodType (..) + , SetupFutureUsage (..) , StripeList (..) , Token (..) ) where @@ -50,7 +51,7 @@ import Web.Stripe.Types (Amount(..), Charge (..), CardId (.. EndingBefore(..), Limit(..), MetaData(..), PaymentIntent (..), PaymentMethodId (..), PaymentMethodTypes(..), PaymentMethodType(..), PaymentIntentId (..), ReceiptEmail(..), - StartingAfter(..), ExpandParams(..), + SetupFutureUsage (..), StartingAfter(..), ExpandParams(..), StripeList (..), Token (..)) ------------------------------------------------------------------------------ @@ -73,6 +74,7 @@ type instance StripeReturn CreatePaymentIntent = PaymentIntent instance StripeHasParam CreatePaymentIntent CustomerId instance StripeHasParam CreatePaymentIntent ReceiptEmail instance StripeHasParam CreatePaymentIntent PaymentMethodTypes +instance StripeHasParam CreatePaymentIntent SetupFutureUsage ------------------------------------------------------------------------------ -- | Retrieve a `PaymentIntent` by `ChargeId` and `PaymentIntentId` diff --git a/stripe-core/src/Web/Stripe/StripeRequest.hs b/stripe-core/src/Web/Stripe/StripeRequest.hs index 121cc6b..992e187 100644 --- a/stripe-core/src/Web/Stripe/StripeRequest.hs +++ b/stripe-core/src/Web/Stripe/StripeRequest.hs @@ -66,7 +66,7 @@ import Web.Stripe.Types (AccountBalance(..), AccountNumber(..), RecipientId(..), RecipientType(..), RedeemBy(..), RefundId(..), RefundApplicationFee(..), RefundReason(..), - RoutingNumber(..), StartingAfter(..), + RoutingNumber(..), SetupFutureUsage(..), StartingAfter(..), StatementDescription(..), Source(..), SubscriptionId(..), TaxID(..), TaxPercent(..), TimeRange(..), @@ -334,6 +334,12 @@ instance ToStripeParam PaymentIntentId where toStripeParam (PaymentIntentId rid) = (("payment_intent", Text.encodeUtf8 rid) :) +instance ToStripeParam SetupFutureUsage where + toStripeParam OffSession = + (("setup_future_usage", "off_session") :) + toStripeParam OnSession = + (("setup_future_usage", "on_session") :) + instance ToStripeParam (Param Text Text) where toStripeParam (Param (k,v)) = ((Text.encodeUtf8 k, Text.encodeUtf8 v) :) diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index ca9ef85..146b1f1 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -2047,7 +2047,7 @@ data PaymentIntent = PaymentIntent { , paymentIntentPaymentMethodTypes :: [Text] , paymentIntentReceiptEmail :: Maybe ReceiptEmail , paymentIntentReview :: Maybe TODO - , paymentIntentSetupFutureUsage :: Maybe Text + , paymentIntentSetupFutureUsage :: Maybe SetupFutureUsage , paymentIntentShipping :: Maybe TODO , paymentIntentStatementDescriptor :: Maybe StatementDescription , paymentIntentStatementDescriptorSuffix :: Maybe StatementDescription @@ -2096,6 +2096,15 @@ instance FromJSON PaymentIntent where <*> o .:? "transfer_data" <*> o .:? "transfer_group" +data SetupFutureUsage = OnSession | OffSession + deriving (Read, Show, Eq, Ord, Data, Typeable) + +instance FromJSON SetupFutureUsage where + parseJSON = withText "SetupFutureUsage" $ \t -> case t of + "on_session" -> pure OnSession + "off_session" -> pure OffSession + _ -> fail $ "unknown SetupFutureUsage: " <> T.unpack t + data TODO = TODO deriving (Read, Show, Eq, Ord, Data, Typeable) diff --git a/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs b/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs index 3c9a0d0..6ed1278 100644 --- a/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs +++ b/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs @@ -18,7 +18,7 @@ paymentIntentTests stripe = do describe "Payment intent tests" $ do it "Succesfully creates a PaymentIntent" $ do result <- stripe $ do - paymentIntent <- createPaymentIntent (Amount 100) USD + paymentIntent <- createPaymentIntent (Amount 100) USD -&- OffSession void $ cancelPaymentIntent (paymentIntentId paymentIntent) return paymentIntent result `shouldSatisfy` isRight From 33647342b6576725547674c4906cb3182c6fbdce Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Tue, 22 Dec 2020 10:31:47 -0500 Subject: [PATCH 25/44] Add amount and currenct to UpdatePaymentIntent --- stripe-core/src/Web/Stripe/PaymentIntent.hs | 2 ++ stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs | 4 +++- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/stripe-core/src/Web/Stripe/PaymentIntent.hs b/stripe-core/src/Web/Stripe/PaymentIntent.hs index bdc06ac..dd25d99 100644 --- a/stripe-core/src/Web/Stripe/PaymentIntent.hs +++ b/stripe-core/src/Web/Stripe/PaymentIntent.hs @@ -107,6 +107,8 @@ data UpdatePaymentIntent type instance StripeReturn UpdatePaymentIntent = PaymentIntent instance StripeHasParam UpdatePaymentIntent MetaData instance StripeHasParam UpdatePaymentIntent PaymentMethodId +instance StripeHasParam UpdatePaymentIntent Amount +instance StripeHasParam UpdatePaymentIntent Currency confirmPaymentIntent :: PaymentIntentId diff --git a/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs b/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs index 6ed1278..d03d214 100644 --- a/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs +++ b/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs @@ -25,7 +25,9 @@ paymentIntentTests stripe = do it "Successfully updates a PaymentIntent" $ do result <- stripe $ do paymentIntent <- createPaymentIntent (Amount 100) USD - updatedPaymentIntent <- updatePaymentIntent (paymentIntentId paymentIntent) + updatedPaymentIntent <- + updatePaymentIntent (paymentIntentId paymentIntent) + -&- (Amount 100) -&- USD void $ cancelPaymentIntent (paymentIntentId paymentIntent) return updatedPaymentIntent result `shouldSatisfy` isRight From a4e66451e4447cdf9c3703af77dc2c5f702576f1 Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Tue, 29 Dec 2020 14:52:18 -0500 Subject: [PATCH 26/44] Add Description to CreatePaymentIntent params --- stripe-core/src/Web/Stripe/PaymentIntent.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/stripe-core/src/Web/Stripe/PaymentIntent.hs b/stripe-core/src/Web/Stripe/PaymentIntent.hs index dd25d99..a97083f 100644 --- a/stripe-core/src/Web/Stripe/PaymentIntent.hs +++ b/stripe-core/src/Web/Stripe/PaymentIntent.hs @@ -48,7 +48,7 @@ import Web.Stripe.StripeRequest (Method (GET, POST), StripeRequest (..), toStripeParam, mkStripeRequest) import Web.Stripe.Util (()) import Web.Stripe.Types (Amount(..), Charge (..), CardId (..), ChargeId (..), Currency(..), CustomerId(..), - EndingBefore(..), Limit(..), + Description(..), EndingBefore(..), Limit(..), MetaData(..), PaymentIntent (..), PaymentMethodId (..), PaymentMethodTypes(..), PaymentMethodType(..), PaymentIntentId (..), ReceiptEmail(..), SetupFutureUsage (..), StartingAfter(..), ExpandParams(..), @@ -72,6 +72,7 @@ createPaymentIntent data CreatePaymentIntent type instance StripeReturn CreatePaymentIntent = PaymentIntent instance StripeHasParam CreatePaymentIntent CustomerId +instance StripeHasParam CreatePaymentIntent Description instance StripeHasParam CreatePaymentIntent ReceiptEmail instance StripeHasParam CreatePaymentIntent PaymentMethodTypes instance StripeHasParam CreatePaymentIntent SetupFutureUsage From 2f16fbcbcf5fdce88ff3e50238b3c8d9383c092c Mon Sep 17 00:00:00 2001 From: L Dean Date: Tue, 29 Dec 2020 13:03:28 -0800 Subject: [PATCH 27/44] modify UpdatePaymentIntent to accept some more optional params --- stripe-core/src/Web/Stripe/PaymentIntent.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/stripe-core/src/Web/Stripe/PaymentIntent.hs b/stripe-core/src/Web/Stripe/PaymentIntent.hs index a97083f..70c6124 100644 --- a/stripe-core/src/Web/Stripe/PaymentIntent.hs +++ b/stripe-core/src/Web/Stripe/PaymentIntent.hs @@ -110,6 +110,12 @@ instance StripeHasParam UpdatePaymentIntent MetaData instance StripeHasParam UpdatePaymentIntent PaymentMethodId instance StripeHasParam UpdatePaymentIntent Amount instance StripeHasParam UpdatePaymentIntent Currency +instance StripeHasParam UpdatePaymentIntent CustomerId +instance StripeHasParam UpdatePaymentIntent Description +instance StripeHasParam UpdatePaymentIntent PaymentMethodTypes +instance StripeHasParam UpdatePaymentIntent ReceiptEmail +instance StripeHasParam UpdatePaymentIntent SetupFutureUsage +-- TODO shipping, statement descriptor, statement descriptor suffix confirmPaymentIntent :: PaymentIntentId From b5b8bd7e63fa5043eee3da9afb08fa79774244b1 Mon Sep 17 00:00:00 2001 From: L Dean Date: Tue, 29 Dec 2020 13:03:59 -0800 Subject: [PATCH 28/44] test for some new updatePaymentIntent params --- stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs b/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs index 9ce5d63..b882638 100644 --- a/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs +++ b/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs @@ -25,10 +25,15 @@ paymentIntentTests stripe = do it "Successfully updates a PaymentIntent" $ do result <- stripe $ do paymentIntent <- createPaymentIntent (Amount 100) USD + Customer { customerId = cid } <- createCustomer updatedPaymentIntent <- updatePaymentIntent (paymentIntentId paymentIntent) -&- (Amount 100) -&- USD + -&- cid + -&- Description "some description" + -&- OffSession void $ cancelPaymentIntent (paymentIntentId paymentIntent) + void $ deleteCustomer cid return updatedPaymentIntent result `shouldSatisfy` isRight it "Successfully cancels a PaymentIntent" $ do From 9e3189579729d7cfca514602f328fb2ef602b049 Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Thu, 31 Dec 2020 17:57:00 -0500 Subject: [PATCH 29/44] Export PaymentIntent params --- stripe-core/src/Web/Stripe/PaymentIntent.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/stripe-core/src/Web/Stripe/PaymentIntent.hs b/stripe-core/src/Web/Stripe/PaymentIntent.hs index 70c6124..ecafcfa 100644 --- a/stripe-core/src/Web/Stripe/PaymentIntent.hs +++ b/stripe-core/src/Web/Stripe/PaymentIntent.hs @@ -31,6 +31,8 @@ module Web.Stripe.PaymentIntent , Charge (..) , ChargeId (..) , Currency (..) + , CustomerId (..) + , Description (..) , EndingBefore (..) , ExpandParams (..) , PaymentIntent (..) From 42f61c65727eb22ba5573e8a84c3a9512dea5ab2 Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Thu, 7 Jan 2021 11:24:18 -0500 Subject: [PATCH 30/44] Add SetupIntents --- stripe-core/src/Web/Stripe/PaymentIntent.hs | 9 +- stripe-core/src/Web/Stripe/SetupIntent.hs | 151 ++++++++++++++++++ stripe-core/src/Web/Stripe/StripeRequest.hs | 20 ++- stripe-core/src/Web/Stripe/Types.hs | 119 ++++++++++---- stripe-core/stripe-core.cabal | 1 + stripe-tests/stripe-tests.cabal | 1 + .../tests/Web/Stripe/Test/AllTests.hs | 2 + stripe-tests/tests/Web/Stripe/Test/Balance.hs | 2 +- stripe-tests/tests/Web/Stripe/Test/Card.hs | 2 +- stripe-tests/tests/Web/Stripe/Test/Charge.hs | 2 +- stripe-tests/tests/Web/Stripe/Test/Dispute.hs | 2 +- stripe-tests/tests/Web/Stripe/Test/Invoice.hs | 2 +- .../tests/Web/Stripe/Test/PaymentIntent.hs | 6 +- stripe-tests/tests/Web/Stripe/Test/Refund.hs | 2 +- .../tests/Web/Stripe/Test/SetupIntent.hs | 87 ++++++++++ stripe-tests/tests/Web/Stripe/Test/Token.hs | 2 +- 16 files changed, 363 insertions(+), 47 deletions(-) create mode 100644 stripe-core/src/Web/Stripe/SetupIntent.hs create mode 100644 stripe-tests/tests/Web/Stripe/Test/SetupIntent.hs diff --git a/stripe-core/src/Web/Stripe/PaymentIntent.hs b/stripe-core/src/Web/Stripe/PaymentIntent.hs index ecafcfa..d6f044a 100644 --- a/stripe-core/src/Web/Stripe/PaymentIntent.hs +++ b/stripe-core/src/Web/Stripe/PaymentIntent.hs @@ -40,7 +40,8 @@ module Web.Stripe.PaymentIntent , PaymentMethodId (..) , PaymentMethodTypes (..) , PaymentMethodType (..) - , SetupFutureUsage (..) + , PaymentIntentUsage (..) + , Usage (..) , StripeList (..) , Token (..) ) where @@ -53,7 +54,7 @@ import Web.Stripe.Types (Amount(..), Charge (..), CardId (.. Description(..), EndingBefore(..), Limit(..), MetaData(..), PaymentIntent (..), PaymentMethodId (..), PaymentMethodTypes(..), PaymentMethodType(..), PaymentIntentId (..), ReceiptEmail(..), - SetupFutureUsage (..), StartingAfter(..), ExpandParams(..), + PaymentIntentUsage(..), Usage (..), StartingAfter(..), ExpandParams(..), StripeList (..), Token (..)) ------------------------------------------------------------------------------ @@ -77,7 +78,7 @@ instance StripeHasParam CreatePaymentIntent CustomerId instance StripeHasParam CreatePaymentIntent Description instance StripeHasParam CreatePaymentIntent ReceiptEmail instance StripeHasParam CreatePaymentIntent PaymentMethodTypes -instance StripeHasParam CreatePaymentIntent SetupFutureUsage +instance StripeHasParam CreatePaymentIntent PaymentIntentUsage ------------------------------------------------------------------------------ -- | Retrieve a `PaymentIntent` by `ChargeId` and `PaymentIntentId` @@ -116,7 +117,7 @@ instance StripeHasParam UpdatePaymentIntent CustomerId instance StripeHasParam UpdatePaymentIntent Description instance StripeHasParam UpdatePaymentIntent PaymentMethodTypes instance StripeHasParam UpdatePaymentIntent ReceiptEmail -instance StripeHasParam UpdatePaymentIntent SetupFutureUsage +instance StripeHasParam UpdatePaymentIntent PaymentIntentUsage -- TODO shipping, statement descriptor, statement descriptor suffix confirmPaymentIntent diff --git a/stripe-core/src/Web/Stripe/SetupIntent.hs b/stripe-core/src/Web/Stripe/SetupIntent.hs new file mode 100644 index 0000000..d536e90 --- /dev/null +++ b/stripe-core/src/Web/Stripe/SetupIntent.hs @@ -0,0 +1,151 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.SetupIntent +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +module Web.Stripe.SetupIntent + ( -- * API + CreateSetupIntent + , createSetupIntent + , GetSetupIntent + , getSetupIntent + , UpdateSetupIntent + , updateSetupIntent + , ConfirmSetupIntent + , confirmSetupIntent + , CancelSetupIntent + , cancelSetupIntent + , GetSetupIntents + , getSetupIntents + -- * Types + , Amount (..) + , CardId (..) + , Charge (..) + , ChargeId (..) + , Currency (..) + , CustomerId (..) + , Description (..) + , EndingBefore (..) + , ExpandParams (..) + , SetupIntent (..) + , SetupIntentId (..) + , PaymentMethodId (..) + , PaymentMethodTypes (..) + , PaymentMethodType (..) + , SetupIntentUsage (..) + , Usage (..) + , StripeList (..) + , Token (..) + ) where + +import Web.Stripe.StripeRequest (Method (GET, POST), + StripeHasParam, StripeReturn, + StripeRequest (..), toStripeParam, mkStripeRequest) +import Web.Stripe.Util (()) +import Web.Stripe.Types (Amount(..), Charge (..), CardId (..), ChargeId (..), Currency(..), CustomerId(..), + Description(..), EndingBefore(..), Limit(..), + MetaData(..), SetupIntent (..), PaymentMethodId (..), PaymentMethodTypes(..), PaymentMethodType(..), + SetupIntentId (..), ReceiptEmail(..), + SetupIntentUsage(..), Usage (..), StartingAfter(..), ExpandParams(..), + StripeList (..), Token (..)) + +------------------------------------------------------------------------------ +-- | create a `SetupIntent` +createSetupIntent :: StripeRequest CreateSetupIntent +createSetupIntent = request + where request = mkStripeRequest POST url params + url = "setup_intents" + params = [] + +data CreateSetupIntent +type instance StripeReturn CreateSetupIntent = SetupIntent +instance StripeHasParam CreateSetupIntent CustomerId +instance StripeHasParam CreateSetupIntent Description +instance StripeHasParam CreateSetupIntent PaymentMethodTypes +instance StripeHasParam CreateSetupIntent SetupIntentUsage + +------------------------------------------------------------------------------ +-- | Retrieve a `SetupIntent` by `ChargeId` and `SetupIntentId` +getSetupIntent + :: SetupIntentId -- ^ `SetupIntentId` associated with the `SetupIntent` to be retrieved + -> StripeRequest GetSetupIntent +getSetupIntent + (SetupIntentId setupIntentid) = request + where request = mkStripeRequest GET url params + url = "setup_intents" setupIntentid + params = [] + +data GetSetupIntent +type instance StripeReturn GetSetupIntent = SetupIntent +instance StripeHasParam GetSetupIntent ExpandParams + +------------------------------------------------------------------------------ +-- | Update a `SetupIntent` by `ChargeId` and `SetupIntentId` +updateSetupIntent + :: SetupIntentId -- ^ `SetupIntentId` associated with the `SetupIntent` to be retrieved + -> StripeRequest UpdateSetupIntent +updateSetupIntent + (SetupIntentId setupIntentid) + = request + where request = mkStripeRequest POST url params + url = "setup_intents" setupIntentid + params = [] + +data UpdateSetupIntent +type instance StripeReturn UpdateSetupIntent = SetupIntent +instance StripeHasParam UpdateSetupIntent MetaData +instance StripeHasParam UpdateSetupIntent PaymentMethodId +instance StripeHasParam UpdateSetupIntent CustomerId +instance StripeHasParam UpdateSetupIntent Description +instance StripeHasParam UpdateSetupIntent PaymentMethodTypes + +confirmSetupIntent + :: SetupIntentId + -> StripeRequest ConfirmSetupIntent +confirmSetupIntent + (SetupIntentId setupIntentid) + = request + where request = mkStripeRequest POST url params + url = "setup_intents" setupIntentid "confirm" + params = [] + +data ConfirmSetupIntent +type instance StripeReturn ConfirmSetupIntent = SetupIntent +instance StripeHasParam ConfirmSetupIntent MetaData +instance StripeHasParam ConfirmSetupIntent PaymentMethodId + +cancelSetupIntent + :: SetupIntentId + -> StripeRequest CancelSetupIntent +cancelSetupIntent + (SetupIntentId setupIntentid) + = request + where request = mkStripeRequest POST url params + url = "setup_intents" setupIntentid "cancel" + params = [] + +data CancelSetupIntent +type instance StripeReturn CancelSetupIntent = SetupIntent + +------------------------------------------------------------------------------ +-- | Retrieve a list of SetupIntents +getSetupIntents + :: StripeRequest GetSetupIntents +getSetupIntents + = request + where request = mkStripeRequest GET url params + url = "setup_intents" + params = [] + +data GetSetupIntents +type instance StripeReturn GetSetupIntents = StripeList SetupIntent +instance StripeHasParam GetSetupIntents ExpandParams +instance StripeHasParam GetSetupIntents (EndingBefore SetupIntentId) +instance StripeHasParam GetSetupIntents Limit +instance StripeHasParam GetSetupIntents (StartingAfter SetupIntentId) diff --git a/stripe-core/src/Web/Stripe/StripeRequest.hs b/stripe-core/src/Web/Stripe/StripeRequest.hs index 992e187..f9ed6f6 100644 --- a/stripe-core/src/Web/Stripe/StripeRequest.hs +++ b/stripe-core/src/Web/Stripe/StripeRequest.hs @@ -58,7 +58,7 @@ import Web.Stripe.Types (AccountBalance(..), AccountNumber(..), IntervalCount(..), InvoiceId(..), InvoiceItemId(..), InvoiceLineItemId(..), - IsVerified(..), MetaData(..), PaymentIntentId(..), PaymentMethodId(..), PaymentMethodTypes(..), PaymentMethodType(..), PlanId(..), + IsVerified(..), MetaData(..), PaymentIntentId(..), PaymentIntentUsage(..), PaymentMethodId(..), PaymentMethodTypes(..), PaymentMethodType(..), PlanId(..), PlanName(..), Prorate(..), Limit(..), MaxRedemptions(..), Name(..), NewBankAccount(..), NewCard(..), @@ -66,7 +66,7 @@ import Web.Stripe.Types (AccountBalance(..), AccountNumber(..), RecipientId(..), RecipientType(..), RedeemBy(..), RefundId(..), RefundApplicationFee(..), RefundReason(..), - RoutingNumber(..), SetupFutureUsage(..), StartingAfter(..), + RoutingNumber(..), SetupIntentId(..), SetupIntentUsage(..), Usage(..), StartingAfter(..), StatementDescription(..), Source(..), SubscriptionId(..), TaxID(..), TaxPercent(..), TimeRange(..), @@ -334,12 +334,18 @@ instance ToStripeParam PaymentIntentId where toStripeParam (PaymentIntentId rid) = (("payment_intent", Text.encodeUtf8 rid) :) -instance ToStripeParam SetupFutureUsage where - toStripeParam OffSession = +instance ToStripeParam PaymentIntentUsage where + toStripeParam (PaymentIntentUsage OffSession) = (("setup_future_usage", "off_session") :) - toStripeParam OnSession = + toStripeParam (PaymentIntentUsage OnSession) = (("setup_future_usage", "on_session") :) +instance ToStripeParam SetupIntentUsage where + toStripeParam (SetupIntentUsage OffSession) = + (("usage", "off_session") :) + toStripeParam (SetupIntentUsage OnSession) = + (("usage", "on_session") :) + instance ToStripeParam (Param Text Text) where toStripeParam (Param (k,v)) = ((Text.encodeUtf8 k, Text.encodeUtf8 v) :) @@ -509,6 +515,10 @@ instance ToStripeParam RefundReason where RefundFraudulent -> "fraudulent" RefundRequestedByCustomer -> "requested_by_customer") :) +instance ToStripeParam SetupIntentId where + toStripeParam (SetupIntentId siid) = + (("setup_intent", Text.encodeUtf8 siid) :) + instance ToStripeParam StatementDescription where toStripeParam (StatementDescription txt) = (("statement_description", Text.encodeUtf8 txt) :) diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index 146b1f1..1aafdec 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -2036,7 +2036,7 @@ data PaymentIntent = PaymentIntent { , paymentIntentCreated :: UTCTime , paymentIntentCurrency :: Currency , paymentIntentCustomer :: Maybe (Expandable CustomerId) - , paymentInventInvoice :: Maybe (Expandable InvoiceId) + , paymentIntentInvoice :: Maybe (Expandable InvoiceId) , paymentIntentLastPaymentError :: Maybe TODO , paymentIntentLiveMode :: Maybe Bool , paymentIntentMetadata :: Maybe MetaData @@ -2047,11 +2047,11 @@ data PaymentIntent = PaymentIntent { , paymentIntentPaymentMethodTypes :: [Text] , paymentIntentReceiptEmail :: Maybe ReceiptEmail , paymentIntentReview :: Maybe TODO - , paymentIntentSetupFutureUsage :: Maybe SetupFutureUsage + , paymentIntentSetupFutureUsage :: Maybe PaymentIntentUsage , paymentIntentShipping :: Maybe TODO , paymentIntentStatementDescriptor :: Maybe StatementDescription , paymentIntentStatementDescriptorSuffix :: Maybe StatementDescription - , paymentIntentStatus :: PaymentIntentStatus + , paymentIntentStatus :: IntentStatus , paymentIntentTransferData :: Maybe TODO , paymentIntentTransferGroup :: Maybe Text } deriving (Read, Show, Eq, Ord, Data, Typeable) @@ -2088,7 +2088,7 @@ instance FromJSON PaymentIntent where <*> o .: "payment_method_types" <*> (fmap ReceiptEmail <$> o .:? "receipt_email") <*> o .:? "review" - <*> o .:? "setup_future_usage" + <*> (fmap . fmap) PaymentIntentUsage (o .:? "setup_future_usage") <*> o .:? "shipping" <*> o .:? "statement_descriptor" <*> o .:? "statement_descriptor_suffix" @@ -2096,14 +2096,77 @@ instance FromJSON PaymentIntent where <*> o .:? "transfer_data" <*> o .:? "transfer_group" -data SetupFutureUsage = OnSession | OffSession + +newtype PaymentIntentUsage = PaymentIntentUsage Usage + deriving (Read, Show, Eq, Ord, Data, Typeable) + + +newtype SetupIntentUsage = SetupIntentUsage Usage deriving (Read, Show, Eq, Ord, Data, Typeable) -instance FromJSON SetupFutureUsage where - parseJSON = withText "SetupFutureUsage" $ \t -> case t of + +data Usage = OnSession | OffSession + deriving (Read, Show, Eq, Ord, Data, Typeable) + +instance FromJSON Usage where + parseJSON = withText "Usage" $ \t -> case t of "on_session" -> pure OnSession "off_session" -> pure OffSession - _ -> fail $ "unknown SetupFutureUsage: " <> T.unpack t + _ -> fail $ "unknown Usage: " <> T.unpack t + + +------------------------------------------------------------------------------ +-- | `SetupIntentId` for `SetupIntent` +newtype SetupIntentId = + SetupIntentId { getSetupIntentId :: Text } deriving (Read, Show, Eq, Ord, Data, Typeable, FromJSON) + +------------------------------------------------------------------------------ +-- | `SetupIntent` Object +data SetupIntent = SetupIntent { + setupIntentId :: SetupIntentId + , setupIntentApplication :: Maybe (Expandable ApplicationId) + , setupIntentCancellationReason :: Maybe CancellationReason + , setupIntentClientSecret :: Maybe (Text) + , setupIntentCreated :: UTCTime + , setupIntentCustomer :: Maybe (Expandable CustomerId) + , setupIntentDescription :: Maybe Text + , setupIntentLastSetupError :: Maybe TODO + , setupIntentLiveMode :: Maybe Bool + , setupIntentMetadata :: Maybe MetaData + , setupIntentNextAction :: Maybe TODO + , setupIntentOnBehalfOf :: Maybe (Expandable AccountId) + , setupIntentPaymentMethod :: Maybe TODO + , setupIntentPaymentOptions :: Maybe TODO + , setupIntentPaymentMethodTypes :: [Text] + , setupIntentSingleUseMandate :: Maybe TODO + , setupIntentStatus :: IntentStatus + , setupIntentUsage :: Maybe SetupIntentUsage + } deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | JSON Instance for `SetupIntent` +instance FromJSON SetupIntent where + parseJSON = withObject "SetupIntent" $ \o -> + SetupIntent + <$> (SetupIntentId <$> o .: "id") + <*> o .:? "application" + <*> o .:? "cancellation_reason" + <*> o .:? "client_secret" + <*> (fromSeconds <$> o .: "created") + <*> o .:? "customer" + <*> o .:? "description" + <*> o .:? "last_setup_error" + <*> o .:? "live_mode" + <*> o .:? "metadata" + <*> o .:? "next_action" + <*> o .:? "on_behalf_of" + <*> o .:? "payment_method" + <*> o .:? "payment_options" + <*> o .: "payment_method_types" + <*> o .:? "single_use_mandate" + <*> o .: "status" + <*> (fmap.fmap) SetupIntentUsage (o .:? "usage") + data TODO = TODO deriving (Read, Show, Eq, Ord, Data, Typeable) @@ -2166,28 +2229,28 @@ instance FromJSON ConfirmationMethod where "manual" -> pure ConfirmationMethodManual _ -> fail $ "Unknown ConfirmationMethod: " <> T.unpack t -data PaymentIntentStatus - = PaymentIntentStatusCanceled - | PaymentIntentStatusProcessing - | PaymentIntentStatusRequiresAction - | PaymentIntentStatusRequiresCapture - | PaymentIntentStatusRequiresConfirmation - | PaymentIntentStatusRequiresSource - | PaymentIntentStatusRequiresPaymentMethod - | PaymentIntentStatusSucceeded +data IntentStatus + = IntentStatusCanceled + | IntentStatusProcessing + | IntentStatusRequiresAction + | IntentStatusRequiresCapture + | IntentStatusRequiresConfirmation + | IntentStatusRequiresSource + | IntentStatusRequiresPaymentMethod + | IntentStatusSucceeded deriving (Read, Show, Eq, Ord, Data, Typeable) -instance FromJSON PaymentIntentStatus where - parseJSON = withText "PaymentIntentStatus" $ \t -> case t of - "canceled" -> pure PaymentIntentStatusCanceled - "processing" -> pure PaymentIntentStatusProcessing - "requires_action" -> pure PaymentIntentStatusRequiresAction - "requires_capture" -> pure PaymentIntentStatusRequiresCapture - "requires_confirmation" -> pure PaymentIntentStatusRequiresConfirmation - "requires_payment_method" -> pure PaymentIntentStatusRequiresPaymentMethod - "requires_source" -> pure PaymentIntentStatusRequiresSource - "succeeded" -> pure PaymentIntentStatusSucceeded - _ -> fail $ "Unknown PaymentIntentStatus: " <> T.unpack t +instance FromJSON IntentStatus where + parseJSON = withText "IntentStatus" $ \t -> case t of + "canceled" -> pure IntentStatusCanceled + "processing" -> pure IntentStatusProcessing + "requires_action" -> pure IntentStatusRequiresAction + "requires_capture" -> pure IntentStatusRequiresCapture + "requires_confirmation" -> pure IntentStatusRequiresConfirmation + "requires_payment_method" -> pure IntentStatusRequiresPaymentMethod + "requires_source" -> pure IntentStatusRequiresSource + "succeeded" -> pure IntentStatusSucceeded + _ -> fail $ "Unknown IntentStatus: " <> T.unpack t newtype PaymentMethodId = PaymentMethodId Text deriving (Read, Show, Eq, Ord, Data, Typeable) diff --git a/stripe-core/stripe-core.cabal b/stripe-core/stripe-core.cabal index 79ae3f8..3118efd 100644 --- a/stripe-core/stripe-core.cabal +++ b/stripe-core/stripe-core.cabal @@ -52,6 +52,7 @@ library Web.Stripe.Recipient Web.Stripe.Refund Web.Stripe.Session + Web.Stripe.SetupIntent Web.Stripe.StripeRequest Web.Stripe.Subscription Web.Stripe.Token diff --git a/stripe-tests/stripe-tests.cabal b/stripe-tests/stripe-tests.cabal index 9f9d8d9..f46c424 100644 --- a/stripe-tests/stripe-tests.cabal +++ b/stripe-tests/stripe-tests.cabal @@ -57,6 +57,7 @@ library Web.Stripe.Test.Prelude Web.Stripe.Test.Recipient Web.Stripe.Test.Refund + Web.Stripe.Test.SetupIntent Web.Stripe.Test.Subscription Web.Stripe.Test.Token Web.Stripe.Test.Transfer diff --git a/stripe-tests/tests/Web/Stripe/Test/AllTests.hs b/stripe-tests/tests/Web/Stripe/Test/AllTests.hs index 9facbd7..61bfd26 100644 --- a/stripe-tests/tests/Web/Stripe/Test/AllTests.hs +++ b/stripe-tests/tests/Web/Stripe/Test/AllTests.hs @@ -21,6 +21,7 @@ import Web.Stripe.Test.InvoiceItem (invoiceItemTests) import Web.Stripe.Test.PaymentIntent (paymentIntentTests) import Web.Stripe.Test.Plan (planTests) import Web.Stripe.Test.Recipient (recipientTests) +import Web.Stripe.Test.SetupIntent (setupIntentTests) import Web.Stripe.Test.Refund (refundTests) import Web.Stripe.Test.Subscription (subscriptionTests) import Web.Stripe.Test.Token (tokenTests) @@ -56,5 +57,6 @@ allTests stripe' = do tokenTests stripe eventTests stripe paymentIntentTests stripe + setupIntentTests stripe diff --git a/stripe-tests/tests/Web/Stripe/Test/Balance.hs b/stripe-tests/tests/Web/Stripe/Test/Balance.hs index 58ea15a..4227ce0 100644 --- a/stripe-tests/tests/Web/Stripe/Test/Balance.hs +++ b/stripe-tests/tests/Web/Stripe/Test/Balance.hs @@ -48,6 +48,6 @@ balanceTests stripe = do where cn = CardNumber "4242424242424242" em = ExpMonth 12 - ey = ExpYear 2020 + ey = ExpYear 2023 cvc = CVC "123" diff --git a/stripe-tests/tests/Web/Stripe/Test/Card.hs b/stripe-tests/tests/Web/Stripe/Test/Card.hs index 251b65b..a0d4a94 100644 --- a/stripe-tests/tests/Web/Stripe/Test/Card.hs +++ b/stripe-tests/tests/Web/Stripe/Test/Card.hs @@ -233,7 +233,7 @@ cardTests stripe = do credit = CardNumber "4242424242424242" debit = CardNumber "4000056655665556" em = ExpMonth 12 - ey = ExpYear 2020 + ey = ExpYear 2023 cvc = CVC "123" country = Country "US" routingnumber = RoutingNumber "110000000" diff --git a/stripe-tests/tests/Web/Stripe/Test/Charge.hs b/stripe-tests/tests/Web/Stripe/Test/Charge.hs index 3431adc..510ac2a 100644 --- a/stripe-tests/tests/Web/Stripe/Test/Charge.hs +++ b/stripe-tests/tests/Web/Stripe/Test/Charge.hs @@ -22,7 +22,7 @@ chargeTests stripe = where cn = CardNumber "4242424242424242" em = ExpMonth 12 - ey = ExpYear 2020 + ey = ExpYear 2023 cvc = CVC "123" cardinfo = (mkNewCard cn em ey) { newCardCVC = Just cvc } chargeCustomerTest = diff --git a/stripe-tests/tests/Web/Stripe/Test/Dispute.hs b/stripe-tests/tests/Web/Stripe/Test/Dispute.hs index b9fe598..306bd69 100644 --- a/stripe-tests/tests/Web/Stripe/Test/Dispute.hs +++ b/stripe-tests/tests/Web/Stripe/Test/Dispute.hs @@ -89,7 +89,7 @@ disputeTests stripe = do where cn = CardNumber "4000000000000259" em = ExpMonth 12 - ey = ExpYear 2020 + ey = ExpYear 2023 cvc = CVC "123" win = Evidence "winning_evidence" lose = Evidence "losing_evidence" diff --git a/stripe-tests/tests/Web/Stripe/Test/Invoice.hs b/stripe-tests/tests/Web/Stripe/Test/Invoice.hs index c1c926c..12c9a49 100644 --- a/stripe-tests/tests/Web/Stripe/Test/Invoice.hs +++ b/stripe-tests/tests/Web/Stripe/Test/Invoice.hs @@ -117,5 +117,5 @@ invoiceTests stripe = do meta = MetaData [ ("some","metadata") ] credit = CardNumber "4242424242424242" em = ExpMonth 12 - ey = ExpYear 2020 + ey = ExpYear 2023 cvc = CVC "123" diff --git a/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs b/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs index b882638..90c396e 100644 --- a/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs +++ b/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs @@ -18,7 +18,7 @@ paymentIntentTests stripe = do describe "Payment intent tests" $ do it "Succesfully creates a PaymentIntent" $ do result <- stripe $ do - paymentIntent <- createPaymentIntent (Amount 100) USD -&- OffSession + paymentIntent <- createPaymentIntent (Amount 100) USD -&- (PaymentIntentUsage OffSession) void $ cancelPaymentIntent (paymentIntentId paymentIntent) return paymentIntent result `shouldSatisfy` isRight @@ -31,7 +31,7 @@ paymentIntentTests stripe = do -&- (Amount 100) -&- USD -&- cid -&- Description "some description" - -&- OffSession + -&- (PaymentIntentUsage OffSession) void $ cancelPaymentIntent (paymentIntentId paymentIntent) void $ deleteCustomer cid return updatedPaymentIntent @@ -82,5 +82,5 @@ paymentIntentTests stripe = do cardinfo = (mkNewCard credit em ey) { newCardCVC = Just cvc } credit = CardNumber "4242424242424242" em = ExpMonth 12 - ey = ExpYear 2020 + ey = ExpYear 2023 cvc = CVC "123" diff --git a/stripe-tests/tests/Web/Stripe/Test/Refund.hs b/stripe-tests/tests/Web/Stripe/Test/Refund.hs index 407853b..7e8c5f5 100644 --- a/stripe-tests/tests/Web/Stripe/Test/Refund.hs +++ b/stripe-tests/tests/Web/Stripe/Test/Refund.hs @@ -20,7 +20,7 @@ em :: ExpMonth em = ExpMonth 12 ey :: ExpYear -ey = ExpYear 2020 +ey = ExpYear 2023 cvc :: CVC cvc = CVC "123" diff --git a/stripe-tests/tests/Web/Stripe/Test/SetupIntent.hs b/stripe-tests/tests/Web/Stripe/Test/SetupIntent.hs new file mode 100644 index 0000000..e90b72b --- /dev/null +++ b/stripe-tests/tests/Web/Stripe/Test/SetupIntent.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RebindableSyntax #-} +{-# LANGUAGE RankNTypes #-} +module Web.Stripe.Test.SetupIntent where + +import Data.Either (Either(..), isRight) +import Test.Hspec +import Web.Stripe.Test.Util (makePlanId) +import Web.Stripe.Test.Prelude + +import Web.Stripe.SetupIntent +import Web.Stripe.Card +import Web.Stripe.Customer +import Web.Stripe.Token + +setupIntentTests :: StripeSpec +setupIntentTests stripe = do + describe "Setup intent tests" $ do + it "Succesfully creates a SetupIntent" $ do + result <- stripe $ do + setupIntent <- createSetupIntent -&- (SetupIntentUsage OffSession) + void $ cancelSetupIntent (setupIntentId setupIntent) + return setupIntent + result `shouldSatisfy` isRight + it "Successfully updates a SetupIntent" $ do + result <- stripe $ do + setupIntent <- createSetupIntent + Customer { customerId = cid } <- createCustomer + Token { tokenId = tkid } <- createCardToken (Just cardinfo) + Card { cardId = CardId cardid } <- createCustomerCardByToken cid tkid + updatedSetupIntent <- + updateSetupIntent (setupIntentId setupIntent) + -&- cid + -&- Description "some description" + -&- PaymentMethodId cardid + void $ cancelSetupIntent (setupIntentId setupIntent) + void $ deleteCustomer cid + return updatedSetupIntent + result `shouldSatisfy` isRight + it "Successfully cancels a SetupIntent" $ do + result <- stripe $ do + setupIntent <- createSetupIntent + cancelledSetupIntent <- cancelSetupIntent (setupIntentId setupIntent) + return cancelledSetupIntent + result `shouldSatisfy` isRight + it "Successfully gets a SetupIntent"$ do + result <- stripe $ do + setupIntent <- createSetupIntent + setupIntent' <- getSetupIntent (setupIntentId setupIntent) + void $ cancelSetupIntent (setupIntentId setupIntent) + return setupIntent' + result `shouldSatisfy` isRight + it "Successfully confirms a SetupIntent"$ do + result <- stripe $ do + Customer { customerId = cid } <- createCustomer + setupIntent <- createSetupIntent -&- cid + Token { tokenId = tkid } <- createCardToken (Just cardinfo) + Card { cardId = CardId cardid } <- createCustomerCardByToken cid tkid + confirmedSetupIntent <- + confirmSetupIntent (setupIntentId setupIntent) -&- (PaymentMethodId cardid) + void $ deleteCustomer cid + return confirmedSetupIntent + result `shouldSatisfy` isRight + {- need to do a separate authorization and capture to test this + https://stripe.com/docs/payments/capture-later + it "Successfully captures a SetupIntent"$ do + result <- stripe $ do + Customer { customerId = cid } <- createCustomer + setupIntent <- createSetupIntent (Amount 100) USD -&- cid + Token { tokenId = tkid } <- createCardToken (Just cardinfo) + Card { cardId = CardId cardid } <- createCustomerCardByToken cid tkid + capturedSetupIntent <- captureSetupIntent (setupIntentId setupIntent) + void $ deleteCustomer cid + return capturedSetupIntent + result `shouldSatisfy` isRight -} + it "Successfully gets all SetupIntents"$ do + result <- stripe $ do + setupIntents <- getSetupIntents + return setupIntents + result `shouldSatisfy` isRight + + where + cardinfo = (mkNewCard credit em ey) { newCardCVC = Just cvc } + credit = CardNumber "4242424242424242" + em = ExpMonth 12 + ey = ExpYear 2023 + cvc = CVC "123" diff --git a/stripe-tests/tests/Web/Stripe/Test/Token.hs b/stripe-tests/tests/Web/Stripe/Test/Token.hs index 048113e..d5e84bb 100644 --- a/stripe-tests/tests/Web/Stripe/Test/Token.hs +++ b/stripe-tests/tests/Web/Stripe/Test/Token.hs @@ -32,7 +32,7 @@ tokenTests stripe = do where cn = CardNumber "4242424242424242" em = ExpMonth 12 - ey = ExpYear 2020 + ey = ExpYear 2023 cvc = CVC "123" cardinfo = (mkNewCard cn em ey) { newCardCVC = Just cvc } bankinfo = NewBankAccount From b6df3ed14b87c2d31aadde340ca5befe26495c0e Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Thu, 14 Jan 2021 15:46:38 -0500 Subject: [PATCH 31/44] Add PaymentMethod --- stripe-core/src/Web/Stripe/PaymentMethod.hs | 228 ++++++++++++++++++ stripe-core/src/Web/Stripe/StripeRequest.hs | 7 +- stripe-core/src/Web/Stripe/Types.hs | 81 ++++++- stripe-core/stripe-core.cabal | 1 + stripe-tests/stripe-tests.cabal | 1 + .../tests/Web/Stripe/Test/AllTests.hs | 2 + .../tests/Web/Stripe/Test/PaymentMethod.hs | 133 ++++++++++ stripe-tests/tests/Web/Stripe/Test/Prelude.hs | 7 +- 8 files changed, 445 insertions(+), 15 deletions(-) create mode 100644 stripe-core/src/Web/Stripe/PaymentMethod.hs create mode 100644 stripe-tests/tests/Web/Stripe/Test/PaymentMethod.hs diff --git a/stripe-core/src/Web/Stripe/PaymentMethod.hs b/stripe-core/src/Web/Stripe/PaymentMethod.hs new file mode 100644 index 0000000..7c76e53 --- /dev/null +++ b/stripe-core/src/Web/Stripe/PaymentMethod.hs @@ -0,0 +1,228 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +------------------------------------------- + +module Web.Stripe.PaymentMethod + ( -- * API + -- ** Customers + -- *** Create PaymentMethod + CreatePaymentMethodByToken + , createPaymentMethodByToken + , CreatePaymentMethod + , createPaymentMethod + , AttachPaymentMethod + , attachPaymentMethod + -- *** Get PaymentMethod(s) + , GetPaymentMethod + , getPaymentMethod + , GetCustomerPaymentMethods + , getCustomerPaymentMethods {- + , GetPaymentMethods + , getPaymentMethods + -- *** Update PaymentMethod + , UpdatePaymentMethod + , updatePaymentMethod + -- *** Delete PaymentMethod -} + , DetachPaymentMethod + , detachPaymentMethod + -- * Types + , AddressLine1 (..) + , AddressLine2 (..) + , AddressCity (..) + , AddressCountry (..) + , AddressState (..) + , AddressZip (..) + , Brand (..) + , PaymentMethod (..) + , PaymentMethodId (..) + , PaymentMethodType (..) + , CardHash (..) + , CardNumber (..) + , CVC (..) + , EndingBefore (..) + , ExpandParams (..) + , ExpMonth (..) + , ExpYear (..) + , Limit (..) + , Name (..) + , StartingAfter (..) + ) where + +import Data.Text (Text) +import Web.Stripe.StripeRequest (Method (GET, POST, DELETE), + StripeHasParam, StripeRequest (..), + StripeReturn, ToStripeParam(..), + mkStripeRequest) +import Web.Stripe.Util (()) +import Web.Stripe.Types (AddressLine1(..), AddressLine2(..) + , AddressCity(..), AddressCountry(..) + , AddressState(..), AddressZip(..) + , Brand(..), PaymentMethod(..), PaymentMethodId(..) + , PaymentMethodType(..), CardHash(..), CardToken(..) + , CardNumber(..), CustomerId(..) + , CVC(..), EndingBefore(..) + , ExpandParams(..) + , ExpMonth(..), ExpYear(..), ID + , Limit(..), Name(..), NewCard(..) + , StartingAfter(..) + , StripeDeleteResult(..) + , StripeList(..), TokenId(..), URL) +import Web.Stripe.Types.Util (getCustomerId) + +createPaymentMethodByToken + :: TokenId -- ^ `TokenId` of card to add + -> PaymentMethodType + -> StripeRequest CreatePaymentMethodByToken +createPaymentMethodByToken + tokenid + typ = request + where request = mkStripeRequest POST url params + url = "payment_methods" + params = toStripeParam (CardToken tokenid) $ + toStripeParam typ + [] + +data CreatePaymentMethodByToken +type instance StripeReturn CreatePaymentMethodByToken = PaymentMethod + +createPaymentMethod + :: NewCard + -> StripeRequest CreatePaymentMethod +createPaymentMethod + newPaymentMethod = request + where request = mkStripeRequest POST url params + url = "payment_methods" + params = toStripeParam newPaymentMethod $ + toStripeParam PaymentMethodTypeCard + [] + +data CreatePaymentMethod +type instance StripeReturn CreatePaymentMethod = PaymentMethod + +attachPaymentMethod + :: PaymentMethodId -- ^ `TokenId` of card to add + -> CustomerId -- ^ id of customer + -> StripeRequest CreatePaymentMethodByToken +attachPaymentMethod + paymentMethodId + customer = request + where request = mkStripeRequest POST url params + url = "payment_methods" getPaymentMethodId paymentMethodId "attach" + params = toStripeParam customer $ + [] + +data AttachPaymentMethod +type instance StripeReturn AttachPaymentMethod = PaymentMethod + +getPaymentMethod + :: PaymentMethodId + -> StripeRequest GetPaymentMethod +getPaymentMethod + pmid = request + where request = mkStripeRequest GET url params + url = "payment_methods" getPaymentMethodId pmid + params = [] +data GetPaymentMethod +type instance StripeReturn GetPaymentMethod = PaymentMethod +-- instance StripeHasParam GetPaymentMethod ExpandParams + +getCustomerPaymentMethods + :: CustomerId -- ^ `CustomerId` of the `PaymentMethod` to retrieve + -> StripeRequest GetCustomerPaymentMethods +getCustomerPaymentMethods + customer = request + where request = mkStripeRequest GET url params + url = "payment_methods" + params = toStripeParam customer $ + toStripeParam PaymentMethodTypeCard + [] + +data GetCustomerPaymentMethods +type instance StripeReturn GetCustomerPaymentMethods = StripeList PaymentMethod +--instance StripeHasParam GetCustomerPaymentMethods ExpandParams +{- +------------------------------------------------------------------------------ +-- | INTERNAL: Generalized update a `PaymentMethod` +updatePaymentMethod + :: URL + -> ID + -> Text -- ^ cardid + -> StripeRequest a +updatePaymentMethod + prefix + id_ + cardid_ = request + where request = mkStripeRequest POST url params + url = prefix id_ + "cards" cardid_ + params = [] + +------------------------------------------------------------------------------ +-- | Update a `Customer` `PaymentMethod` +updateCustomerPaymentMethod + :: CustomerId -- ^ `CustomerId` of the card holder + -> PaymentMethodId -- ^ `PaymentMethodId` of card to update + -> StripeRequest UpdateCustomerPaymentMethod +updateCustomerPaymentMethod + customerid + (PaymentMethodId cardid) + = updatePaymentMethod "customers" (getCustomerId customerid) cardid + +data UpdateCustomerPaymentMethod +type instance StripeReturn UpdateCustomerPaymentMethod = PaymentMethod +instance StripeHasParam UpdateCustomerPaymentMethod AddressLine1 +instance StripeHasParam UpdateCustomerPaymentMethod AddressLine2 +instance StripeHasParam UpdateCustomerPaymentMethod AddressCity +instance StripeHasParam UpdateCustomerPaymentMethod AddressZip +instance StripeHasParam UpdateCustomerPaymentMethod AddressState +instance StripeHasParam UpdateCustomerPaymentMethod AddressCountry +instance StripeHasParam UpdateCustomerPaymentMethod ExpMonth +instance StripeHasParam UpdateCustomerPaymentMethod ExpYear +instance StripeHasParam UpdateCustomerPaymentMethod Name +-} + +detachPaymentMethod + :: PaymentMethodId -- ^ `PaymentMethodId` associated with `PaymentMethod` to be deleted + -> StripeRequest DetachPaymentMethod +detachPaymentMethod + pmid = request + where request = mkStripeRequest POST url params + url = "payment_methods" getPaymentMethodId pmid "detach" + params = [] + +data DetachPaymentMethod +type instance StripeReturn DetachPaymentMethod = PaymentMethod +{- +------------------------------------------------------------------------------ +-- | INTERNAL: Generalized retrieve all cards for `ID` +getPaymentMethods + :: URL + -> ID + -> StripeRequest a +getPaymentMethods + prefix + id_ + = request + where request = mkStripeRequest GET url params + url = prefix id_ "cards" + params = [] + +------------------------------------------------------------------------------ +-- | Retrieve all cards associated with a `Customer` +getCustomerPaymentMethods + :: CustomerId -- ^ The `CustomerId` associated with the cards + -> StripeRequest GetCustomerPaymentMethods +getCustomerPaymentMethods + customerid + = getPaymentMethods "customers" (getCustomerId customerid) + +data GetCustomerPaymentMethods +type instance StripeReturn GetCustomerPaymentMethods = (StripeList PaymentMethod) +instance StripeHasParam GetCustomerPaymentMethods ExpandParams +instance StripeHasParam GetCustomerPaymentMethods (EndingBefore PaymentMethodId) +instance StripeHasParam GetCustomerPaymentMethods Limit +instance StripeHasParam GetCustomerPaymentMethods (StartingAfter PaymentMethodId) +-} \ No newline at end of file diff --git a/stripe-core/src/Web/Stripe/StripeRequest.hs b/stripe-core/src/Web/Stripe/StripeRequest.hs index f9ed6f6..30e598b 100644 --- a/stripe-core/src/Web/Stripe/StripeRequest.hs +++ b/stripe-core/src/Web/Stripe/StripeRequest.hs @@ -44,7 +44,7 @@ import Web.Stripe.Types (AccountBalance(..), AccountNumber(..), ApplicationFeePercent(..), AtPeriodEnd(..), AvailableOn(..), BankAccountId(..), - CardId(..), CardNumber(..), + CardId(..), CardNumber(..), CardToken(..), Capture(..), ChargeId(..), Closed(..), CouponId(..), Country(..), Created(..), Currency(..), @@ -431,6 +431,11 @@ instance ToStripeParam a => ToStripeParam (TimeRange a) where [(k,v)] -> ((k <> "[" <> n <> "]", v) :) lst' -> error $ "toRecord in ToStripeRange (TimeRange a) expected exactly one element in this list. " ++ show lst' + +instance ToStripeParam CardToken where + toStripeParam (CardToken (TokenId tid)) = + (("card[token]", Text.encodeUtf8 tid) :) + instance ToStripeParam TokenId where toStripeParam (TokenId tid) = (("card", Text.encodeUtf8 tid) :) diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index 1aafdec..3019b34 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -366,13 +366,21 @@ data Brand = instance FromJSON Brand where parseJSON = \case String "American Express" -> pure AMEX + String "amex" -> pure AMEX String "Diners Club" -> pure DinersClub + String "diners" -> pure DinersClub String "Discover" -> pure Discover + String "discover" -> pure Discover String "JCB" -> pure JCB + String "jcb" -> pure JCB String "MasterCard" -> pure MasterCard + String "mastercard" -> pure MasterCard String "UnionPay" -> pure UnionPay + String "unionpay" -> pure UnionPay String "Visa" -> pure Visa + String "visa" -> pure Visa String "Unknown" -> pure Unknown + String "unknown" -> pure Unknown brand -> fail $ "Failed to parse brand: " <> show brand ------------------------------------------------------------------------------ @@ -476,7 +484,36 @@ instance FromJSON RecipientCard where <*> o .:? "address_zip_check" <*> o .:? "recipient" - +------------------------------------------------------------------------------ +-- | `Card` Hash - When embedded in a PaymentMethod +data CardHash = CardHash { + cardHashBrand :: Brand + , cardHashChecks :: Maybe TODO + , cardHashCountry :: Maybe Text + , cardHashExpMonth :: ExpMonth + , cardHashExpYear :: ExpYear + , cardHashFingerprint :: Maybe Text + , cardHashFunding :: Text + , cardHashGeneratedFrom :: Maybe TODO + , cardHashLastFour :: Text + , cardHashNetworks :: Maybe TODO + , cardHash3DSUsage :: Maybe TODO + } deriving (Read, Show, Eq, Ord, Data, Typeable) +------------------------------------------------------------------------------ +-- | JSON Instance for `Card` +instance FromJSON CardHash where + parseJSON = withObject "CardHash" $ \o -> + CardHash <$> o .: "brand" + <*> o .:? "checks" + <*> o .:? "country" + <*> (ExpMonth <$> o .: "exp_month") + <*> (ExpYear <$> o .: "exp_year") + <*> o .:? "fingerprint" + <*> o .: "funding" + <*> o .:? "generated_from" + <*>o .: "last4" + <*> o .:? "networks" + <*> o .:? "three_d_secure_usage" ------------------------------------------------------------------------------ -- | `NewCard` contains the data needed to create a new `Card` data NewCard = NewCard @@ -2252,14 +2289,14 @@ instance FromJSON IntentStatus where "succeeded" -> pure IntentStatusSucceeded _ -> fail $ "Unknown IntentStatus: " <> T.unpack t -newtype PaymentMethodId = - PaymentMethodId Text deriving (Read, Show, Eq, Ord, Data, Typeable) +newtype PaymentMethodId = PaymentMethodId { getPaymentMethodId :: Text } + deriving (Read, Show, Eq, Ord, Data, Typeable) data PaymentMethod = PaymentMethod { paymentMethodId :: PaymentMethodId , paymentMethodBillingDetails :: TODO - , paymentMethodCard :: Maybe TODO + , paymentMethodCard :: Maybe CardHash , paymentMethodCardPresent :: Maybe TODO , paymentMethodCreated :: UTCTime , paymentMethodCustomer :: Maybe (Expandable CustomerId) @@ -2282,18 +2319,31 @@ data PaymentMethodType instance FromJSON PaymentMethodType where parseJSON = withText "PaymentMethodType" $ \t -> case t of - "PaymentMethodTypeCard" -> pure PaymentMethodTypeCard - "PaymentMethodTypeCardPresent" -> pure PaymentMethodTypeCardPresent - "PaymentMethodTypeIdeal" -> pure PaymentMethodTypeIdeal - "PaymentMethodTypeFPX" -> pure PaymentMethodTypeFPX - "PaymentMethodTypeBacsDebit" -> pure PaymentMethodTypeBacsDebit - "PaymentMethodTypeBancontact" -> pure PaymentMethodTypeBancontact - "PaymentMethodTypeGiropay" -> pure PaymentMethodTypeGiropay - "PaymentMethodTypeP24" -> pure PaymentMethodTypeP24 - "PaymentMethodTypeSepaDebit" -> pure PaymentMethodTypeSepaDebit + "card" -> pure PaymentMethodTypeCard + "ideal" -> pure PaymentMethodTypeIdeal + "fpx" -> pure PaymentMethodTypeFPX + "bacs_debit" -> pure PaymentMethodTypeBacsDebit + "bancontact" -> pure PaymentMethodTypeBancontact + "giropay" -> pure PaymentMethodTypeGiropay + "p24" -> pure PaymentMethodTypeP24 + "sepa_debit" -> pure PaymentMethodTypeSepaDebit _ -> fail $ "Unknown PaymentMethodType: " <> T.unpack t +------------------------------------------------------------------------------ +-- | JSON Instance for `PaymentMethod` +instance FromJSON PaymentMethod where + parseJSON = withObject "PaymentMethod" $ \o -> + PaymentMethod + <$> (PaymentMethodId <$> o .: "id") + <*> o .: "billing_details" + <*> o .:? "card" + <*> o .:? "card_present" + <*> (fromSeconds <$> o .: "created") + <*> o .:? "customer" + <*> o .: "livemode" + <*> o .: "type" + ------------------------------------------------------------------------------ -- | Connect Application data ConnectApp = ConnectApp { @@ -2310,6 +2360,11 @@ instance FromJSON ConnectApp where <*> o .: "object" <*> o .: "name" +------------------------------------------------------------------------------ +-- | Wrapper for `TokenId` `PaymentMethod` param +newtype CardToken = CardToken TokenId + deriving (Read, Show, Eq, Ord, Data, Typeable) + ------------------------------------------------------------------------------ -- | `TokenId` of a `Token` newtype TokenId = diff --git a/stripe-core/stripe-core.cabal b/stripe-core/stripe-core.cabal index 3118efd..1868a46 100644 --- a/stripe-core/stripe-core.cabal +++ b/stripe-core/stripe-core.cabal @@ -48,6 +48,7 @@ library Web.Stripe.Invoice Web.Stripe.InvoiceItem Web.Stripe.PaymentIntent + Web.Stripe.PaymentMethod Web.Stripe.Plan Web.Stripe.Recipient Web.Stripe.Refund diff --git a/stripe-tests/stripe-tests.cabal b/stripe-tests/stripe-tests.cabal index f46c424..1f3e771 100644 --- a/stripe-tests/stripe-tests.cabal +++ b/stripe-tests/stripe-tests.cabal @@ -53,6 +53,7 @@ library Web.Stripe.Test.Invoice Web.Stripe.Test.InvoiceItem Web.Stripe.Test.PaymentIntent + Web.Stripe.Test.PaymentMethod Web.Stripe.Test.Plan Web.Stripe.Test.Prelude Web.Stripe.Test.Recipient diff --git a/stripe-tests/tests/Web/Stripe/Test/AllTests.hs b/stripe-tests/tests/Web/Stripe/Test/AllTests.hs index 61bfd26..3d9a12b 100644 --- a/stripe-tests/tests/Web/Stripe/Test/AllTests.hs +++ b/stripe-tests/tests/Web/Stripe/Test/AllTests.hs @@ -19,6 +19,7 @@ import Web.Stripe.Test.Dispute (disputeTests) import Web.Stripe.Test.Invoice (invoiceTests) import Web.Stripe.Test.InvoiceItem (invoiceItemTests) import Web.Stripe.Test.PaymentIntent (paymentIntentTests) +import Web.Stripe.Test.PaymentMethod (paymentMethodTests) import Web.Stripe.Test.Plan (planTests) import Web.Stripe.Test.Recipient (recipientTests) import Web.Stripe.Test.SetupIntent (setupIntentTests) @@ -58,5 +59,6 @@ allTests stripe' = do eventTests stripe paymentIntentTests stripe setupIntentTests stripe + paymentMethodTests stripe diff --git a/stripe-tests/tests/Web/Stripe/Test/PaymentMethod.hs b/stripe-tests/tests/Web/Stripe/Test/PaymentMethod.hs new file mode 100644 index 0000000..c3d7d4a --- /dev/null +++ b/stripe-tests/tests/Web/Stripe/Test/PaymentMethod.hs @@ -0,0 +1,133 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RebindableSyntax #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RankNTypes #-} +module Web.Stripe.Test.PaymentMethod where + +import Data.Either +import Data.Maybe +import Test.Hspec +import Web.Stripe.Card +import Web.Stripe.PaymentMethod +import Web.Stripe.Customer +import Web.Stripe.StripeRequest (Expandable (Id)) +import Web.Stripe.Test.Prelude +import Web.Stripe.Token + +paymentMethodTests :: StripeSpec +paymentMethodTests stripe = do + describe "Card tests" $ do + it "can create a payment method by CardNumber" $ do + result <- stripe $ do + pm <- createPaymentMethod cardinfo + return pm + result `shouldSatisfy` isRight + + it "can create a payment method by TokenId" $ do + result <- stripe $ do + Token { tokenId = tkid } <- createCardToken (Just cardinfo) + pm <- createPaymentMethodByToken tkid (PaymentMethodTypeCard) + return pm + result `shouldSatisfy` isRight + + it "can attach a card to a customer" $ do + result <- stripe $ do + Customer { customerId = cid } <- createCustomer + pm <- createPaymentMethod cardinfo + pm' <- attachPaymentMethod (paymentMethodId pm) cid + void $ deleteCustomer cid + return pm' + result `shouldSatisfy` isRight + + it "Can retrieve a payment method" $ do + result <- stripe $ do + PaymentMethod { paymentMethodId = pmid }<- createPaymentMethod cardinfo + pm <- getPaymentMethod pmid + return pm + result `shouldSatisfy` isRight + let Right pm = result + cardHashLastFour <$> paymentMethodCard pm `shouldBe` Just "4242" + cardHashExpMonth <$> paymentMethodCard pm `shouldBe` Just em + cardHashExpYear <$> paymentMethodCard pm `shouldBe` Just ey + + it "Can retrieve a Customer's Cards" $ do + result <- stripe $ do + Customer { customerId = customerid + } <- createCustomer + pm <- createPaymentMethod cardinfo + pm' <- attachPaymentMethod (paymentMethodId pm) customerid + pms <- getCustomerPaymentMethods customerid + void $ deleteCustomer customerid + return pms + result `shouldSatisfy` isRight + +{- + it "Can retrieve a Customer's Card with expansion" $ do + result <- stripe $ do + Customer { customerId = customerid + , customerCards = StripeList { list = [ Card { cardId = cardid } ] } + } <- createCustomer -&- cardinfo + card <- getCustomerCard customerid cardid -&- ExpandParams ["customer"] + void $ deleteCustomer customerid + return card + result `shouldSatisfy` isRight + let Right Card{..} = result + cardLastFour `shouldBe` "4242" + cardExpMonth `shouldBe` em + cardExpYear `shouldBe` ey +-} + + it "Can detach a Customer's Cards" $ do + result <- stripe $ do + Customer { customerId = customerid } <- createCustomer + PaymentMethod { paymentMethodId = pmid }<- createPaymentMethod cardinfo + pm <- attachPaymentMethod pmid customerid + result <- detachPaymentMethod pmid + void $ deleteCustomer customerid + return result + result `shouldSatisfy` isRight +{- + it "Can update a Customer's Card" $ do + result <- stripe $ do + Customer { customerId = customerid + , customerDefaultCard = Just (Id cardid) + } <- createCustomer -&- cardinfo + result <- updateCustomerCard customerid cardid + -&- cardname + -&- cardcity + -&- cardcountry + -&- cardaddressOne + -&- cardaddressTwo + -&- cardaddressState + -&- cardzip + void $ deleteCustomer customerid + return result + result `shouldSatisfy` isRight + let Right Card{..} = result + cardName `shouldBe` (Just cardname) + cardAddressCity `shouldBe` (Just cardcity) + cardAddressCountry `shouldBe` (Just cardcountry) + cardAddressLine1 `shouldBe` (Just cardaddressOne) + cardAddressLine2 `shouldBe` (Just cardaddressTwo) + cardAddressState `shouldBe` (Just cardaddressState) + cardAddressZip `shouldBe` (Just cardzip) -} + + where + cardinfo = (mkNewCard credit em ey) { newCardCVC = Just cvc } + debitinfo = (mkNewCard debit em ey) { newCardCVC = Just cvc } + credit = CardNumber "4242424242424242" + debit = CardNumber "4000056655665556" + em = ExpMonth 12 + ey = ExpYear 2023 + cvc = CVC "123" + country = Country "US" + routingnumber = RoutingNumber "110000000" + accountnumber = AccountNumber "000123456789" + name = Name "David Johnson" + cardname = Name "cardName" + cardcity = AddressCity "Chicago" + cardcountry = AddressCountry "US" + cardaddressOne = AddressLine1 "123 Fake Street" + cardaddressTwo = AddressLine2 "456 Fake Street" + cardaddressState = AddressState "IL" + cardzip = AddressZip "60610" diff --git a/stripe-tests/tests/Web/Stripe/Test/Prelude.hs b/stripe-tests/tests/Web/Stripe/Test/Prelude.hs index 0c74001..d71f83e 100644 --- a/stripe-tests/tests/Web/Stripe/Test/Prelude.hs +++ b/stripe-tests/tests/Web/Stripe/Test/Prelude.hs @@ -10,6 +10,7 @@ {-# LANGUAGE RankNTypes #-} module Web.Stripe.Test.Prelude ( ($) + , (<$>) , (-&-) , Char , Functor @@ -36,6 +37,7 @@ module Web.Stripe.Test.Prelude , Stripe , StripeRequestF(..) , StripeSpec + , Conf ) where import Data.Aeson (Value, Result(..), FromJSON, fromJSON) @@ -43,7 +45,7 @@ import Data.Either (Either) import Data.String (fromString) import Data.Maybe (Maybe(..)) import GHC.Num (fromInteger) -import Prelude (Bool(..), Eq(..), Functor(..), ($), IO, Char, String, error, undefined, (.), id, length) +import Prelude (Bool(..), Eq(..), Functor(..), ($), (<$>), IO, Char, String, error, undefined, (.), id, length) import Test.Hspec import Test.Hspec.Core.Spec (SpecM) import qualified Control.Monad as M @@ -52,6 +54,9 @@ import qualified Control.Monad.Trans as M import Control.Monad.Trans.Free (FreeT(..), liftF) import Web.Stripe.Client + +type Conf = forall a. StripeConfig -> Stripe a -> IO (Either StripeError a) + ------------------------------------------------------------------------------ -- Stripe free monad From 536840fb12181f722aaaf55ec930f6a8513a9f59 Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Thu, 14 Jan 2021 16:02:29 -0500 Subject: [PATCH 32/44] Add OffSession and Confirm params --- stripe-core/src/Web/Stripe/PaymentIntent.hs | 12 +++++-- stripe-core/src/Web/Stripe/StripeRequest.hs | 36 +++++++++++++++---- stripe-core/src/Web/Stripe/Types.hs | 16 ++++++--- stripe-core/src/Web/Stripe/Util.hs | 7 ++++ .../tests/Web/Stripe/Test/PaymentIntent.hs | 30 ++++++++++++++-- .../tests/Web/Stripe/Test/SetupIntent.hs | 21 ++++++++++- 6 files changed, 107 insertions(+), 15 deletions(-) diff --git a/stripe-core/src/Web/Stripe/PaymentIntent.hs b/stripe-core/src/Web/Stripe/PaymentIntent.hs index d6f044a..3f91596 100644 --- a/stripe-core/src/Web/Stripe/PaymentIntent.hs +++ b/stripe-core/src/Web/Stripe/PaymentIntent.hs @@ -35,6 +35,8 @@ module Web.Stripe.PaymentIntent , Description (..) , EndingBefore (..) , ExpandParams (..) + , Confirm (..) + , OffSession (..) , PaymentIntent (..) , PaymentIntentId (..) , PaymentMethodId (..) @@ -50,10 +52,11 @@ import Web.Stripe.StripeRequest (Method (GET, POST), StripeHasParam, StripeReturn, StripeRequest (..), toStripeParam, mkStripeRequest) import Web.Stripe.Util (()) -import Web.Stripe.Types (Amount(..), Charge (..), CardId (..), ChargeId (..), Currency(..), CustomerId(..), +import Web.Stripe.Types (Amount(..), Charge (..), CardId (..), ChargeId (..), + Confirm(..), Currency(..), CustomerId(..), Description(..), EndingBefore(..), Limit(..), MetaData(..), PaymentIntent (..), PaymentMethodId (..), PaymentMethodTypes(..), PaymentMethodType(..), - PaymentIntentId (..), ReceiptEmail(..), + PaymentIntentId (..), OffSession(..), ReceiptEmail(..), PaymentIntentUsage(..), Usage (..), StartingAfter(..), ExpandParams(..), StripeList (..), Token (..)) @@ -79,6 +82,10 @@ instance StripeHasParam CreatePaymentIntent Description instance StripeHasParam CreatePaymentIntent ReceiptEmail instance StripeHasParam CreatePaymentIntent PaymentMethodTypes instance StripeHasParam CreatePaymentIntent PaymentIntentUsage +instance StripeHasParam CreatePaymentIntent PaymentMethodId +instance StripeHasParam CreatePaymentIntent Confirm +instance StripeHasParam CreatePaymentIntent MetaData +instance StripeHasParam CreatePaymentIntent OffSession ------------------------------------------------------------------------------ -- | Retrieve a `PaymentIntent` by `ChargeId` and `PaymentIntentId` @@ -133,6 +140,7 @@ confirmPaymentIntent data ConfirmPaymentIntent type instance StripeReturn ConfirmPaymentIntent = PaymentIntent instance StripeHasParam ConfirmPaymentIntent MetaData +instance StripeHasParam ConfirmPaymentIntent OffSession instance StripeHasParam ConfirmPaymentIntent PaymentMethodId capturePaymentIntent diff --git a/stripe-core/src/Web/Stripe/StripeRequest.hs b/stripe-core/src/Web/Stripe/StripeRequest.hs index 30e598b..9e7fe59 100644 --- a/stripe-core/src/Web/Stripe/StripeRequest.hs +++ b/stripe-core/src/Web/Stripe/StripeRequest.hs @@ -46,7 +46,7 @@ import Web.Stripe.Types (AccountBalance(..), AccountNumber(..), AvailableOn(..), BankAccountId(..), CardId(..), CardNumber(..), CardToken(..), Capture(..), ChargeId(..), Closed(..), - CouponId(..), + CouponId(..), Confirm(..), Country(..), Created(..), Currency(..), CustomerId(..), CustomerEmail(..), ClientReferenceId(..), CVC(..), Date(..), DefaultCard(..), Description(..), @@ -62,6 +62,7 @@ import Web.Stripe.Types (AccountBalance(..), AccountNumber(..), PlanName(..), Prorate(..), Limit(..), MaxRedemptions(..), Name(..), NewBankAccount(..), NewCard(..), + OffSession(..), PercentOff(..), Quantity(..), ReceiptEmail(..), RecipientId(..), RecipientType(..), RedeemBy(..), RefundId(..), @@ -74,7 +75,7 @@ import Web.Stripe.Types (AccountBalance(..), AccountNumber(..), TransactionType(..), TransferId(..), TransferStatus(..), TrialEnd(..), SuccessUrl(..), CancelUrl(..), LineItems(..), LineItem(..), TrialPeriodDays(..), eventTypeText) -import Web.Stripe.Util (toBytestring, toExpandable,toMetaData, encodeList, +import Web.Stripe.Util (toBytestring, toBytestringLower, toExpandable,toMetaData, encodeList, toSeconds, getParams, toText) ------------------------------------------------------------------------------ @@ -335,17 +336,21 @@ instance ToStripeParam PaymentIntentId where (("payment_intent", Text.encodeUtf8 rid) :) instance ToStripeParam PaymentIntentUsage where - toStripeParam (PaymentIntentUsage OffSession) = + toStripeParam (PaymentIntentUsage UseOffSession) = (("setup_future_usage", "off_session") :) - toStripeParam (PaymentIntentUsage OnSession) = + toStripeParam (PaymentIntentUsage UseOnSession) = (("setup_future_usage", "on_session") :) instance ToStripeParam SetupIntentUsage where - toStripeParam (SetupIntentUsage OffSession) = + toStripeParam (SetupIntentUsage UseOffSession) = (("usage", "off_session") :) - toStripeParam (SetupIntentUsage OnSession) = + toStripeParam (SetupIntentUsage UseOnSession) = (("usage", "on_session") :) +instance ToStripeParam OffSession where + toStripeParam (OffSession offSession) = + (("off_session", toBytestringLower offSession) :) + instance ToStripeParam (Param Text Text) where toStripeParam (Param (k,v)) = ((Text.encodeUtf8 k, Text.encodeUtf8 v) :) @@ -476,6 +481,22 @@ instance ToStripeParam PaymentMethodId where toStripeParam (PaymentMethodId pid) = (("payment_method", Text.encodeUtf8 pid) :) +instance ToStripeParam PaymentMethodType where + toStripeParam pmt = + let typ = case pmt of + PaymentMethodTypeCard -> "card" + PaymentMethodTypeCardPresent -> "card_present" + PaymentMethodTypeIdeal -> "ideal" + PaymentMethodTypeFPX -> "fpx" + PaymentMethodTypeBacsDebit -> "bacs_debit" + PaymentMethodTypeBancontact -> "bancontact" + PaymentMethodTypeGiropay -> "giropay" + PaymentMethodTypeP24 -> "p24" + PaymentMethodTypeEPS -> "eps" + PaymentMethodTypeSepaDebit -> "sepa_debit" + in (("type", Text.encodeUtf8 typ) :) + + instance ToStripeParam PaymentMethodTypes where toStripeParam (PaymentMethodTypes pmts) = let t pmt = case pmt of @@ -541,6 +562,9 @@ instance ToStripeParam TransactionType where TransferCancelTxn -> "transfer_cancel" TransferFailureTxn -> "transfer_failure") :) +instance ToStripeParam Confirm where + toStripeParam (Confirm conf) = + (("confirm", toBytestringLower conf) :) instance (ToStripeParam param) => ToStripeParam (StartingAfter param) where toStripeParam (StartingAfter param) = diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index 3019b34..9ad9e45 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -146,7 +146,7 @@ data Charge = Charge { , chargeBalanceTransaction :: Maybe (Expandable TransactionId) , chargeFailureMessage :: Maybe Text , chargeFailureCode :: Maybe Text - , chargeAmountRefunded :: Int + , chargeAmountRefunded :: Int -- Is this a mistake? Not an Amount? , chargeCustomerId :: Maybe (Expandable CustomerId) , chargeInvoice :: Maybe (Expandable InvoiceId) , chargeDescription :: Maybe Description @@ -2142,16 +2142,24 @@ newtype SetupIntentUsage = SetupIntentUsage Usage deriving (Read, Show, Eq, Ord, Data, Typeable) -data Usage = OnSession | OffSession +data Usage = UseOnSession | UseOffSession deriving (Read, Show, Eq, Ord, Data, Typeable) instance FromJSON Usage where parseJSON = withText "Usage" $ \t -> case t of - "on_session" -> pure OnSession - "off_session" -> pure OffSession + "on_session" -> pure UseOnSession + "off_session" -> pure UseOffSession _ -> fail $ "unknown Usage: " <> T.unpack t +newtype OffSession = OffSession Bool + deriving (Read, Show, Eq, Ord, Data, Typeable) + + +newtype Confirm = Confirm Bool + deriving (Read, Show, Eq, Ord, Data, Typeable) + + ------------------------------------------------------------------------------ -- | `SetupIntentId` for `SetupIntent` newtype SetupIntentId = diff --git a/stripe-core/src/Web/Stripe/Util.hs b/stripe-core/src/Web/Stripe/Util.hs index 5852931..0e3bb6f 100644 --- a/stripe-core/src/Web/Stripe/Util.hs +++ b/stripe-core/src/Web/Stripe/Util.hs @@ -14,6 +14,7 @@ module Web.Stripe.Util , toTextLower , getParams , toBytestring + , toBytestringLower , encodeList , () , toMetaData @@ -23,6 +24,7 @@ module Web.Stripe.Util import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B8 import Data.Monoid (Monoid, mconcat, mempty, (<>)) +import qualified Data.Char as Char import Data.String (IsString) import Data.Text (Text) import qualified Data.Text as T @@ -93,6 +95,11 @@ getParams xs = [ (x, T.encodeUtf8 y) | (x, Just y) <- xs ] toBytestring :: Show a => a -> ByteString toBytestring = B8.pack . show +------------------------------------------------------------------------------ +-- | Convert APITVersion to a ByteString - for, e.g., Boolean -> "true" or "false" +toBytestringLower :: Show a => a -> ByteString +toBytestringLower = B8.pack . map Char.toLower . show + ------------------------------------------------------------------------------ -- | EncodeList encodeList :: Text -> [a] -> (a -> [(ByteString, ByteString)]) -> [(ByteString, ByteString)] diff --git a/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs b/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs index 90c396e..ceb496a 100644 --- a/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs +++ b/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs @@ -10,6 +10,7 @@ import Web.Stripe.Test.Prelude import Web.Stripe.PaymentIntent import Web.Stripe.Card +import Web.Stripe.PaymentMethod import Web.Stripe.Customer import Web.Stripe.Token @@ -18,10 +19,35 @@ paymentIntentTests stripe = do describe "Payment intent tests" $ do it "Succesfully creates a PaymentIntent" $ do result <- stripe $ do - paymentIntent <- createPaymentIntent (Amount 100) USD -&- (PaymentIntentUsage OffSession) + paymentIntent <- createPaymentIntent (Amount 100) USD -&- (PaymentIntentUsage UseOffSession) void $ cancelPaymentIntent (paymentIntentId paymentIntent) return paymentIntent result `shouldSatisfy` isRight + it "Succesfully creates a PaymentIntent and immediately confirms" $ do + result <- stripe $ do + PaymentMethod { paymentMethodId = pmid } <- createPaymentMethod cardinfo + paymentIntent <- createPaymentIntent (Amount 100) USD + -&- Confirm True + -&- pmid + return paymentIntent + result `shouldSatisfy` isRight + it "Succesfully creates a second PaymentIntent and confirms off-session" $ do + result <- stripe $ do + Customer { customerId = cid } <- createCustomer + PaymentMethod { paymentMethodId = pmid } <- createPaymentMethod cardinfo + paymentIntent <- createPaymentIntent (Amount 100) USD + -&- pmid + -&- cid + -&- PaymentIntentUsage UseOffSession + void $ confirmPaymentIntent (paymentIntentId paymentIntent) + newPaymentIntent <- createPaymentIntent (Amount 100) USD + -&- pmid + -&- cid + newConfirmedPaymentIntent <- + confirmPaymentIntent (paymentIntentId newPaymentIntent) + -&- OffSession True + return newConfirmedPaymentIntent + result `shouldSatisfy` isRight it "Successfully updates a PaymentIntent" $ do result <- stripe $ do paymentIntent <- createPaymentIntent (Amount 100) USD @@ -31,7 +57,7 @@ paymentIntentTests stripe = do -&- (Amount 100) -&- USD -&- cid -&- Description "some description" - -&- (PaymentIntentUsage OffSession) + -&- (PaymentIntentUsage UseOffSession) void $ cancelPaymentIntent (paymentIntentId paymentIntent) void $ deleteCustomer cid return updatedPaymentIntent diff --git a/stripe-tests/tests/Web/Stripe/Test/SetupIntent.hs b/stripe-tests/tests/Web/Stripe/Test/SetupIntent.hs index e90b72b..5cf2efe 100644 --- a/stripe-tests/tests/Web/Stripe/Test/SetupIntent.hs +++ b/stripe-tests/tests/Web/Stripe/Test/SetupIntent.hs @@ -9,6 +9,7 @@ import Web.Stripe.Test.Util (makePlanId) import Web.Stripe.Test.Prelude import Web.Stripe.SetupIntent +import Web.Stripe.PaymentIntent import Web.Stripe.Card import Web.Stripe.Customer import Web.Stripe.Token @@ -18,7 +19,7 @@ setupIntentTests stripe = do describe "Setup intent tests" $ do it "Succesfully creates a SetupIntent" $ do result <- stripe $ do - setupIntent <- createSetupIntent -&- (SetupIntentUsage OffSession) + setupIntent <- createSetupIntent -&- (SetupIntentUsage UseOffSession) void $ cancelSetupIntent (setupIntentId setupIntent) return setupIntent result `shouldSatisfy` isRight @@ -61,6 +62,24 @@ setupIntentTests stripe = do void $ deleteCustomer cid return confirmedSetupIntent result `shouldSatisfy` isRight + it "Successfully confirms a SetupIntent and charges off-session"$ do + result <- stripe $ do + Customer { customerId = cid } <- createCustomer + setupIntent <- createSetupIntent -&- cid + -&- SetupIntentUsage UseOffSession + Token { tokenId = tkid } <- createCardToken (Just cardinfo) + Card { cardId = CardId cardid } <- createCustomerCardByToken cid tkid + confirmedSetupIntent <- + confirmSetupIntent (setupIntentId setupIntent) + -&- PaymentMethodId cardid + paymentIntent <- createPaymentIntent (Amount 100) USD + -&- PaymentMethodId cardid + -&- OffSession True + -&- cid + -&- Confirm True + void $ deleteCustomer cid + return paymentIntent + result `shouldSatisfy` isRight {- need to do a separate authorization and capture to test this https://stripe.com/docs/payments/capture-later it "Successfully captures a SetupIntent"$ do From fb83adcb6a860f35c0fd4f0d26a9aab6d78981e1 Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Wed, 10 Feb 2021 10:35:32 -0500 Subject: [PATCH 33/44] Update version --- stripe-core/stripe-core.cabal | 2 +- stripe-haskell/stripe-haskell.cabal | 2 +- stripe-http-client/stripe-http-client.cabal | 2 +- stripe-http-streams/stripe-http-streams.cabal | 2 +- stripe-tests/stripe-tests.cabal | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/stripe-core/stripe-core.cabal b/stripe-core/stripe-core.cabal index 1868a46..e244ad6 100644 --- a/stripe-core/stripe-core.cabal +++ b/stripe-core/stripe-core.cabal @@ -1,5 +1,5 @@ name: stripe-core -version: 2.6.2 +version: 2.7.0 synopsis: Stripe API for Haskell - Pure Core license: MIT license-file: LICENSE diff --git a/stripe-haskell/stripe-haskell.cabal b/stripe-haskell/stripe-haskell.cabal index a0553fc..a7501df 100644 --- a/stripe-haskell/stripe-haskell.cabal +++ b/stripe-haskell/stripe-haskell.cabal @@ -1,5 +1,5 @@ name: stripe-haskell -version: 2.6.2 +version: 2.7.0 synopsis: Stripe API for Haskell license: MIT license-file: LICENSE diff --git a/stripe-http-client/stripe-http-client.cabal b/stripe-http-client/stripe-http-client.cabal index 68f4dc1..f9fe9bd 100644 --- a/stripe-http-client/stripe-http-client.cabal +++ b/stripe-http-client/stripe-http-client.cabal @@ -1,5 +1,5 @@ name: stripe-http-client -version: 2.6.2 +version: 2.7.0 license: MIT license-file: LICENSE author: Christopher Reichert diff --git a/stripe-http-streams/stripe-http-streams.cabal b/stripe-http-streams/stripe-http-streams.cabal index 6248620..8003f73 100644 --- a/stripe-http-streams/stripe-http-streams.cabal +++ b/stripe-http-streams/stripe-http-streams.cabal @@ -1,5 +1,5 @@ name: stripe-http-streams -version: 2.5.0 +version: 2.7.0 license: MIT license-file: LICENSE author: David Johnson, Jeremy Shaw diff --git a/stripe-tests/stripe-tests.cabal b/stripe-tests/stripe-tests.cabal index 1f3e771..7798811 100644 --- a/stripe-tests/stripe-tests.cabal +++ b/stripe-tests/stripe-tests.cabal @@ -1,5 +1,5 @@ name: stripe-tests -version: 2.6.2 +version: 2.7.0 synopsis: Tests for Stripe API bindings for Haskell license: MIT license-file: LICENSE From 376969f8edc49d109062c0b7c3adf638fa2b4565 Mon Sep 17 00:00:00 2001 From: Remeike Forbes Date: Tue, 23 Nov 2021 12:29:32 -0600 Subject: [PATCH 34/44] Add statement descriptors to payment intent --- stripe-core/src/Web/Stripe/PaymentIntent.hs | 6 +++++- stripe-core/src/Web/Stripe/StripeRequest.hs | 10 +++++++++- stripe-core/src/Web/Stripe/Types.hs | 20 ++++++++++++++++++-- 3 files changed, 32 insertions(+), 4 deletions(-) diff --git a/stripe-core/src/Web/Stripe/PaymentIntent.hs b/stripe-core/src/Web/Stripe/PaymentIntent.hs index 3f91596..ba76d3f 100644 --- a/stripe-core/src/Web/Stripe/PaymentIntent.hs +++ b/stripe-core/src/Web/Stripe/PaymentIntent.hs @@ -58,7 +58,7 @@ import Web.Stripe.Types (Amount(..), Charge (..), CardId (.. MetaData(..), PaymentIntent (..), PaymentMethodId (..), PaymentMethodTypes(..), PaymentMethodType(..), PaymentIntentId (..), OffSession(..), ReceiptEmail(..), PaymentIntentUsage(..), Usage (..), StartingAfter(..), ExpandParams(..), - StripeList (..), Token (..)) + StripeList (..), Token (..), StatementDescriptor(..), StatementDescriptorSuffix(..)) ------------------------------------------------------------------------------ -- | create a `PaymentIntent` @@ -86,6 +86,8 @@ instance StripeHasParam CreatePaymentIntent PaymentMethodId instance StripeHasParam CreatePaymentIntent Confirm instance StripeHasParam CreatePaymentIntent MetaData instance StripeHasParam CreatePaymentIntent OffSession +instance StripeHasParam CreatePaymentIntent StatementDescriptor +instance StripeHasParam CreatePaymentIntent StatementDescriptorSuffix ------------------------------------------------------------------------------ -- | Retrieve a `PaymentIntent` by `ChargeId` and `PaymentIntentId` @@ -125,6 +127,8 @@ instance StripeHasParam UpdatePaymentIntent Description instance StripeHasParam UpdatePaymentIntent PaymentMethodTypes instance StripeHasParam UpdatePaymentIntent ReceiptEmail instance StripeHasParam UpdatePaymentIntent PaymentIntentUsage +instance StripeHasParam UpdatePaymentIntent StatementDescriptor +instance StripeHasParam UpdatePaymentIntent StatementDescriptorSuffix -- TODO shipping, statement descriptor, statement descriptor suffix confirmPaymentIntent diff --git a/stripe-core/src/Web/Stripe/StripeRequest.hs b/stripe-core/src/Web/Stripe/StripeRequest.hs index 9e7fe59..2c53c45 100644 --- a/stripe-core/src/Web/Stripe/StripeRequest.hs +++ b/stripe-core/src/Web/Stripe/StripeRequest.hs @@ -68,7 +68,7 @@ import Web.Stripe.Types (AccountBalance(..), AccountNumber(..), RefundId(..), RefundApplicationFee(..), RefundReason(..), RoutingNumber(..), SetupIntentId(..), SetupIntentUsage(..), Usage(..), StartingAfter(..), - StatementDescription(..), Source(..), + StatementDescription(..), StatementDescriptor(..), StatementDescriptorSuffix(..), Source(..), SubscriptionId(..), TaxID(..), TaxPercent(..), TimeRange(..), TokenId(..), TransactionId(..), @@ -549,6 +549,14 @@ instance ToStripeParam StatementDescription where toStripeParam (StatementDescription txt) = (("statement_description", Text.encodeUtf8 txt) :) +instance ToStripeParam StatementDescriptor where + toStripeParam (StatementDescriptor txt) = + (("statement_descriptor", Text.encodeUtf8 txt) :) + +instance ToStripeParam StatementDescriptorSuffix where + toStripeParam (StatementDescriptorSuffix txt) = + (("statement_descriptor_suffix", Text.encodeUtf8 txt) :) + instance ToStripeParam TransactionType where toStripeParam txn = (("type", case txn of diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index 9ad9e45..18c4065 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -129,6 +129,22 @@ newtype StatementDescription = instance FromJSON StatementDescription where parseJSON v = StatementDescription <$> parseJSON v +------------------------------------------------------------------------------ +-- | `StatementDescriptor` to be added to a `PaymentIntent` +newtype StatementDescriptor = + StatementDescriptor Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +instance FromJSON StatementDescriptor where + parseJSON v = StatementDescriptor <$> parseJSON v + +------------------------------------------------------------------------------ +-- | `StatementDescriptorSuffix` to be added to a `PaymentIntent` +newtype StatementDescriptorSuffix = + StatementDescriptorSuffix Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +instance FromJSON StatementDescriptorSuffix where + parseJSON v = StatementDescriptorSuffix <$> parseJSON v + ------------------------------------------------------------------------------ -- | `Charge` object in `Stripe` API data Charge = Charge { @@ -2086,8 +2102,8 @@ data PaymentIntent = PaymentIntent { , paymentIntentReview :: Maybe TODO , paymentIntentSetupFutureUsage :: Maybe PaymentIntentUsage , paymentIntentShipping :: Maybe TODO - , paymentIntentStatementDescriptor :: Maybe StatementDescription - , paymentIntentStatementDescriptorSuffix :: Maybe StatementDescription + , paymentIntentStatementDescriptor :: Maybe StatementDescriptor + , paymentIntentStatementDescriptorSuffix :: Maybe StatementDescriptorSuffix , paymentIntentStatus :: IntentStatus , paymentIntentTransferData :: Maybe TODO , paymentIntentTransferGroup :: Maybe Text From 3623046796eddce4af43544d4164c06857c4cf03 Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Mon, 7 Feb 2022 08:59:26 -0500 Subject: [PATCH 35/44] Add customer invoice settings fields --- stripe-core/src/Web/Stripe/Customer.hs | 5 +-- stripe-core/src/Web/Stripe/Types.hs | 43 +++++++++++++++++--------- 2 files changed, 32 insertions(+), 16 deletions(-) diff --git a/stripe-core/src/Web/Stripe/Customer.hs b/stripe-core/src/Web/Stripe/Customer.hs index 6c6c9bb..c4e1022 100644 --- a/stripe-core/src/Web/Stripe/Customer.hs +++ b/stripe-core/src/Web/Stripe/Customer.hs @@ -57,6 +57,7 @@ module Web.Stripe.Customer , ExpandParams (..) , ExpMonth (..) , ExpYear (..) + , InvoiceSettings (..) , Limit (..) , MetaData (..) , mkNewCard @@ -80,8 +81,8 @@ import Web.Stripe.Types (AccountBalance(..), CVC (..), CustomerId (..), DefaultCard(..), Description(..), Email (..), EndingBefore(..), ExpMonth (..), - ExpYear (..), Limit(..), PlanId (..), - Quantity (..), MetaData(..), + ExpYear (..), Limit(..), InvoiceSettings (..), + PlanId (..), Quantity (..), MetaData(..), mkNewCard, NewCard(..), StartingAfter(..), StripeDeleteResult (..), StripeList (..), TokenId (..), diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index 18c4065..7bc2f40 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -260,20 +260,21 @@ newtype CustomerId ------------------------------------------------------------------------------ -- | `Customer` object data Customer = Customer { - customerObject :: Text - , customerCreated :: UTCTime - , customerId :: CustomerId - , customerLiveMode :: Bool - , customerDescription :: Maybe Description - , customerEmail :: Maybe Email - , customerDelinquent :: Bool - , customerSubscriptions :: Maybe (StripeList Subscription) - , customerDiscount :: Maybe Discount - , customerAccountBalance :: Int - , customerCards :: StripeList Card - , customerCurrency :: Maybe Currency - , customerDefaultCard :: Maybe (Expandable CardId) - , customerMetaData :: MetaData + customerObject :: Text + , customerCreated :: UTCTime + , customerId :: CustomerId + , customerLiveMode :: Bool + , customerDescription :: Maybe Description + , customerEmail :: Maybe Email + , customerDelinquent :: Bool + , customerSubscriptions :: Maybe (StripeList Subscription) + , customerDiscount :: Maybe Discount + , customerAccountBalance :: Int + , customerCards :: StripeList Card + , customerCurrency :: Maybe Currency + , customerDefaultCard :: Maybe (Expandable CardId) + , customerInvoiceSettings :: InvoiceSettings + , customerMetaData :: MetaData } | DeletedCustomer { deletedCustomer :: Bool , deletedCustomerId :: CustomerId @@ -300,6 +301,7 @@ instance FromJSON Customer where <*> o .: "sources" <*> o .:? "currency" <*> o .:? "default_source" + <*> o .: "invoice_settings" <*> o .: "metadata") ------------------------------------------------------------------------------ @@ -312,6 +314,16 @@ newtype AccountBalance = AccountBalance Int newtype CardId = CardId Text deriving (Eq, Ord, Read, Show, Data, Typeable, FromJSON) +------------------------------------------------------------------------------ +-- | InvoiceSettings for a `Customer` +data InvoiceSettings = InvoiceSettings { + invoiceSettingsDefaultPaymentMethod :: Maybe (Expandable PaymentMethodId) + } deriving (Read, Show, Eq, Ord, Data, Typeable) + +instance FromJSON InvoiceSettings where + parseJSON = withObject "InvoiceSettings" $ \o -> + InvoiceSettings <$> o .:? "default_payment_method" + ------------------------------------------------------------------------------ -- | CardId for a `Recipient` newtype RecipientCardId = RecipientCardId Text @@ -2316,6 +2328,9 @@ instance FromJSON IntentStatus where newtype PaymentMethodId = PaymentMethodId { getPaymentMethodId :: Text } deriving (Read, Show, Eq, Ord, Data, Typeable) +instance FromJSON PaymentMethodId where + parseJSON = withText "PaymentMethodId" $ \t -> + return $ PaymentMethodId t data PaymentMethod = PaymentMethod { paymentMethodId :: PaymentMethodId From f0a137990fe838ff4680b7fff242a561cee8fcbf Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Mon, 30 Oct 2023 15:45:57 -0400 Subject: [PATCH 36/44] Add Source as param to createCharge --- stack.yaml | 10 ++--- stack.yaml.lock | 17 ++++++--- stripe-core/src/Web/Stripe/Charge.hs | 6 ++- stripe-tests/stripe-tests.cabal | 2 +- stripe-tests/tests/Web/Stripe/Test/Charge.hs | 40 ++++++++++++++++++++ 5 files changed, 60 insertions(+), 15 deletions(-) diff --git a/stack.yaml b/stack.yaml index b65c479..762ac14 100644 --- a/stack.yaml +++ b/stack.yaml @@ -17,7 +17,7 @@ # # resolver: ./custom-snapshot.yaml # resolver: https://example.com/snapshots/2018-01-01.yaml -resolver: nightly-2020-09-02 +resolver: lts-18.19 # User packages to be built. # Various formats can be used as shown in the example below. @@ -37,12 +37,8 @@ packages: # These entries can reference officially published versions as well as # forks / in-progress versions pinned to a git hash. For example: # -# extra-deps: -# - acme-missiles-0.3 -# - git: https://github.com/commercialhaskell/stack.git -# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a -# -# extra-deps: [] +extra-deps: + - random-1.2.1.1@sha256:dea1f11e5569332dc6c8efaad1cb301016a5587b6754943a49f9de08ae0e56d9 # Override default flag values for local packages and extra-deps # flags: {} diff --git a/stack.yaml.lock b/stack.yaml.lock index 30d1e2e..478ded1 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -3,10 +3,17 @@ # For more information, please see the documentation at: # https://docs.haskellstack.org/en/stable/lock_files -packages: [] +packages: +- completed: + hackage: random-1.2.1.1@sha256:dea1f11e5569332dc6c8efaad1cb301016a5587b6754943a49f9de08ae0e56d9,6541 + pantry-tree: + sha256: 646ee77fe01178837ee928b61ae8653dcf190e9b5353ebebd094079c77a18b76 + size: 1528 + original: + hackage: random-1.2.1.1@sha256:dea1f11e5569332dc6c8efaad1cb301016a5587b6754943a49f9de08ae0e56d9 snapshots: - completed: - size: 527775 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2020/9/2.yaml - sha256: 92ec78ae38830f06ec9307c5ce346ae93982fab6179eb10dec9d57d5069c7f14 - original: nightly-2020-09-02 + sha256: 32716534fff554b7f90762130fdb985cabf29f157758934dd1c8f3892a646430 + size: 586103 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/19.yaml + original: lts-18.19 diff --git a/stripe-core/src/Web/Stripe/Charge.hs b/stripe-core/src/Web/Stripe/Charge.hs index 483a5fe..bb45c50 100644 --- a/stripe-core/src/Web/Stripe/Charge.hs +++ b/stripe-core/src/Web/Stripe/Charge.hs @@ -75,6 +75,7 @@ module Web.Stripe.Charge , MetaData (..) , NewCard (..) , ReceiptEmail (..) + , Source (..) , StartingAfter (..) , StatementDescription (..) , StripeList (..) @@ -95,11 +96,11 @@ import Web.Stripe.Types (Amount(..), ApplicationFeeAmount(.. CustomerId (..), Description(..), EndingBefore(..), ExpMonth (..), ExpYear (..), Limit(..), MetaData(..), - NewCard(..), Email (..), + NewCard(..), Email (..), PaymentMethodId(..), StartingAfter(..), ReceiptEmail(..), StatementDescription(..), - ExpandParams(..), + ExpandParams(..), Source(..), StripeList (..), TokenId (..)) import Web.Stripe.Types.Util (getChargeId) @@ -124,6 +125,7 @@ instance StripeHasParam CreateCharge ExpandParams instance StripeHasParam CreateCharge CustomerId instance StripeHasParam CreateCharge NewCard instance StripeHasParam CreateCharge TokenId +instance StripeHasParam CreateCharge (Source PaymentMethodId) instance StripeHasParam CreateCharge Description instance StripeHasParam CreateCharge MetaData instance StripeHasParam CreateCharge Capture diff --git a/stripe-tests/stripe-tests.cabal b/stripe-tests/stripe-tests.cabal index 7798811..f3430f9 100644 --- a/stripe-tests/stripe-tests.cabal +++ b/stripe-tests/stripe-tests.cabal @@ -27,7 +27,7 @@ library , bytestring >= 0.10 && < 0.11 , free >= 4.10 && < 6 , mtl >= 2.1.2 && < 2.3 - , random >= 1.1 && < 1.2 + , random >= 1.1 && < 1.3 , hspec >= 2.1.0 && < 2.8 , hspec-core >= 2.1.0 && < 2.8 , stripe-core diff --git a/stripe-tests/tests/Web/Stripe/Test/Charge.hs b/stripe-tests/tests/Web/Stripe/Test/Charge.hs index 510ac2a..17a2459 100644 --- a/stripe-tests/tests/Web/Stripe/Test/Charge.hs +++ b/stripe-tests/tests/Web/Stripe/Test/Charge.hs @@ -9,11 +9,16 @@ import Test.Hspec import Web.Stripe.Charge import Web.Stripe.Customer import Web.Stripe.Test.Prelude +import Web.Stripe.Card +import Web.Stripe.PaymentMethod +import Web.Stripe.StripeRequest (Expandable (Id)) +import Web.Stripe.Token chargeTests :: StripeSpec chargeTests stripe = describe "Charge tests" $ do chargeCustomerTest + chargeCustomerTest2 retrieveChargeTest updateChargeTest retrieveExpandedChargeTest @@ -32,6 +37,14 @@ chargeTests stripe = charge <- createCharge (Amount 100) USD -&- cid void $ deleteCustomer cid return charge + result `shouldSatisfy` isLeft + chargeCustomerTest2 = + it "Charges a customer's card succesfully" $ do + result <- stripe $ do + (cid, PaymentMethod { paymentMethodId = pmid }) <- attachTestPaymentMethod + charge <- createCharge (Amount 100) USD -&- cid -&- (Source pmid) + void $ deleteCustomer cid + return charge result `shouldSatisfy` isRight retrieveChargeTest = it "Retrieves a charge succesfully" $ do @@ -88,3 +101,30 @@ chargeTests stripe = result `shouldSatisfy` isRight let Right Charge { chargeCaptured = captured } = result captured `shouldBe` True + + +attachTestPaymentMethod = do + Customer { customerId = cid } <- createCustomer + pm <- createPaymentMethod cardinfo + pm' <- attachPaymentMethod (paymentMethodId pm) cid + return (cid, pm') + + where + cardinfo = (mkNewCard credit em ey) { newCardCVC = Just cvc } + debitinfo = (mkNewCard debit em ey) { newCardCVC = Just cvc } + credit = CardNumber "4242424242424242" + debit = CardNumber "4000056655665556" + em = ExpMonth 12 + ey = ExpYear 2023 + cvc = CVC "123" + country = Country "US" + routingnumber = RoutingNumber "110000000" + accountnumber = AccountNumber "000123456789" + name = Name "David Johnson" + cardname = Name "cardName" + cardcity = AddressCity "Chicago" + cardcountry = AddressCountry "US" + cardaddressOne = AddressLine1 "123 Fake Street" + cardaddressTwo = AddressLine2 "456 Fake Street" + cardaddressState = AddressState "IL" + cardzip = AddressZip "60610" From 5e6d5322c74c66d57462c74f48eba747f8ae02aa Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Thu, 18 Jul 2024 10:49:24 -0400 Subject: [PATCH 37/44] Update customer invoice settings --- stripe-core/src/Web/Stripe/Customer.hs | 1 + stripe-core/src/Web/Stripe/StripeRequest.hs | 8 +++++++- stripe-core/src/Web/Stripe/Types.hs | 2 +- 3 files changed, 9 insertions(+), 2 deletions(-) diff --git a/stripe-core/src/Web/Stripe/Customer.hs b/stripe-core/src/Web/Stripe/Customer.hs index c4e1022..4393a91 100644 --- a/stripe-core/src/Web/Stripe/Customer.hs +++ b/stripe-core/src/Web/Stripe/Customer.hs @@ -142,6 +142,7 @@ instance StripeHasParam UpdateCustomer TokenId instance StripeHasParam UpdateCustomer NewCard instance StripeHasParam UpdateCustomer CouponId instance StripeHasParam UpdateCustomer DefaultCard +instance StripeHasParam UpdateCustomer InvoiceSettings instance StripeHasParam UpdateCustomer Description instance StripeHasParam UpdateCustomer Email instance StripeHasParam UpdateCustomer MetaData diff --git a/stripe-core/src/Web/Stripe/StripeRequest.hs b/stripe-core/src/Web/Stripe/StripeRequest.hs index 2c53c45..c23a77a 100644 --- a/stripe-core/src/Web/Stripe/StripeRequest.hs +++ b/stripe-core/src/Web/Stripe/StripeRequest.hs @@ -57,7 +57,7 @@ import Web.Stripe.Types (AccountBalance(..), AccountNumber(..), ExpYear(..), Forgiven(..), Interval(..), IntervalCount(..), InvoiceId(..), InvoiceItemId(..), - InvoiceLineItemId(..), + InvoiceLineItemId(..), InvoiceSettings(..), IsVerified(..), MetaData(..), PaymentIntentId(..), PaymentIntentUsage(..), PaymentMethodId(..), PaymentMethodTypes(..), PaymentMethodType(..), PlanId(..), PlanName(..), Prorate(..), Limit(..), MaxRedemptions(..), Name(..), @@ -291,6 +291,12 @@ instance ToStripeParam InvoiceLineItemId where toStripeParam (InvoiceLineItemId txt) = (("line_item", Text.encodeUtf8 txt) :) +instance ToStripeParam InvoiceSettings where + toStripeParam (InvoiceSettings (Just (PaymentMethodId pid))) = + (("default_payment_method", Text.encodeUtf8 pid) :) + toStripeParam (InvoiceSettings Nothing) = + (("default_payment_method", "null") :) + instance ToStripeParam IsVerified where toStripeParam (IsVerified b) = (("verified", if b then "true" else "false") :) diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index 7bc2f40..1364ab8 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -317,7 +317,7 @@ newtype CardId = CardId Text ------------------------------------------------------------------------------ -- | InvoiceSettings for a `Customer` data InvoiceSettings = InvoiceSettings { - invoiceSettingsDefaultPaymentMethod :: Maybe (Expandable PaymentMethodId) + invoiceSettingsDefaultPaymentMethod :: Maybe PaymentMethodId } deriving (Read, Show, Eq, Ord, Data, Typeable) instance FromJSON InvoiceSettings where From a400c76e4861f50dfe9a3e320ff52841efdb426a Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Fri, 19 Jul 2024 10:55:39 -0400 Subject: [PATCH 38/44] Change version --- stripe-core/src/Web/Stripe/StripeRequest.hs | 4 ++-- stripe-core/stripe-core.cabal | 2 +- stripe-haskell/stripe-haskell.cabal | 2 +- stripe-tests/stripe-tests.cabal | 2 +- 4 files changed, 5 insertions(+), 5 deletions(-) diff --git a/stripe-core/src/Web/Stripe/StripeRequest.hs b/stripe-core/src/Web/Stripe/StripeRequest.hs index c23a77a..3f82dd8 100644 --- a/stripe-core/src/Web/Stripe/StripeRequest.hs +++ b/stripe-core/src/Web/Stripe/StripeRequest.hs @@ -293,9 +293,9 @@ instance ToStripeParam InvoiceLineItemId where instance ToStripeParam InvoiceSettings where toStripeParam (InvoiceSettings (Just (PaymentMethodId pid))) = - (("default_payment_method", Text.encodeUtf8 pid) :) + (("invoice_settings", "{ default_payment_method: " <> Text.encodeUtf8 pid <> "}") :) toStripeParam (InvoiceSettings Nothing) = - (("default_payment_method", "null") :) + (("invoice_settings", "{ default_payment_method: null }") :) instance ToStripeParam IsVerified where toStripeParam (IsVerified b) = diff --git a/stripe-core/stripe-core.cabal b/stripe-core/stripe-core.cabal index e244ad6..fd35436 100644 --- a/stripe-core/stripe-core.cabal +++ b/stripe-core/stripe-core.cabal @@ -1,5 +1,5 @@ name: stripe-core -version: 2.7.0 +version: 2.7.1 synopsis: Stripe API for Haskell - Pure Core license: MIT license-file: LICENSE diff --git a/stripe-haskell/stripe-haskell.cabal b/stripe-haskell/stripe-haskell.cabal index a7501df..d69fc09 100644 --- a/stripe-haskell/stripe-haskell.cabal +++ b/stripe-haskell/stripe-haskell.cabal @@ -1,5 +1,5 @@ name: stripe-haskell -version: 2.7.0 +version: 2.7.1 synopsis: Stripe API for Haskell license: MIT license-file: LICENSE diff --git a/stripe-tests/stripe-tests.cabal b/stripe-tests/stripe-tests.cabal index f3430f9..c450dca 100644 --- a/stripe-tests/stripe-tests.cabal +++ b/stripe-tests/stripe-tests.cabal @@ -1,5 +1,5 @@ name: stripe-tests -version: 2.7.0 +version: 2.7.1 synopsis: Tests for Stripe API bindings for Haskell license: MIT license-file: LICENSE From de935ebafff3ed65da1fe6ab90e9a265623753de Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Fri, 19 Jul 2024 14:46:48 -0400 Subject: [PATCH 39/44] Bump versions --- stripe-core/stripe-core.cabal | 2 +- stripe-haskell/stripe-haskell.cabal | 2 +- stripe-tests/stripe-tests.cabal | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/stripe-core/stripe-core.cabal b/stripe-core/stripe-core.cabal index fd35436..32c8b82 100644 --- a/stripe-core/stripe-core.cabal +++ b/stripe-core/stripe-core.cabal @@ -1,5 +1,5 @@ name: stripe-core -version: 2.7.1 +version: 2.7.2 synopsis: Stripe API for Haskell - Pure Core license: MIT license-file: LICENSE diff --git a/stripe-haskell/stripe-haskell.cabal b/stripe-haskell/stripe-haskell.cabal index d69fc09..edb9fd8 100644 --- a/stripe-haskell/stripe-haskell.cabal +++ b/stripe-haskell/stripe-haskell.cabal @@ -1,5 +1,5 @@ name: stripe-haskell -version: 2.7.1 +version: 2.7.2 synopsis: Stripe API for Haskell license: MIT license-file: LICENSE diff --git a/stripe-tests/stripe-tests.cabal b/stripe-tests/stripe-tests.cabal index c450dca..d45f5c1 100644 --- a/stripe-tests/stripe-tests.cabal +++ b/stripe-tests/stripe-tests.cabal @@ -1,5 +1,5 @@ name: stripe-tests -version: 2.7.1 +version: 2.7.2 synopsis: Tests for Stripe API bindings for Haskell license: MIT license-file: LICENSE From 91dfa9072622bc616717837f3c42246ae4866ef0 Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Fri, 19 Jul 2024 15:26:50 -0400 Subject: [PATCH 40/44] Try again sending default payment method id --- stripe-core/src/Web/Stripe/StripeRequest.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/stripe-core/src/Web/Stripe/StripeRequest.hs b/stripe-core/src/Web/Stripe/StripeRequest.hs index 3f82dd8..88424a3 100644 --- a/stripe-core/src/Web/Stripe/StripeRequest.hs +++ b/stripe-core/src/Web/Stripe/StripeRequest.hs @@ -293,9 +293,9 @@ instance ToStripeParam InvoiceLineItemId where instance ToStripeParam InvoiceSettings where toStripeParam (InvoiceSettings (Just (PaymentMethodId pid))) = - (("invoice_settings", "{ default_payment_method: " <> Text.encodeUtf8 pid <> "}") :) + (("invoice_settings[default_payment_method]", Text.encodeUtf8 pid ) :) toStripeParam (InvoiceSettings Nothing) = - (("invoice_settings", "{ default_payment_method: null }") :) + (("invoice_settings[default_payment_method]", null ) :) instance ToStripeParam IsVerified where toStripeParam (IsVerified b) = From 7b81fc3dfeaab820a94ab58fd62ca9c60eae8add Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Fri, 19 Jul 2024 15:37:21 -0400 Subject: [PATCH 41/44] Fix typo --- stripe-core/src/Web/Stripe/StripeRequest.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/stripe-core/src/Web/Stripe/StripeRequest.hs b/stripe-core/src/Web/Stripe/StripeRequest.hs index 88424a3..b06b951 100644 --- a/stripe-core/src/Web/Stripe/StripeRequest.hs +++ b/stripe-core/src/Web/Stripe/StripeRequest.hs @@ -295,7 +295,7 @@ instance ToStripeParam InvoiceSettings where toStripeParam (InvoiceSettings (Just (PaymentMethodId pid))) = (("invoice_settings[default_payment_method]", Text.encodeUtf8 pid ) :) toStripeParam (InvoiceSettings Nothing) = - (("invoice_settings[default_payment_method]", null ) :) + (("invoice_settings[default_payment_method]", "null" ) :) instance ToStripeParam IsVerified where toStripeParam (IsVerified b) = From 9488ebd8d243ba1c87a17744eb483f3999574298 Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Mon, 22 Jul 2024 10:50:46 -0400 Subject: [PATCH 42/44] Use Expandable on PaymentMethod --- stripe-core/src/Web/Stripe/StripeRequest.hs | 2 +- stripe-core/src/Web/Stripe/Types.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/stripe-core/src/Web/Stripe/StripeRequest.hs b/stripe-core/src/Web/Stripe/StripeRequest.hs index b06b951..e1f0564 100644 --- a/stripe-core/src/Web/Stripe/StripeRequest.hs +++ b/stripe-core/src/Web/Stripe/StripeRequest.hs @@ -292,7 +292,7 @@ instance ToStripeParam InvoiceLineItemId where (("line_item", Text.encodeUtf8 txt) :) instance ToStripeParam InvoiceSettings where - toStripeParam (InvoiceSettings (Just (PaymentMethodId pid))) = + toStripeParam (InvoiceSettings (Just (Id (PaymentMethodId pid)))) = (("invoice_settings[default_payment_method]", Text.encodeUtf8 pid ) :) toStripeParam (InvoiceSettings Nothing) = (("invoice_settings[default_payment_method]", "null" ) :) diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index 1364ab8..7bc2f40 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -317,7 +317,7 @@ newtype CardId = CardId Text ------------------------------------------------------------------------------ -- | InvoiceSettings for a `Customer` data InvoiceSettings = InvoiceSettings { - invoiceSettingsDefaultPaymentMethod :: Maybe PaymentMethodId + invoiceSettingsDefaultPaymentMethod :: Maybe (Expandable PaymentMethodId) } deriving (Read, Show, Eq, Ord, Data, Typeable) instance FromJSON InvoiceSettings where From e424a89aab32bd862808893ea07179a574cfc787 Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Wed, 24 Jul 2024 10:26:40 -0400 Subject: [PATCH 43/44] Add type for payment intent payment method --- stripe-core/src/Web/Stripe/Types.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index 7bc2f40..0bf064b 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -2107,7 +2107,7 @@ data PaymentIntent = PaymentIntent { , paymentIntentMetadata :: Maybe MetaData , paymentIntentNextAction :: Maybe TODO , paymentIntentOnBehalfOf :: Maybe (Expandable AccountId) - , paymentIntentPaymentMethod :: Maybe TODO + , paymentIntentPaymentMethod :: Maybe (Expandable PaymentMethodId) , paymentIntentPaymentOptions :: Maybe TODO , paymentIntentPaymentMethodTypes :: [Text] , paymentIntentReceiptEmail :: Maybe ReceiptEmail From 3d5157068c5ec0e3b6f65358b0f99736bc055f85 Mon Sep 17 00:00:00 2001 From: Libby Horacek Date: Wed, 24 Jul 2024 10:27:29 -0400 Subject: [PATCH 44/44] Add type for setup intent payment method --- stripe-core/src/Web/Stripe/Types.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index 0bf064b..a5465a1 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -2208,7 +2208,7 @@ data SetupIntent = SetupIntent { , setupIntentMetadata :: Maybe MetaData , setupIntentNextAction :: Maybe TODO , setupIntentOnBehalfOf :: Maybe (Expandable AccountId) - , setupIntentPaymentMethod :: Maybe TODO + , setupIntentPaymentMethod :: Maybe (Expandable PaymentMethodId) , setupIntentPaymentOptions :: Maybe TODO , setupIntentPaymentMethodTypes :: [Text] , setupIntentSingleUseMandate :: Maybe TODO