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/18] 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/18] 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/18] 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/18] 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/18] 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/18] 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/18] 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/18] 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/18] 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/18] 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/18] 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/18] 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/18] 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/18] 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/18] 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/18] 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/18] 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/18] 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