diff --git a/stack.yaml b/stack.yaml index b65c479..762ac14 100644 --- a/stack.yaml +++ b/stack.yaml @@ -17,7 +17,7 @@ # # resolver: ./custom-snapshot.yaml # resolver: https://example.com/snapshots/2018-01-01.yaml -resolver: nightly-2020-09-02 +resolver: lts-18.19 # User packages to be built. # Various formats can be used as shown in the example below. @@ -37,12 +37,8 @@ packages: # These entries can reference officially published versions as well as # forks / in-progress versions pinned to a git hash. For example: # -# extra-deps: -# - acme-missiles-0.3 -# - git: https://github.com/commercialhaskell/stack.git -# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a -# -# extra-deps: [] +extra-deps: + - random-1.2.1.1@sha256:dea1f11e5569332dc6c8efaad1cb301016a5587b6754943a49f9de08ae0e56d9 # Override default flag values for local packages and extra-deps # flags: {} diff --git a/stack.yaml.lock b/stack.yaml.lock index 30d1e2e..478ded1 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -3,10 +3,17 @@ # For more information, please see the documentation at: # https://docs.haskellstack.org/en/stable/lock_files -packages: [] +packages: +- completed: + hackage: random-1.2.1.1@sha256:dea1f11e5569332dc6c8efaad1cb301016a5587b6754943a49f9de08ae0e56d9,6541 + pantry-tree: + sha256: 646ee77fe01178837ee928b61ae8653dcf190e9b5353ebebd094079c77a18b76 + size: 1528 + original: + hackage: random-1.2.1.1@sha256:dea1f11e5569332dc6c8efaad1cb301016a5587b6754943a49f9de08ae0e56d9 snapshots: - completed: - size: 527775 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2020/9/2.yaml - sha256: 92ec78ae38830f06ec9307c5ce346ae93982fab6179eb10dec9d57d5069c7f14 - original: nightly-2020-09-02 + sha256: 32716534fff554b7f90762130fdb985cabf29f157758934dd1c8f3892a646430 + size: 586103 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/19.yaml + original: lts-18.19 diff --git a/stripe-core/src/Web/Stripe/Charge.hs b/stripe-core/src/Web/Stripe/Charge.hs index 483a5fe..bb45c50 100644 --- a/stripe-core/src/Web/Stripe/Charge.hs +++ b/stripe-core/src/Web/Stripe/Charge.hs @@ -75,6 +75,7 @@ module Web.Stripe.Charge , MetaData (..) , NewCard (..) , ReceiptEmail (..) + , Source (..) , StartingAfter (..) , StatementDescription (..) , StripeList (..) @@ -95,11 +96,11 @@ import Web.Stripe.Types (Amount(..), ApplicationFeeAmount(.. CustomerId (..), Description(..), EndingBefore(..), ExpMonth (..), ExpYear (..), Limit(..), MetaData(..), - NewCard(..), Email (..), + NewCard(..), Email (..), PaymentMethodId(..), StartingAfter(..), ReceiptEmail(..), StatementDescription(..), - ExpandParams(..), + ExpandParams(..), Source(..), StripeList (..), TokenId (..)) import Web.Stripe.Types.Util (getChargeId) @@ -124,6 +125,7 @@ instance StripeHasParam CreateCharge ExpandParams instance StripeHasParam CreateCharge CustomerId instance StripeHasParam CreateCharge NewCard instance StripeHasParam CreateCharge TokenId +instance StripeHasParam CreateCharge (Source PaymentMethodId) instance StripeHasParam CreateCharge Description instance StripeHasParam CreateCharge MetaData instance StripeHasParam CreateCharge Capture diff --git a/stripe-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/Customer.hs b/stripe-core/src/Web/Stripe/Customer.hs index 6c6c9bb..4393a91 100644 --- a/stripe-core/src/Web/Stripe/Customer.hs +++ b/stripe-core/src/Web/Stripe/Customer.hs @@ -57,6 +57,7 @@ module Web.Stripe.Customer , ExpandParams (..) , ExpMonth (..) , ExpYear (..) + , InvoiceSettings (..) , Limit (..) , MetaData (..) , mkNewCard @@ -80,8 +81,8 @@ import Web.Stripe.Types (AccountBalance(..), CVC (..), CustomerId (..), DefaultCard(..), Description(..), Email (..), EndingBefore(..), ExpMonth (..), - ExpYear (..), Limit(..), PlanId (..), - Quantity (..), MetaData(..), + ExpYear (..), Limit(..), InvoiceSettings (..), + PlanId (..), Quantity (..), MetaData(..), mkNewCard, NewCard(..), StartingAfter(..), StripeDeleteResult (..), StripeList (..), TokenId (..), @@ -141,6 +142,7 @@ instance StripeHasParam UpdateCustomer TokenId instance StripeHasParam UpdateCustomer NewCard instance StripeHasParam UpdateCustomer CouponId instance StripeHasParam UpdateCustomer DefaultCard +instance StripeHasParam UpdateCustomer InvoiceSettings instance StripeHasParam UpdateCustomer Description instance StripeHasParam UpdateCustomer Email instance StripeHasParam UpdateCustomer MetaData diff --git a/stripe-core/src/Web/Stripe/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-core/src/Web/Stripe/Event.hs b/stripe-core/src/Web/Stripe/Event.hs index 6ca6f5b..c4f5922 100644 --- a/stripe-core/src/Web/Stripe/Event.hs +++ b/stripe-core/src/Web/Stripe/Event.hs @@ -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 new file mode 100644 index 0000000..ba76d3f --- /dev/null +++ b/stripe-core/src/Web/Stripe/PaymentIntent.hs @@ -0,0 +1,193 @@ +{-# 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 +module Web.Stripe.PaymentIntent + ( -- * API + CreatePaymentIntent + , createPaymentIntent + , GetPaymentIntent + , getPaymentIntent + , UpdatePaymentIntent + , updatePaymentIntent + , ConfirmPaymentIntent + , confirmPaymentIntent + , CapturePaymentIntent + , capturePaymentIntent + , CancelPaymentIntent + , cancelPaymentIntent + , GetPaymentIntents + , getPaymentIntents + -- * Types + , Amount (..) + , CardId (..) + , Charge (..) + , ChargeId (..) + , Currency (..) + , CustomerId (..) + , Description (..) + , EndingBefore (..) + , ExpandParams (..) + , Confirm (..) + , OffSession (..) + , PaymentIntent (..) + , PaymentIntentId (..) + , PaymentMethodId (..) + , PaymentMethodTypes (..) + , PaymentMethodType (..) + , PaymentIntentUsage (..) + , Usage (..) + , StripeList (..) + , Token (..) + ) where + +import Web.Stripe.StripeRequest (Method (GET, POST), + StripeHasParam, StripeReturn, + StripeRequest (..), toStripeParam, mkStripeRequest) +import Web.Stripe.Util (()) +import Web.Stripe.Types (Amount(..), Charge (..), CardId (..), ChargeId (..), + Confirm(..), Currency(..), CustomerId(..), + Description(..), EndingBefore(..), Limit(..), + MetaData(..), PaymentIntent (..), PaymentMethodId (..), PaymentMethodTypes(..), PaymentMethodType(..), + PaymentIntentId (..), OffSession(..), ReceiptEmail(..), + PaymentIntentUsage(..), Usage (..), StartingAfter(..), ExpandParams(..), + StripeList (..), Token (..), StatementDescriptor(..), StatementDescriptorSuffix(..)) + +------------------------------------------------------------------------------ +-- | create a `PaymentIntent` +createPaymentIntent + :: Amount + -> Currency + -> StripeRequest CreatePaymentIntent +createPaymentIntent + amount + currency = request + where request = mkStripeRequest POST url params + url = "payment_intents" + params = toStripeParam amount $ + toStripeParam currency $ + [] + +data CreatePaymentIntent +type instance StripeReturn CreatePaymentIntent = PaymentIntent +instance StripeHasParam CreatePaymentIntent CustomerId +instance StripeHasParam CreatePaymentIntent Description +instance StripeHasParam CreatePaymentIntent ReceiptEmail +instance StripeHasParam CreatePaymentIntent PaymentMethodTypes +instance StripeHasParam CreatePaymentIntent PaymentIntentUsage +instance StripeHasParam CreatePaymentIntent PaymentMethodId +instance StripeHasParam CreatePaymentIntent Confirm +instance StripeHasParam CreatePaymentIntent MetaData +instance StripeHasParam CreatePaymentIntent OffSession +instance StripeHasParam CreatePaymentIntent StatementDescriptor +instance StripeHasParam CreatePaymentIntent StatementDescriptorSuffix + +------------------------------------------------------------------------------ +-- | Retrieve a `PaymentIntent` by `ChargeId` and `PaymentIntentId` +getPaymentIntent + :: PaymentIntentId -- ^ `PaymentIntentId` associated with the `PaymentIntent` to be retrieved + -> StripeRequest GetPaymentIntent +getPaymentIntent + (PaymentIntentId paymentIntentid) = request + where request = mkStripeRequest GET url params + url = "payment_intents" paymentIntentid + params = [] + +data GetPaymentIntent +type instance StripeReturn GetPaymentIntent = PaymentIntent +instance StripeHasParam GetPaymentIntent ExpandParams + +------------------------------------------------------------------------------ +-- | Update a `PaymentIntent` by `ChargeId` and `PaymentIntentId` +updatePaymentIntent + :: PaymentIntentId -- ^ `PaymentIntentId` associated with the `PaymentIntent` to be retrieved + -> StripeRequest UpdatePaymentIntent +updatePaymentIntent + (PaymentIntentId paymentIntentid) + = request + where request = mkStripeRequest POST url params + url = "payment_intents" paymentIntentid + params = [] + +data UpdatePaymentIntent +type instance StripeReturn UpdatePaymentIntent = PaymentIntent +instance StripeHasParam UpdatePaymentIntent MetaData +instance StripeHasParam UpdatePaymentIntent PaymentMethodId +instance StripeHasParam UpdatePaymentIntent Amount +instance StripeHasParam UpdatePaymentIntent Currency +instance StripeHasParam UpdatePaymentIntent CustomerId +instance StripeHasParam UpdatePaymentIntent Description +instance StripeHasParam UpdatePaymentIntent PaymentMethodTypes +instance StripeHasParam UpdatePaymentIntent ReceiptEmail +instance StripeHasParam UpdatePaymentIntent PaymentIntentUsage +instance StripeHasParam UpdatePaymentIntent StatementDescriptor +instance StripeHasParam UpdatePaymentIntent StatementDescriptorSuffix +-- TODO shipping, statement descriptor, statement descriptor suffix + +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 +instance StripeHasParam ConfirmPaymentIntent OffSession +instance StripeHasParam ConfirmPaymentIntent PaymentMethodId + +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 list of PaymentIntents +getPaymentIntents + :: StripeRequest GetPaymentIntents +getPaymentIntents + = request + where request = mkStripeRequest GET url params + url = "payment_intents" + 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/PaymentMethod.hs b/stripe-core/src/Web/Stripe/PaymentMethod.hs new file mode 100644 index 0000000..7c76e53 --- /dev/null +++ b/stripe-core/src/Web/Stripe/PaymentMethod.hs @@ -0,0 +1,228 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +------------------------------------------- + +module Web.Stripe.PaymentMethod + ( -- * API + -- ** Customers + -- *** Create PaymentMethod + CreatePaymentMethodByToken + , createPaymentMethodByToken + , CreatePaymentMethod + , createPaymentMethod + , AttachPaymentMethod + , attachPaymentMethod + -- *** Get PaymentMethod(s) + , GetPaymentMethod + , getPaymentMethod + , GetCustomerPaymentMethods + , getCustomerPaymentMethods {- + , GetPaymentMethods + , getPaymentMethods + -- *** Update PaymentMethod + , UpdatePaymentMethod + , updatePaymentMethod + -- *** Delete PaymentMethod -} + , DetachPaymentMethod + , detachPaymentMethod + -- * Types + , AddressLine1 (..) + , AddressLine2 (..) + , AddressCity (..) + , AddressCountry (..) + , AddressState (..) + , AddressZip (..) + , Brand (..) + , PaymentMethod (..) + , PaymentMethodId (..) + , PaymentMethodType (..) + , CardHash (..) + , CardNumber (..) + , CVC (..) + , EndingBefore (..) + , ExpandParams (..) + , ExpMonth (..) + , ExpYear (..) + , Limit (..) + , Name (..) + , StartingAfter (..) + ) where + +import Data.Text (Text) +import Web.Stripe.StripeRequest (Method (GET, POST, DELETE), + StripeHasParam, StripeRequest (..), + StripeReturn, ToStripeParam(..), + mkStripeRequest) +import Web.Stripe.Util (()) +import Web.Stripe.Types (AddressLine1(..), AddressLine2(..) + , AddressCity(..), AddressCountry(..) + , AddressState(..), AddressZip(..) + , Brand(..), PaymentMethod(..), PaymentMethodId(..) + , PaymentMethodType(..), CardHash(..), CardToken(..) + , CardNumber(..), CustomerId(..) + , CVC(..), EndingBefore(..) + , ExpandParams(..) + , ExpMonth(..), ExpYear(..), ID + , Limit(..), Name(..), NewCard(..) + , StartingAfter(..) + , StripeDeleteResult(..) + , StripeList(..), TokenId(..), URL) +import Web.Stripe.Types.Util (getCustomerId) + +createPaymentMethodByToken + :: TokenId -- ^ `TokenId` of card to add + -> PaymentMethodType + -> StripeRequest CreatePaymentMethodByToken +createPaymentMethodByToken + tokenid + typ = request + where request = mkStripeRequest POST url params + url = "payment_methods" + params = toStripeParam (CardToken tokenid) $ + toStripeParam typ + [] + +data CreatePaymentMethodByToken +type instance StripeReturn CreatePaymentMethodByToken = PaymentMethod + +createPaymentMethod + :: NewCard + -> StripeRequest CreatePaymentMethod +createPaymentMethod + newPaymentMethod = request + where request = mkStripeRequest POST url params + url = "payment_methods" + params = toStripeParam newPaymentMethod $ + toStripeParam PaymentMethodTypeCard + [] + +data CreatePaymentMethod +type instance StripeReturn CreatePaymentMethod = PaymentMethod + +attachPaymentMethod + :: PaymentMethodId -- ^ `TokenId` of card to add + -> CustomerId -- ^ id of customer + -> StripeRequest CreatePaymentMethodByToken +attachPaymentMethod + paymentMethodId + customer = request + where request = mkStripeRequest POST url params + url = "payment_methods" getPaymentMethodId paymentMethodId "attach" + params = toStripeParam customer $ + [] + +data AttachPaymentMethod +type instance StripeReturn AttachPaymentMethod = PaymentMethod + +getPaymentMethod + :: PaymentMethodId + -> StripeRequest GetPaymentMethod +getPaymentMethod + pmid = request + where request = mkStripeRequest GET url params + url = "payment_methods" getPaymentMethodId pmid + params = [] +data GetPaymentMethod +type instance StripeReturn GetPaymentMethod = PaymentMethod +-- instance StripeHasParam GetPaymentMethod ExpandParams + +getCustomerPaymentMethods + :: CustomerId -- ^ `CustomerId` of the `PaymentMethod` to retrieve + -> StripeRequest GetCustomerPaymentMethods +getCustomerPaymentMethods + customer = request + where request = mkStripeRequest GET url params + url = "payment_methods" + params = toStripeParam customer $ + toStripeParam PaymentMethodTypeCard + [] + +data GetCustomerPaymentMethods +type instance StripeReturn GetCustomerPaymentMethods = StripeList PaymentMethod +--instance StripeHasParam GetCustomerPaymentMethods ExpandParams +{- +------------------------------------------------------------------------------ +-- | INTERNAL: Generalized update a `PaymentMethod` +updatePaymentMethod + :: URL + -> ID + -> Text -- ^ cardid + -> StripeRequest a +updatePaymentMethod + prefix + id_ + cardid_ = request + where request = mkStripeRequest POST url params + url = prefix id_ + "cards" cardid_ + params = [] + +------------------------------------------------------------------------------ +-- | Update a `Customer` `PaymentMethod` +updateCustomerPaymentMethod + :: CustomerId -- ^ `CustomerId` of the card holder + -> PaymentMethodId -- ^ `PaymentMethodId` of card to update + -> StripeRequest UpdateCustomerPaymentMethod +updateCustomerPaymentMethod + customerid + (PaymentMethodId cardid) + = updatePaymentMethod "customers" (getCustomerId customerid) cardid + +data UpdateCustomerPaymentMethod +type instance StripeReturn UpdateCustomerPaymentMethod = PaymentMethod +instance StripeHasParam UpdateCustomerPaymentMethod AddressLine1 +instance StripeHasParam UpdateCustomerPaymentMethod AddressLine2 +instance StripeHasParam UpdateCustomerPaymentMethod AddressCity +instance StripeHasParam UpdateCustomerPaymentMethod AddressZip +instance StripeHasParam UpdateCustomerPaymentMethod AddressState +instance StripeHasParam UpdateCustomerPaymentMethod AddressCountry +instance StripeHasParam UpdateCustomerPaymentMethod ExpMonth +instance StripeHasParam UpdateCustomerPaymentMethod ExpYear +instance StripeHasParam UpdateCustomerPaymentMethod Name +-} + +detachPaymentMethod + :: PaymentMethodId -- ^ `PaymentMethodId` associated with `PaymentMethod` to be deleted + -> StripeRequest DetachPaymentMethod +detachPaymentMethod + pmid = request + where request = mkStripeRequest POST url params + url = "payment_methods" getPaymentMethodId pmid "detach" + params = [] + +data DetachPaymentMethod +type instance StripeReturn DetachPaymentMethod = PaymentMethod +{- +------------------------------------------------------------------------------ +-- | INTERNAL: Generalized retrieve all cards for `ID` +getPaymentMethods + :: URL + -> ID + -> StripeRequest a +getPaymentMethods + prefix + id_ + = request + where request = mkStripeRequest GET url params + url = prefix id_ "cards" + params = [] + +------------------------------------------------------------------------------ +-- | Retrieve all cards associated with a `Customer` +getCustomerPaymentMethods + :: CustomerId -- ^ The `CustomerId` associated with the cards + -> StripeRequest GetCustomerPaymentMethods +getCustomerPaymentMethods + customerid + = getPaymentMethods "customers" (getCustomerId customerid) + +data GetCustomerPaymentMethods +type instance StripeReturn GetCustomerPaymentMethods = (StripeList PaymentMethod) +instance StripeHasParam GetCustomerPaymentMethods ExpandParams +instance StripeHasParam GetCustomerPaymentMethods (EndingBefore PaymentMethodId) +instance StripeHasParam GetCustomerPaymentMethods Limit +instance StripeHasParam GetCustomerPaymentMethods (StartingAfter PaymentMethodId) +-} \ No newline at end of file diff --git a/stripe-core/src/Web/Stripe/Session.hs b/stripe-core/src/Web/Stripe/Session.hs new file mode 100644 index 0000000..7310f37 --- /dev/null +++ b/stripe-core/src/Web/Stripe/Session.hs @@ -0,0 +1,88 @@ +{-# 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 + , SuccessUrl(..) + , CancelUrl(..) + , ClientReferenceId(..) + , CustomerEmail(..) + , Amount (..) + , LineItems(..) + , LineItem(..) + , Charge (..) + , ChargeId (..) + , EndingBefore (..) + , ExpandParams (..) + , Session (..) + , SessionId (..) + , SessionData (..) + , StripeList (..) + , PaymentMethodTypes(..) + ) where + +import Web.Stripe.StripeRequest (Method (GET, POST), + StripeHasParam, StripeReturn, + StripeRequest (..), toStripeParam, mkStripeRequest) +import Web.Stripe.Util (()) +import Web.Stripe.Types (Amount(..), Charge (..), ChargeId (..), + EndingBefore(..), + Session (..), + SessionId (..), SuccessUrl(..), CancelUrl(..), LineItems(..), LineItem(..), CustomerId(..), CustomerEmail(..), ClientReferenceId(..), SessionData(..), PaymentMethodTypes(..), + ExpandParams(..), + StripeList (..)) + +------------------------------------------------------------------------------ +-- | create a `Session` +createSession + :: SuccessUrl -- ^ Success url + -> CancelUrl -- ^ Cancel url + -> PaymentMethodTypes + -> StripeRequest CreateSession +createSession + successUrl + cancelUrl + paymentMethodTypes = request + where request = mkStripeRequest POST url params + url = "checkout" "sessions" + params = toStripeParam successUrl $ + toStripeParam cancelUrl $ + toStripeParam paymentMethodTypes $ + [] + +data CreateSession +type instance StripeReturn CreateSession = Session +instance StripeHasParam CreateSession LineItems +instance StripeHasParam CreateSession CustomerId +instance StripeHasParam CreateSession ClientReferenceId +instance StripeHasParam CreateSession CustomerEmail +instance StripeHasParam CreateSession PaymentMethodTypes +instance StripeHasParam CreateSession ExpandParams + +------------------------------------------------------------------------------ +-- | 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/SetupIntent.hs b/stripe-core/src/Web/Stripe/SetupIntent.hs new file mode 100644 index 0000000..d536e90 --- /dev/null +++ b/stripe-core/src/Web/Stripe/SetupIntent.hs @@ -0,0 +1,151 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +------------------------------------------- +-- | +-- Module : Web.Stripe.SetupIntent +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +module Web.Stripe.SetupIntent + ( -- * API + CreateSetupIntent + , createSetupIntent + , GetSetupIntent + , getSetupIntent + , UpdateSetupIntent + , updateSetupIntent + , ConfirmSetupIntent + , confirmSetupIntent + , CancelSetupIntent + , cancelSetupIntent + , GetSetupIntents + , getSetupIntents + -- * Types + , Amount (..) + , CardId (..) + , Charge (..) + , ChargeId (..) + , Currency (..) + , CustomerId (..) + , Description (..) + , EndingBefore (..) + , ExpandParams (..) + , SetupIntent (..) + , SetupIntentId (..) + , PaymentMethodId (..) + , PaymentMethodTypes (..) + , PaymentMethodType (..) + , SetupIntentUsage (..) + , Usage (..) + , StripeList (..) + , Token (..) + ) where + +import Web.Stripe.StripeRequest (Method (GET, POST), + StripeHasParam, StripeReturn, + StripeRequest (..), toStripeParam, mkStripeRequest) +import Web.Stripe.Util (()) +import Web.Stripe.Types (Amount(..), Charge (..), CardId (..), ChargeId (..), Currency(..), CustomerId(..), + Description(..), EndingBefore(..), Limit(..), + MetaData(..), SetupIntent (..), PaymentMethodId (..), PaymentMethodTypes(..), PaymentMethodType(..), + SetupIntentId (..), ReceiptEmail(..), + SetupIntentUsage(..), Usage (..), StartingAfter(..), ExpandParams(..), + StripeList (..), Token (..)) + +------------------------------------------------------------------------------ +-- | create a `SetupIntent` +createSetupIntent :: StripeRequest CreateSetupIntent +createSetupIntent = request + where request = mkStripeRequest POST url params + url = "setup_intents" + params = [] + +data CreateSetupIntent +type instance StripeReturn CreateSetupIntent = SetupIntent +instance StripeHasParam CreateSetupIntent CustomerId +instance StripeHasParam CreateSetupIntent Description +instance StripeHasParam CreateSetupIntent PaymentMethodTypes +instance StripeHasParam CreateSetupIntent SetupIntentUsage + +------------------------------------------------------------------------------ +-- | Retrieve a `SetupIntent` by `ChargeId` and `SetupIntentId` +getSetupIntent + :: SetupIntentId -- ^ `SetupIntentId` associated with the `SetupIntent` to be retrieved + -> StripeRequest GetSetupIntent +getSetupIntent + (SetupIntentId setupIntentid) = request + where request = mkStripeRequest GET url params + url = "setup_intents" setupIntentid + params = [] + +data GetSetupIntent +type instance StripeReturn GetSetupIntent = SetupIntent +instance StripeHasParam GetSetupIntent ExpandParams + +------------------------------------------------------------------------------ +-- | Update a `SetupIntent` by `ChargeId` and `SetupIntentId` +updateSetupIntent + :: SetupIntentId -- ^ `SetupIntentId` associated with the `SetupIntent` to be retrieved + -> StripeRequest UpdateSetupIntent +updateSetupIntent + (SetupIntentId setupIntentid) + = request + where request = mkStripeRequest POST url params + url = "setup_intents" setupIntentid + params = [] + +data UpdateSetupIntent +type instance StripeReturn UpdateSetupIntent = SetupIntent +instance StripeHasParam UpdateSetupIntent MetaData +instance StripeHasParam UpdateSetupIntent PaymentMethodId +instance StripeHasParam UpdateSetupIntent CustomerId +instance StripeHasParam UpdateSetupIntent Description +instance StripeHasParam UpdateSetupIntent PaymentMethodTypes + +confirmSetupIntent + :: SetupIntentId + -> StripeRequest ConfirmSetupIntent +confirmSetupIntent + (SetupIntentId setupIntentid) + = request + where request = mkStripeRequest POST url params + url = "setup_intents" setupIntentid "confirm" + params = [] + +data ConfirmSetupIntent +type instance StripeReturn ConfirmSetupIntent = SetupIntent +instance StripeHasParam ConfirmSetupIntent MetaData +instance StripeHasParam ConfirmSetupIntent PaymentMethodId + +cancelSetupIntent + :: SetupIntentId + -> StripeRequest CancelSetupIntent +cancelSetupIntent + (SetupIntentId setupIntentid) + = request + where request = mkStripeRequest POST url params + url = "setup_intents" setupIntentid "cancel" + params = [] + +data CancelSetupIntent +type instance StripeReturn CancelSetupIntent = SetupIntent + +------------------------------------------------------------------------------ +-- | Retrieve a list of SetupIntents +getSetupIntents + :: StripeRequest GetSetupIntents +getSetupIntents + = request + where request = mkStripeRequest GET url params + url = "setup_intents" + params = [] + +data GetSetupIntents +type instance StripeReturn GetSetupIntents = StripeList SetupIntent +instance StripeHasParam GetSetupIntents ExpandParams +instance StripeHasParam GetSetupIntents (EndingBefore SetupIntentId) +instance StripeHasParam GetSetupIntents Limit +instance StripeHasParam GetSetupIntents (StartingAfter SetupIntentId) diff --git a/stripe-core/src/Web/Stripe/StripeRequest.hs b/stripe-core/src/Web/Stripe/StripeRequest.hs index ac27b89..e1f0564 100644 --- a/stripe-core/src/Web/Stripe/StripeRequest.hs +++ b/stripe-core/src/Web/Stripe/StripeRequest.hs @@ -44,37 +44,38 @@ import Web.Stripe.Types (AccountBalance(..), AccountNumber(..), ApplicationFeePercent(..), AtPeriodEnd(..), AvailableOn(..), BankAccountId(..), - CardId(..), CardNumber(..), + CardId(..), CardNumber(..), CardToken(..), Capture(..), ChargeId(..), Closed(..), - CouponId(..), + CouponId(..), Confirm(..), Country(..), Created(..), Currency(..), - CustomerId(..), CVC(..), Date(..), + CustomerId(..), CustomerEmail(..), ClientReferenceId(..), CVC(..), Date(..), DefaultCard(..), Description(..), Duration(..), DurationInMonths(..), - Email(..), EndingBefore(..), EventId(..), + Email(..), EndingBefore(..), EventId(..), EventType(..), Evidence(..), Expandable(..), ExpandParams(..), ExpMonth(..), ExpYear(..), Forgiven(..), Interval(..), IntervalCount(..), InvoiceId(..), InvoiceItemId(..), - InvoiceLineItemId(..), - IsVerified(..), MetaData(..), PlanId(..), + InvoiceLineItemId(..), InvoiceSettings(..), + IsVerified(..), MetaData(..), PaymentIntentId(..), PaymentIntentUsage(..), PaymentMethodId(..), PaymentMethodTypes(..), PaymentMethodType(..), PlanId(..), PlanName(..), Prorate(..), Limit(..), MaxRedemptions(..), Name(..), NewBankAccount(..), NewCard(..), + OffSession(..), PercentOff(..), Quantity(..), ReceiptEmail(..), RecipientId(..), RecipientType(..), RedeemBy(..), RefundId(..), RefundApplicationFee(..), RefundReason(..), - RoutingNumber(..), StartingAfter(..), - StatementDescription(..), Source(..), - SubscriptionId(..), TaxID(..), + RoutingNumber(..), SetupIntentId(..), SetupIntentUsage(..), Usage(..), StartingAfter(..), + StatementDescription(..), StatementDescriptor(..), StatementDescriptorSuffix(..), Source(..), + SubscriptionId(..), TaxID(..), TaxPercent(..), TimeRange(..), TokenId(..), TransactionId(..), TransactionType(..), TransferId(..), - TransferStatus(..), TrialEnd(..), - TrialPeriodDays(..)) -import Web.Stripe.Util (toBytestring, toExpandable,toMetaData, + TransferStatus(..), TrialEnd(..), SuccessUrl(..), CancelUrl(..), LineItems(..), LineItem(..), + TrialPeriodDays(..), eventTypeText) +import Web.Stripe.Util (toBytestring, toBytestringLower, toExpandable,toMetaData, encodeList, toSeconds, getParams, toText) ------------------------------------------------------------------------------ @@ -202,6 +203,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) :) @@ -238,6 +247,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) :) @@ -278,6 +291,12 @@ instance ToStripeParam InvoiceLineItemId where toStripeParam (InvoiceLineItemId txt) = (("line_item", Text.encodeUtf8 txt) :) +instance ToStripeParam InvoiceSettings where + toStripeParam (InvoiceSettings (Just (Id (PaymentMethodId pid)))) = + (("invoice_settings[default_payment_method]", Text.encodeUtf8 pid ) :) + toStripeParam (InvoiceSettings Nothing) = + (("invoice_settings[default_payment_method]", "null" ) :) + instance ToStripeParam IsVerified where toStripeParam (IsVerified b) = (("verified", if b then "true" else "false") :) @@ -318,6 +337,26 @@ 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 PaymentIntentUsage where + toStripeParam (PaymentIntentUsage UseOffSession) = + (("setup_future_usage", "off_session") :) + toStripeParam (PaymentIntentUsage UseOnSession) = + (("setup_future_usage", "on_session") :) + +instance ToStripeParam SetupIntentUsage where + toStripeParam (SetupIntentUsage UseOffSession) = + (("usage", "off_session") :) + toStripeParam (SetupIntentUsage UseOnSession) = + (("usage", "on_session") :) + +instance ToStripeParam OffSession where + toStripeParam (OffSession offSession) = + (("off_session", toBytestringLower offSession) :) + instance ToStripeParam (Param Text Text) where toStripeParam (Param (k,v)) = ((Text.encodeUtf8 k, Text.encodeUtf8 v) :) @@ -403,6 +442,11 @@ instance ToStripeParam a => ToStripeParam (TimeRange a) where [(k,v)] -> ((k <> "[" <> n <> "]", v) :) lst' -> error $ "toRecord in ToStripeRange (TimeRange a) expected exactly one element in this list. " ++ show lst' + +instance ToStripeParam CardToken where + toStripeParam (CardToken (TokenId tid)) = + (("card[token]", Text.encodeUtf8 tid) :) + instance ToStripeParam TokenId where toStripeParam (TokenId tid) = (("card", Text.encodeUtf8 tid) :) @@ -427,6 +471,67 @@ instance ToStripeParam TrialPeriodDays where toStripeParam (TrialPeriodDays days) = (("trial_period_days", toBytestring days) :) +instance ToStripeParam SuccessUrl where + toStripeParam (SucessUrl url) = + (("success_url", Text.encodeUtf8 url) :) + +instance ToStripeParam CancelUrl where + toStripeParam (CancelUrl url) = + (("cancel_url", Text.encodeUtf8 url) :) + +instance ToStripeParam LineItems where + toStripeParam (LineItems is) = + encodeListStripeParam "line_items" is + +instance ToStripeParam PaymentMethodId where + toStripeParam (PaymentMethodId pid) = + (("payment_method", Text.encodeUtf8 pid) :) + +instance ToStripeParam PaymentMethodType where + toStripeParam pmt = + let typ = case pmt of + PaymentMethodTypeCard -> "card" + PaymentMethodTypeCardPresent -> "card_present" + PaymentMethodTypeIdeal -> "ideal" + PaymentMethodTypeFPX -> "fpx" + PaymentMethodTypeBacsDebit -> "bacs_debit" + PaymentMethodTypeBancontact -> "bancontact" + PaymentMethodTypeGiropay -> "giropay" + PaymentMethodTypeP24 -> "p24" + PaymentMethodTypeEPS -> "eps" + PaymentMethodTypeSepaDebit -> "sepa_debit" + in (("type", Text.encodeUtf8 typ) :) + + +instance ToStripeParam PaymentMethodTypes where + toStripeParam (PaymentMethodTypes pmts) = + let t pmt = case pmt of + 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) ++) + +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) = (toMetaData kvs ++) @@ -442,10 +547,22 @@ instance ToStripeParam RefundReason where RefundFraudulent -> "fraudulent" RefundRequestedByCustomer -> "requested_by_customer") :) +instance ToStripeParam SetupIntentId where + toStripeParam (SetupIntentId siid) = + (("setup_intent", Text.encodeUtf8 siid) :) + instance ToStripeParam StatementDescription where toStripeParam (StatementDescription txt) = (("statement_description", Text.encodeUtf8 txt) :) +instance ToStripeParam StatementDescriptor where + toStripeParam (StatementDescriptor txt) = + (("statement_descriptor", Text.encodeUtf8 txt) :) + +instance ToStripeParam StatementDescriptorSuffix where + toStripeParam (StatementDescriptorSuffix txt) = + (("statement_descriptor_suffix", Text.encodeUtf8 txt) :) + instance ToStripeParam TransactionType where toStripeParam txn = (("type", case txn of @@ -459,6 +576,9 @@ instance ToStripeParam TransactionType where TransferCancelTxn -> "transfer_cancel" TransferFailureTxn -> "transfer_failure") :) +instance ToStripeParam Confirm where + toStripeParam (Confirm conf) = + (("confirm", toBytestringLower conf) :) instance (ToStripeParam param) => ToStripeParam (StartingAfter param) where toStripeParam (StartingAfter param) = diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index 4e04192..a5465a1 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -6,6 +6,7 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} ------------------------------------------------------------------------------ -- | @@ -26,12 +27,15 @@ import Data.Aeson , Value(Bool, Object, String) , (.:) , (.:?) + , withObject + , withText ) import Data.Aeson.Types (typeMismatch) import Data.Data (Data, Typeable) import qualified Data.HashMap.Strict as H import Data.Ratio ((%)) import Data.Text (Text) +import qualified Data.Text as T import Data.Time (UTCTime) import Numeric (fromRat, showFFloat) import Text.Read (lexP, pfail) @@ -57,13 +61,17 @@ 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 RecipientId = Recipient +type instance ExpandsTo PaymentIntentId = PaymentIntent +type instance ExpandsTo PaymentMethodId = PaymentMethod type instance ExpandsTo RecipientCardId = RecipientCard +type instance ExpandsTo RecipientId = Recipient +type instance ExpandsTo SubscriptionId = Subscription type instance ExpandsTo TransactionId = BalanceTransaction ------------------------------------------------------------------------------ @@ -111,13 +119,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` @@ -127,6 +129,22 @@ newtype StatementDescription = instance FromJSON StatementDescription where parseJSON v = StatementDescription <$> parseJSON v +------------------------------------------------------------------------------ +-- | `StatementDescriptor` to be added to a `PaymentIntent` +newtype StatementDescriptor = + StatementDescriptor Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +instance FromJSON StatementDescriptor where + parseJSON v = StatementDescriptor <$> parseJSON v + +------------------------------------------------------------------------------ +-- | `StatementDescriptorSuffix` to be added to a `PaymentIntent` +newtype StatementDescriptorSuffix = + StatementDescriptorSuffix Text deriving (Read, Show, Eq, Ord, Data, Typeable) + +instance FromJSON StatementDescriptorSuffix where + parseJSON v = StatementDescriptorSuffix <$> parseJSON v + ------------------------------------------------------------------------------ -- | `Charge` object in `Stripe` API data Charge = Charge { @@ -144,7 +162,7 @@ data Charge = Charge { , chargeBalanceTransaction :: Maybe (Expandable TransactionId) , chargeFailureMessage :: Maybe Text , chargeFailureCode :: Maybe Text - , chargeAmountRefunded :: Int + , chargeAmountRefunded :: Int -- Is this a mistake? Not an Amount? , chargeCustomerId :: Maybe (Expandable CustomerId) , chargeInvoice :: Maybe (Expandable InvoiceId) , chargeDescription :: Maybe Description @@ -158,7 +176,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") @@ -182,7 +200,6 @@ instance FromJSON Charge where <*> o .:? "statement_description" <*> o .:? "receipt_email" <*> o .:? "receipt_number" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | Capture for `Charge` @@ -210,7 +227,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" @@ -219,7 +236,6 @@ instance FromJSON Refund where <*> o .: "charge" <*> o .:? "balance_transaction" <*> o .: "metadata" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `RefundApplicationFee` @@ -239,31 +255,26 @@ 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 data Customer = Customer { - customerObject :: Text - , customerCreated :: UTCTime - , customerId :: CustomerId - , customerLiveMode :: Bool - , customerDescription :: Maybe Description - , customerEmail :: Maybe Email - , customerDelinquent :: Bool - , customerSubscriptions :: Maybe (StripeList Subscription) - , customerDiscount :: Maybe Discount - , customerAccountBalance :: Int - , customerCards :: StripeList Card - , customerCurrency :: Maybe Currency - , customerDefaultCard :: Maybe (Expandable CardId) - , customerMetaData :: MetaData + customerObject :: Text + , customerCreated :: UTCTime + , customerId :: CustomerId + , customerLiveMode :: Bool + , customerDescription :: Maybe Description + , customerEmail :: Maybe Email + , customerDelinquent :: Bool + , customerSubscriptions :: Maybe (StripeList Subscription) + , customerDiscount :: Maybe Discount + , customerAccountBalance :: Int + , customerCards :: StripeList Card + , customerCurrency :: Maybe Currency + , customerDefaultCard :: Maybe (Expandable CardId) + , customerInvoiceSettings :: InvoiceSettings + , customerMetaData :: MetaData } | DeletedCustomer { deletedCustomer :: Bool , deletedCustomerId :: CustomerId @@ -272,8 +283,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 @@ -287,11 +298,11 @@ instance FromJSON Customer where <*> o .:? "subscriptions" <*> o .:? "discount" <*> o .: "account_balance" - <*> o .: "cards" + <*> o .: "sources" <*> o .:? "currency" - <*> o .:? "default_card" + <*> o .:? "default_source" + <*> o .: "invoice_settings" <*> o .: "metadata") - parseJSON o = typeMismatch "Customer" o ------------------------------------------------------------------------------ -- | AccountBalance for a `Customer` @@ -301,24 +312,22 @@ 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) +-- | InvoiceSettings for a `Customer` +data InvoiceSettings = InvoiceSettings { + invoiceSettingsDefaultPaymentMethod :: Maybe (Expandable PaymentMethodId) + } deriving (Read, Show, Eq, Ord, Data, Typeable) ------------------------------------------------------------------------------- --- | JSON Instance for `CardId` -instance FromJSON CardId where - parseJSON (String x) = pure $ CardId x - parseJSON _ = mzero +instance FromJSON InvoiceSettings where + parseJSON = withObject "InvoiceSettings" $ \o -> + InvoiceSettings <$> o .:? "default_payment_method" ------------------------------------------------------------------------------ --- | JSON Instance for `RecipientCardId` -instance FromJSON RecipientCardId where - parseJSON (String x) = pure $ RecipientCardId x - parseJSON _ = mzero +-- | CardId for a `Recipient` +newtype RecipientCardId = RecipientCardId Text + deriving (Eq, Ord, Read, Show, Data, Typeable, FromJSON) ------------------------------------------------------------------------------ -- | Number associated with a `Card` @@ -385,13 +394,21 @@ data Brand = instance FromJSON Brand where parseJSON = \case String "American Express" -> pure AMEX + String "amex" -> pure AMEX String "Diners Club" -> pure DinersClub + String "diners" -> pure DinersClub String "Discover" -> pure Discover + String "discover" -> pure Discover String "JCB" -> pure JCB + String "jcb" -> pure JCB String "MasterCard" -> pure MasterCard + String "mastercard" -> pure MasterCard String "UnionPay" -> pure UnionPay + String "unionpay" -> pure UnionPay String "Visa" -> pure Visa + String "visa" -> pure Visa String "Unknown" -> pure Unknown + String "unknown" -> pure Unknown brand -> fail $ "Failed to parse brand: " <> show brand ------------------------------------------------------------------------------ @@ -447,7 +464,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" @@ -469,12 +486,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" @@ -495,10 +511,38 @@ instance FromJSON RecipientCard where <*> o .:? "address_line1_check" <*> o .:? "address_zip_check" <*> o .:? "recipient" - parseJSON _ = mzero - ------------------------------------------------------------------------------ +-- | `Card` Hash - When embedded in a PaymentMethod +data CardHash = CardHash { + cardHashBrand :: Brand + , cardHashChecks :: Maybe TODO + , cardHashCountry :: Maybe Text + , cardHashExpMonth :: ExpMonth + , cardHashExpYear :: ExpYear + , cardHashFingerprint :: Maybe Text + , cardHashFunding :: Text + , cardHashGeneratedFrom :: Maybe TODO + , cardHashLastFour :: Text + , cardHashNetworks :: Maybe TODO + , cardHash3DSUsage :: Maybe TODO + } deriving (Read, Show, Eq, Ord, Data, Typeable) +------------------------------------------------------------------------------ +-- | JSON Instance for `Card` +instance FromJSON CardHash where + parseJSON = withObject "CardHash" $ \o -> + CardHash <$> o .: "brand" + <*> o .:? "checks" + <*> o .:? "country" + <*> (ExpMonth <$> o .: "exp_month") + <*> (ExpYear <$> o .: "exp_year") + <*> o .:? "fingerprint" + <*> o .: "funding" + <*> o .:? "generated_from" + <*>o .: "last4" + <*> o .:? "networks" + <*> o .:? "three_d_secure_usage" +------------------------------------------------------------------------------ -- | `NewCard` contains the data needed to create a new `Card` data NewCard = NewCard { newCardCardNumber :: CardNumber @@ -548,13 +592,98 @@ data DefaultCard = DefaultCard { getDefaultCard :: CardId } ------------------------------------------------------------------------------ -- | `SubscriptionId` for a `Subscription` newtype SubscriptionId = SubscriptionId { getSubscriptionId :: Text } - deriving (Read, Show, Eq, Ord, Data, Typeable) + deriving (Read, Show, Eq, Ord, Data, Typeable, FromJSON) + + +data Session = Session { + sessionId :: SessionId + , sessionCancelUrl :: CancelUrl + , sessionSuccessUrl :: SuccessUrl + , sessionLivemode :: Bool + , 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 (Maybe (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 -> 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 .:? "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 ) + +newtype SuccessUrl = SucessUrl { getSuccessUrl :: Text } + deriving (Read, Show, Eq, Ord, Data, Typeable, FromJSON) +newtype CancelUrl = CancelUrl { getCancelUrl :: Text } + deriving (Read, Show, Eq, Ord, Data, Typeable, FromJSON) + +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 + , lineItemName :: Text + , lineItemQuantity :: Int + , lineItemDescription :: Maybe Text + , lineItemImages :: Maybe [TODO] + } + deriving (Read, Show, Eq, Ord, Data, Typeable) ------------------------------------------------------------------------------- --- | JSON Instance for `SubscriptionId` -instance FromJSON SubscriptionId where - parseJSON (String x) = pure (SubscriptionId x) - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | Subscription Object @@ -582,7 +711,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" @@ -601,7 +730,6 @@ instance FromJSON Subscription where <*> o .:? "discount" <*> o .: "metadata" <*> o .:? "tax_percent" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | Status of a `Subscription` @@ -616,12 +744,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` @@ -652,7 +781,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") @@ -665,7 +794,6 @@ instance FromJSON Plan where <*> o .:? "trial_period_days" <*> o .: "metadata" <*> o .:? "statement_description" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `TrialPeriod` for a Plan @@ -683,11 +811,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` @@ -734,11 +863,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 @@ -761,7 +890,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" @@ -775,7 +904,6 @@ instance FromJSON Coupon where <*> o .:? "duration_in_months" <*> o .: "valid" <*> o .: "metadata" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `CouponId` for a `Coupon` @@ -830,31 +958,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 @@ -887,8 +1008,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") @@ -916,7 +1037,6 @@ instance FromJSON Invoice where <*> o .:? "statement_description" <*> o .:? "description" <*> o .: "metadata" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `InvoiceItemId` for `InvoiceItem` @@ -929,7 +1049,7 @@ newtype InvoiceItemId data InvoiceItem = InvoiceItem { invoiceItemObject :: Text , invoiceItemId :: InvoiceItemId - , invoiceItemDate :: UTCTime + , invoiceItemDate :: Maybe UTCTime , invoiceItemAmount :: Int , invoiceItemLiveMode :: Bool , invoiceItemProration :: Bool @@ -945,10 +1065,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" @@ -959,7 +1079,6 @@ instance FromJSON InvoiceItem where <*> (fmap Quantity <$> o .:? "quantity") <*> o .:? "subscription" <*> o .: "metadata" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `InvoiceLineItemId` for an `InvoiceLineItem` @@ -976,9 +1095,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 @@ -1007,15 +1127,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" @@ -1028,7 +1147,6 @@ instance FromJSON InvoiceLineItem where <*> o .:? "plan" <*> o .:? "description" <*> o .: "metadata" - parseJSON _ = mzero ------------------------------------------------------------------------------ @@ -1058,14 +1176,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` @@ -1083,14 +1202,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 @@ -1117,7 +1237,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") @@ -1131,7 +1251,6 @@ instance FromJSON Dispute where <*> (fromSeconds <$> o .: "evidence_due_by") <*> (fmap Evidence <$> o .:? "evidence") <*> o .: "metadata" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `TransferId` @@ -1143,6 +1262,7 @@ newtype TransferId = data TransferStatus = TransferPaid | TransferPending + | TransferInTransit | TransferCanceled | TransferFailed deriving (Read, Show, Eq, Ord, Data, Typeable) @@ -1157,17 +1277,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 @@ -1175,7 +1298,7 @@ data Transfer = Transfer { transferId :: TransferId , transferObject :: Text , transferCreated :: UTCTime - , transferDate :: UTCTime + , transferDate :: Maybe UTCTime , transferLiveMode :: Bool , transferAmount :: Int , transferCurrency :: Currency @@ -1194,11 +1317,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" @@ -1212,7 +1335,6 @@ instance FromJSON Transfer where <*> o .:? "statement_description" <*> o .:? "recipient" <*> o .: "metadata" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `BankAccount` Object @@ -1230,7 +1352,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" @@ -1239,7 +1361,6 @@ instance FromJSON BankAccount where <*> o .:? "status" <*> o .:? "fingerprint" <*> o .: "bank_name" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `BankAccountId` for `BankAccount` @@ -1304,13 +1425,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` @@ -1342,9 +1457,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 @@ -1369,7 +1485,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") @@ -1380,15 +1496,13 @@ instance FromJSON Recipient where <*> o .: "name" <*> o .: "verified" <*> o .:? "active_account" - <*> o .: "cards" - <*> o .:? "default_card" + <*> o .: "sources" + <*> o .:? "default_source" ) <|> DeletedRecipient <$> o .:? "deleted" <*> (RecipientId <$> o .: "id") - parseJSON _ = mzero - ------------------------------------------------------------------------------ -- | `PlanId` for a `Plan` newtype ApplicationFeeId = ApplicationFeeId Text deriving (Read, Show, Eq, Ord, Data, Typeable) @@ -1409,7 +1523,6 @@ data ApplicationFee = ApplicationFee { , applicationFeeAccountId :: Expandable AccountId , applicationFeeApplicationId :: ApplicationId , applicationFeeChargeId :: Expandable ChargeId - , applicationFeeMetaData :: MetaData } deriving (Read, Show, Eq, Ord, Data, Typeable) ------------------------------------------------------------------------------ @@ -1426,12 +1539,12 @@ 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` instance FromJSON ApplicationFee where - parseJSON (Object o) = + parseJSON = withObject "ApplicationFee" $ \o -> ApplicationFee <$> (ApplicationFeeId <$> o .: "id") <*> o .: "object" <*> (fromSeconds <$> o .: "created") @@ -1445,8 +1558,6 @@ instance FromJSON ApplicationFee where <*> o .: "account" <*> (ApplicationId <$> o .: "application") <*> o .: "charge" - <*> o .: "metadata" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `FeeId` for objects with Fees @@ -1470,7 +1581,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" @@ -1479,19 +1591,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 @@ -1517,7 +1622,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" @@ -1534,7 +1639,6 @@ instance FromJSON Account where <*> o .:? "business_url" <*> o .:? "business_logo" <*> o .:? "support_phone" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `Balance` Object @@ -1548,12 +1652,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 @@ -1565,10 +1668,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 @@ -1591,7 +1693,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" @@ -1605,18 +1707,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 @@ -1631,13 +1726,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 @@ -1659,15 +1753,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" @@ -1710,6 +1805,7 @@ data EventType = | CustomerDiscountCreatedEvent | CustomerDiscountUpdatedEvent | CustomerDiscountDeletedEvent + | CheckoutSessionCompletedEvent | InvoiceCreatedEvent | InvoiceUpdatedEvent | InvoicePaymentSucceededEvent @@ -1717,6 +1813,12 @@ data EventType = | InvoiceItemCreatedEvent | InvoiceItemUpdatedEvent | InvoiceItemDeletedEvent + | PaymentIntentAmountCapturableUpdated + | PaymentIntentCanceled + | PaymentIntentCreated + | PaymentIntentPaymentFailed + | PaymentIntentProcessing + | PaymentIntentSucceeded | PlanCreatedEvent | PlanUpdatedEvent | PlanDeletedEvent @@ -1732,66 +1834,136 @@ data EventType = | TransferPaidEvent | TransferFailedEvent | PingEvent - | UnknownEvent + | UnknownEvent Text deriving (Read, Show, Eq, Ord, Data, Typeable) ------------------------------------------------------------------------------ -- | 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 _ = pure UnknownEvent + 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 + "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 + "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" + 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" + 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` -newtype EventId = EventId Text deriving (Read, Show, Eq, Ord, Data, Typeable) +newtype EventId = EventId Text deriving (Read, Show, Eq, Ord, Data, Typeable, FromJSON) ------------------------------------------------------------------------------ -- | EventData @@ -1812,14 +1984,16 @@ data EventData = | SubscriptionEvent Subscription | DiscountEvent Discount | InvoiceItemEvent InvoiceItem - | UnknownEventData + | PaymentIntentEvent PaymentIntent + | CheckoutEvent Session + | UnknownEventData Value | Ping - deriving (Read, Show, Eq, Ord, Data, Typeable) + deriving (Read, Show, Eq, Data, Typeable) ------------------------------------------------------------------------------ -- | `Event` Object data Event = Event { - eventId :: Maybe EventId + eventId :: EventId , eventCreated :: UTCTime , eventLiveMode :: Bool , eventType :: EventType @@ -1827,19 +2001,19 @@ 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` instance FromJSON Event where - parseJSON (Object o) = do - eventId <- fmap EventId <$> o .:? "id" + parseJSON = withObject "Event" $ \o -> do + eventId <- EventId <$> o .: "id" eventCreated <- fromSeconds <$> o .: "created" 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" @@ -1869,6 +2043,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" @@ -1876,6 +2051,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" @@ -1891,12 +2072,316 @@ 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" return Event {..} - parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | `PaymentIntentId` for `PaymentIntent` +newtype PaymentIntentId = + PaymentIntentId { getPaymentIntentId :: Text } deriving (Read, Show, Eq, Ord, Data, Typeable, FromJSON) + +------------------------------------------------------------------------------ +-- | `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) + , paymentIntentInvoice :: Maybe (Expandable InvoiceId) + , paymentIntentLastPaymentError :: Maybe TODO + , paymentIntentLiveMode :: Maybe Bool + , paymentIntentMetadata :: Maybe MetaData + , paymentIntentNextAction :: Maybe TODO + , paymentIntentOnBehalfOf :: Maybe (Expandable AccountId) + , paymentIntentPaymentMethod :: Maybe (Expandable PaymentMethodId) + , paymentIntentPaymentOptions :: Maybe TODO + , paymentIntentPaymentMethodTypes :: [Text] + , paymentIntentReceiptEmail :: Maybe ReceiptEmail + , paymentIntentReview :: Maybe TODO + , paymentIntentSetupFutureUsage :: Maybe PaymentIntentUsage + , paymentIntentShipping :: Maybe TODO + , paymentIntentStatementDescriptor :: Maybe StatementDescriptor + , paymentIntentStatementDescriptorSuffix :: Maybe StatementDescriptorSuffix + , paymentIntentStatus :: IntentStatus + , 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 + <$> (PaymentIntentId <$> o .: "id") + <*> o .: "amount" + <*> o .:? "amount_capturable" + <*> o .:? "amount_received" + <*> o .:? "application" + <*> o .:? "application_fee_amount" + <*> (fmap fromSeconds <$> o .:? "canceled_at") + <*> o .:? "cancellation_reason" + <*> o .: "capture_method" + <*> o .:? "charges" + <*> o .:? "client_secret" + <*> o .: "confirmation_method" + <*> (fromSeconds <$> 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" + <*> (fmap ReceiptEmail <$> o .:? "receipt_email") + <*> o .:? "review" + <*> (fmap . fmap) PaymentIntentUsage (o .:? "setup_future_usage") + <*> o .:? "shipping" + <*> o .:? "statement_descriptor" + <*> o .:? "statement_descriptor_suffix" + <*> o .: "status" + <*> o .:? "transfer_data" + <*> o .:? "transfer_group" + + +newtype PaymentIntentUsage = PaymentIntentUsage Usage + deriving (Read, Show, Eq, Ord, Data, Typeable) + + +newtype SetupIntentUsage = SetupIntentUsage Usage + deriving (Read, Show, Eq, Ord, Data, Typeable) + + +data Usage = UseOnSession | UseOffSession + deriving (Read, Show, Eq, Ord, Data, Typeable) + +instance FromJSON Usage where + parseJSON = withText "Usage" $ \t -> case t of + "on_session" -> pure UseOnSession + "off_session" -> pure UseOffSession + _ -> fail $ "unknown Usage: " <> T.unpack t + + +newtype OffSession = OffSession Bool + deriving (Read, Show, Eq, Ord, Data, Typeable) + + +newtype Confirm = Confirm Bool + deriving (Read, Show, Eq, Ord, Data, Typeable) + + +------------------------------------------------------------------------------ +-- | `SetupIntentId` for `SetupIntent` +newtype SetupIntentId = + SetupIntentId { getSetupIntentId :: Text } deriving (Read, Show, Eq, Ord, Data, Typeable, FromJSON) + +------------------------------------------------------------------------------ +-- | `SetupIntent` Object +data SetupIntent = SetupIntent { + setupIntentId :: SetupIntentId + , setupIntentApplication :: Maybe (Expandable ApplicationId) + , setupIntentCancellationReason :: Maybe CancellationReason + , setupIntentClientSecret :: Maybe (Text) + , setupIntentCreated :: UTCTime + , setupIntentCustomer :: Maybe (Expandable CustomerId) + , setupIntentDescription :: Maybe Text + , setupIntentLastSetupError :: Maybe TODO + , setupIntentLiveMode :: Maybe Bool + , setupIntentMetadata :: Maybe MetaData + , setupIntentNextAction :: Maybe TODO + , setupIntentOnBehalfOf :: Maybe (Expandable AccountId) + , setupIntentPaymentMethod :: Maybe (Expandable PaymentMethodId) + , setupIntentPaymentOptions :: Maybe TODO + , setupIntentPaymentMethodTypes :: [Text] + , setupIntentSingleUseMandate :: Maybe TODO + , setupIntentStatus :: IntentStatus + , setupIntentUsage :: Maybe SetupIntentUsage + } deriving (Read, Show, Eq, Ord, Data, Typeable) + +------------------------------------------------------------------------------ +-- | JSON Instance for `SetupIntent` +instance FromJSON SetupIntent where + parseJSON = withObject "SetupIntent" $ \o -> + SetupIntent + <$> (SetupIntentId <$> o .: "id") + <*> o .:? "application" + <*> o .:? "cancellation_reason" + <*> o .:? "client_secret" + <*> (fromSeconds <$> o .: "created") + <*> o .:? "customer" + <*> o .:? "description" + <*> o .:? "last_setup_error" + <*> o .:? "live_mode" + <*> o .:? "metadata" + <*> o .:? "next_action" + <*> o .:? "on_behalf_of" + <*> o .:? "payment_method" + <*> o .:? "payment_options" + <*> o .: "payment_method_types" + <*> o .:? "single_use_mandate" + <*> o .: "status" + <*> (fmap.fmap) SetupIntentUsage (o .:? "usage") + + +data TODO = TODO + deriving (Read, Show, Eq, Ord, Data, Typeable) + +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 + | CancellationReasonRequestedByCustomer + | CancellationReasonAbandoned + | CancellationReasonFailedInvoice + | CancellationReasonVoidInvoice + | CancellationReasonAutomatic + deriving (Read, Show, Eq, Ord, Data, Typeable) + +instance FromJSON CancellationReason where + parseJSON = withText "CancellationReason" $ \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.unpack 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 + _ -> fail $ "Unknown CaptureMethod: " <> T.unpack t + +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 + _ -> fail $ "Unknown ConfirmationMethod: " <> T.unpack t + +data IntentStatus + = IntentStatusCanceled + | IntentStatusProcessing + | IntentStatusRequiresAction + | IntentStatusRequiresCapture + | IntentStatusRequiresConfirmation + | IntentStatusRequiresSource + | IntentStatusRequiresPaymentMethod + | IntentStatusSucceeded + deriving (Read, Show, Eq, Ord, Data, Typeable) + +instance FromJSON IntentStatus where + parseJSON = withText "IntentStatus" $ \t -> case t of + "canceled" -> pure IntentStatusCanceled + "processing" -> pure IntentStatusProcessing + "requires_action" -> pure IntentStatusRequiresAction + "requires_capture" -> pure IntentStatusRequiresCapture + "requires_confirmation" -> pure IntentStatusRequiresConfirmation + "requires_payment_method" -> pure IntentStatusRequiresPaymentMethod + "requires_source" -> pure IntentStatusRequiresSource + "succeeded" -> pure IntentStatusSucceeded + _ -> fail $ "Unknown IntentStatus: " <> T.unpack t + +newtype PaymentMethodId = PaymentMethodId { getPaymentMethodId :: Text } + deriving (Read, Show, Eq, Ord, Data, Typeable) + +instance FromJSON PaymentMethodId where + parseJSON = withText "PaymentMethodId" $ \t -> + return $ PaymentMethodId t + +data PaymentMethod = PaymentMethod { + paymentMethodId :: PaymentMethodId + , paymentMethodBillingDetails :: TODO + , paymentMethodCard :: Maybe CardHash + , paymentMethodCardPresent :: Maybe TODO + , paymentMethodCreated :: UTCTime + , paymentMethodCustomer :: Maybe (Expandable CustomerId) + , paymentMethodLiveMode :: Bool + , paymentMethodType :: PaymentMethodType + } deriving (Read, Show, Eq, Ord, Data, Typeable) + +data PaymentMethodType + = PaymentMethodTypeCard + | PaymentMethodTypeCardPresent + | PaymentMethodTypeIdeal + | PaymentMethodTypeFPX + | PaymentMethodTypeBacsDebit + | PaymentMethodTypeBancontact + | PaymentMethodTypeGiropay + | PaymentMethodTypeP24 + | PaymentMethodTypeEPS + | PaymentMethodTypeSepaDebit + deriving (Read, Show, Eq, Ord, Data, Typeable) + +instance FromJSON PaymentMethodType where + parseJSON = withText "PaymentMethodType" $ \t -> case t of + "card" -> pure PaymentMethodTypeCard + "ideal" -> pure PaymentMethodTypeIdeal + "fpx" -> pure PaymentMethodTypeFPX + "bacs_debit" -> pure PaymentMethodTypeBacsDebit + "bancontact" -> pure PaymentMethodTypeBancontact + "giropay" -> pure PaymentMethodTypeGiropay + "p24" -> pure PaymentMethodTypeP24 + "sepa_debit" -> pure PaymentMethodTypeSepaDebit + _ -> fail $ "Unknown PaymentMethodType: " <> T.unpack t + + +------------------------------------------------------------------------------ +-- | JSON Instance for `PaymentMethod` +instance FromJSON PaymentMethod where + parseJSON = withObject "PaymentMethod" $ \o -> + PaymentMethod + <$> (PaymentMethodId <$> o .: "id") + <*> o .: "billing_details" + <*> o .:? "card" + <*> o .:? "card_present" + <*> (fromSeconds <$> o .: "created") + <*> o .:? "customer" + <*> o .: "livemode" + <*> o .: "type" ------------------------------------------------------------------------------ -- | Connect Application @@ -1909,11 +2394,15 @@ 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 + +------------------------------------------------------------------------------ +-- | Wrapper for `TokenId` `PaymentMethod` param +newtype CardToken = CardToken TokenId + deriving (Read, Show, Eq, Ord, Data, Typeable) ------------------------------------------------------------------------------ -- | `TokenId` of a `Token` @@ -1930,9 +2419,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 @@ -1949,7 +2439,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" @@ -1964,9 +2454,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 @@ -1981,13 +2470,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` @@ -2014,10 +2502,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 @@ -2086,6 +2573,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 = @@ -2402,7 +2893,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") @@ -2424,7 +2915,6 @@ instance FromJSON BitcoinReceiver where <*> o .:? "transactions" <*> (fmap PaymentId <$> o .:? "payment") <*> (fmap CustomerId <$> o .:? "customer") - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | Bitcoin Transactions @@ -2462,7 +2952,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") @@ -2470,41 +2960,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 diff --git a/stripe-core/src/Web/Stripe/Util.hs b/stripe-core/src/Web/Stripe/Util.hs index fa51707..0e3bb6f 100644 --- a/stripe-core/src/Web/Stripe/Util.hs +++ b/stripe-core/src/Web/Stripe/Util.hs @@ -14,6 +14,8 @@ module Web.Stripe.Util , toTextLower , getParams , toBytestring + , toBytestringLower + , encodeList , () , toMetaData , toExpandable @@ -22,6 +24,7 @@ module Web.Stripe.Util import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B8 import Data.Monoid (Monoid, mconcat, mempty, (<>)) +import qualified Data.Char as Char import Data.String (IsString) import Data.Text (Text) import qualified Data.Text as T @@ -92,6 +95,20 @@ getParams xs = [ (x, T.encodeUtf8 y) | (x, Just y) <- xs ] toBytestring :: Show a => a -> ByteString toBytestring = B8.pack . show +------------------------------------------------------------------------------ +-- | Convert APITVersion to a ByteString - for, e.g., Boolean -> "true" or "false" +toBytestringLower :: Show a => a -> ByteString +toBytestringLower = B8.pack . map Char.toLower . show + +------------------------------------------------------------------------------ +-- | EncodeList +encodeList :: Text -> [a] -> (a -> [(ByteString, ByteString)]) -> [(ByteString, ByteString)] +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)] diff --git a/stripe-core/stripe-core.cabal b/stripe-core/stripe-core.cabal index 32f6d34..32c8b82 100644 --- a/stripe-core/stripe-core.cabal +++ b/stripe-core/stripe-core.cabal @@ -1,5 +1,5 @@ name: stripe-core -version: 2.6.2 +version: 2.7.2 synopsis: Stripe API for Haskell - Pure Core license: MIT license-file: LICENSE @@ -47,9 +47,13 @@ library Web.Stripe.Event Web.Stripe.Invoice Web.Stripe.InvoiceItem + Web.Stripe.PaymentIntent + Web.Stripe.PaymentMethod Web.Stripe.Plan Web.Stripe.Recipient Web.Stripe.Refund + Web.Stripe.Session + Web.Stripe.SetupIntent Web.Stripe.StripeRequest Web.Stripe.Subscription Web.Stripe.Token diff --git a/stripe-haskell/stripe-haskell.cabal b/stripe-haskell/stripe-haskell.cabal index a0553fc..edb9fd8 100644 --- a/stripe-haskell/stripe-haskell.cabal +++ b/stripe-haskell/stripe-haskell.cabal @@ -1,5 +1,5 @@ name: stripe-haskell -version: 2.6.2 +version: 2.7.2 synopsis: Stripe API for Haskell license: MIT license-file: LICENSE 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 = diff --git a/stripe-http-client/stripe-http-client.cabal b/stripe-http-client/stripe-http-client.cabal index 68f4dc1..f9fe9bd 100644 --- a/stripe-http-client/stripe-http-client.cabal +++ b/stripe-http-client/stripe-http-client.cabal @@ -1,5 +1,5 @@ name: stripe-http-client -version: 2.6.2 +version: 2.7.0 license: MIT license-file: LICENSE author: Christopher Reichert diff --git a/stripe-http-streams/stripe-http-streams.cabal b/stripe-http-streams/stripe-http-streams.cabal index 6248620..8003f73 100644 --- a/stripe-http-streams/stripe-http-streams.cabal +++ b/stripe-http-streams/stripe-http-streams.cabal @@ -1,5 +1,5 @@ name: stripe-http-streams -version: 2.5.0 +version: 2.7.0 license: MIT license-file: LICENSE author: David Johnson, Jeremy Shaw diff --git a/stripe-tests/stripe-tests.cabal b/stripe-tests/stripe-tests.cabal index 35d64dc..d45f5c1 100644 --- a/stripe-tests/stripe-tests.cabal +++ b/stripe-tests/stripe-tests.cabal @@ -1,5 +1,5 @@ name: stripe-tests -version: 2.6.2 +version: 2.7.2 synopsis: Tests for Stripe API bindings for Haskell license: MIT license-file: LICENSE @@ -27,7 +27,7 @@ library , bytestring >= 0.10 && < 0.11 , free >= 4.10 && < 6 , mtl >= 2.1.2 && < 2.3 - , random >= 1.1 && < 1.2 + , random >= 1.1 && < 1.3 , hspec >= 2.1.0 && < 2.8 , hspec-core >= 2.1.0 && < 2.8 , stripe-core @@ -52,10 +52,13 @@ library Web.Stripe.Test.Event Web.Stripe.Test.Invoice Web.Stripe.Test.InvoiceItem + Web.Stripe.Test.PaymentIntent + Web.Stripe.Test.PaymentMethod Web.Stripe.Test.Plan Web.Stripe.Test.Prelude Web.Stripe.Test.Recipient Web.Stripe.Test.Refund + Web.Stripe.Test.SetupIntent Web.Stripe.Test.Subscription Web.Stripe.Test.Token Web.Stripe.Test.Transfer diff --git a/stripe-tests/tests/Web/Stripe/Test/AllTests.hs b/stripe-tests/tests/Web/Stripe/Test/AllTests.hs index 8f5bced..3d9a12b 100644 --- a/stripe-tests/tests/Web/Stripe/Test/AllTests.hs +++ b/stripe-tests/tests/Web/Stripe/Test/AllTests.hs @@ -18,8 +18,11 @@ import Web.Stripe.Test.Discount (discountTests) import Web.Stripe.Test.Dispute (disputeTests) import Web.Stripe.Test.Invoice (invoiceTests) import Web.Stripe.Test.InvoiceItem (invoiceItemTests) +import Web.Stripe.Test.PaymentIntent (paymentIntentTests) +import Web.Stripe.Test.PaymentMethod (paymentMethodTests) import Web.Stripe.Test.Plan (planTests) import Web.Stripe.Test.Recipient (recipientTests) +import Web.Stripe.Test.SetupIntent (setupIntentTests) import Web.Stripe.Test.Refund (refundTests) import Web.Stripe.Test.Subscription (subscriptionTests) import Web.Stripe.Test.Token (tokenTests) @@ -54,5 +57,8 @@ allTests stripe' = do balanceTests stripe tokenTests stripe eventTests stripe + paymentIntentTests stripe + setupIntentTests stripe + paymentMethodTests stripe diff --git a/stripe-tests/tests/Web/Stripe/Test/Balance.hs b/stripe-tests/tests/Web/Stripe/Test/Balance.hs index 58ea15a..4227ce0 100644 --- a/stripe-tests/tests/Web/Stripe/Test/Balance.hs +++ b/stripe-tests/tests/Web/Stripe/Test/Balance.hs @@ -48,6 +48,6 @@ balanceTests stripe = do where cn = CardNumber "4242424242424242" em = ExpMonth 12 - ey = ExpYear 2020 + ey = ExpYear 2023 cvc = CVC "123" diff --git a/stripe-tests/tests/Web/Stripe/Test/Card.hs b/stripe-tests/tests/Web/Stripe/Test/Card.hs index 251b65b..a0d4a94 100644 --- a/stripe-tests/tests/Web/Stripe/Test/Card.hs +++ b/stripe-tests/tests/Web/Stripe/Test/Card.hs @@ -233,7 +233,7 @@ cardTests stripe = do credit = CardNumber "4242424242424242" debit = CardNumber "4000056655665556" em = ExpMonth 12 - ey = ExpYear 2020 + ey = ExpYear 2023 cvc = CVC "123" country = Country "US" routingnumber = RoutingNumber "110000000" diff --git a/stripe-tests/tests/Web/Stripe/Test/Charge.hs b/stripe-tests/tests/Web/Stripe/Test/Charge.hs index 3431adc..17a2459 100644 --- a/stripe-tests/tests/Web/Stripe/Test/Charge.hs +++ b/stripe-tests/tests/Web/Stripe/Test/Charge.hs @@ -9,11 +9,16 @@ import Test.Hspec import Web.Stripe.Charge import Web.Stripe.Customer import Web.Stripe.Test.Prelude +import Web.Stripe.Card +import Web.Stripe.PaymentMethod +import Web.Stripe.StripeRequest (Expandable (Id)) +import Web.Stripe.Token chargeTests :: StripeSpec chargeTests stripe = describe "Charge tests" $ do chargeCustomerTest + chargeCustomerTest2 retrieveChargeTest updateChargeTest retrieveExpandedChargeTest @@ -22,7 +27,7 @@ chargeTests stripe = where cn = CardNumber "4242424242424242" em = ExpMonth 12 - ey = ExpYear 2020 + ey = ExpYear 2023 cvc = CVC "123" cardinfo = (mkNewCard cn em ey) { newCardCVC = Just cvc } chargeCustomerTest = @@ -32,6 +37,14 @@ chargeTests stripe = charge <- createCharge (Amount 100) USD -&- cid void $ deleteCustomer cid return charge + result `shouldSatisfy` isLeft + chargeCustomerTest2 = + it "Charges a customer's card succesfully" $ do + result <- stripe $ do + (cid, PaymentMethod { paymentMethodId = pmid }) <- attachTestPaymentMethod + charge <- createCharge (Amount 100) USD -&- cid -&- (Source pmid) + void $ deleteCustomer cid + return charge result `shouldSatisfy` isRight retrieveChargeTest = it "Retrieves a charge succesfully" $ do @@ -88,3 +101,30 @@ chargeTests stripe = result `shouldSatisfy` isRight let Right Charge { chargeCaptured = captured } = result captured `shouldBe` True + + +attachTestPaymentMethod = do + Customer { customerId = cid } <- createCustomer + pm <- createPaymentMethod cardinfo + pm' <- attachPaymentMethod (paymentMethodId pm) cid + return (cid, pm') + + where + cardinfo = (mkNewCard credit em ey) { newCardCVC = Just cvc } + debitinfo = (mkNewCard debit em ey) { newCardCVC = Just cvc } + credit = CardNumber "4242424242424242" + debit = CardNumber "4000056655665556" + em = ExpMonth 12 + ey = ExpYear 2023 + cvc = CVC "123" + country = Country "US" + routingnumber = RoutingNumber "110000000" + accountnumber = AccountNumber "000123456789" + name = Name "David Johnson" + cardname = Name "cardName" + cardcity = AddressCity "Chicago" + cardcountry = AddressCountry "US" + cardaddressOne = AddressLine1 "123 Fake Street" + cardaddressTwo = AddressLine2 "456 Fake Street" + cardaddressState = AddressState "IL" + cardzip = AddressZip "60610" diff --git a/stripe-tests/tests/Web/Stripe/Test/Dispute.hs b/stripe-tests/tests/Web/Stripe/Test/Dispute.hs index b9fe598..306bd69 100644 --- a/stripe-tests/tests/Web/Stripe/Test/Dispute.hs +++ b/stripe-tests/tests/Web/Stripe/Test/Dispute.hs @@ -89,7 +89,7 @@ disputeTests stripe = do where cn = CardNumber "4000000000000259" em = ExpMonth 12 - ey = ExpYear 2020 + ey = ExpYear 2023 cvc = CVC "123" win = Evidence "winning_evidence" lose = Evidence "losing_evidence" diff --git a/stripe-tests/tests/Web/Stripe/Test/Invoice.hs b/stripe-tests/tests/Web/Stripe/Test/Invoice.hs index c1c926c..12c9a49 100644 --- a/stripe-tests/tests/Web/Stripe/Test/Invoice.hs +++ b/stripe-tests/tests/Web/Stripe/Test/Invoice.hs @@ -117,5 +117,5 @@ invoiceTests stripe = do meta = MetaData [ ("some","metadata") ] credit = CardNumber "4242424242424242" em = ExpMonth 12 - ey = ExpYear 2020 + ey = ExpYear 2023 cvc = CVC "123" diff --git a/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs b/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs new file mode 100644 index 0000000..ceb496a --- /dev/null +++ b/stripe-tests/tests/Web/Stripe/Test/PaymentIntent.hs @@ -0,0 +1,112 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RebindableSyntax #-} +{-# LANGUAGE RankNTypes #-} +module Web.Stripe.Test.PaymentIntent where + +import Data.Either (Either(..), isRight) +import Test.Hspec +import Web.Stripe.Test.Util (makePlanId) +import Web.Stripe.Test.Prelude + +import Web.Stripe.PaymentIntent +import Web.Stripe.Card +import Web.Stripe.PaymentMethod +import Web.Stripe.Customer +import Web.Stripe.Token + +paymentIntentTests :: StripeSpec +paymentIntentTests stripe = do + describe "Payment intent tests" $ do + it "Succesfully creates a PaymentIntent" $ do + result <- stripe $ do + paymentIntent <- createPaymentIntent (Amount 100) USD -&- (PaymentIntentUsage UseOffSession) + void $ cancelPaymentIntent (paymentIntentId paymentIntent) + return paymentIntent + result `shouldSatisfy` isRight + it "Succesfully creates a PaymentIntent and immediately confirms" $ do + result <- stripe $ do + PaymentMethod { paymentMethodId = pmid } <- createPaymentMethod cardinfo + paymentIntent <- createPaymentIntent (Amount 100) USD + -&- Confirm True + -&- pmid + return paymentIntent + result `shouldSatisfy` isRight + it "Succesfully creates a second PaymentIntent and confirms off-session" $ do + result <- stripe $ do + Customer { customerId = cid } <- createCustomer + PaymentMethod { paymentMethodId = pmid } <- createPaymentMethod cardinfo + paymentIntent <- createPaymentIntent (Amount 100) USD + -&- pmid + -&- cid + -&- PaymentIntentUsage UseOffSession + void $ confirmPaymentIntent (paymentIntentId paymentIntent) + newPaymentIntent <- createPaymentIntent (Amount 100) USD + -&- pmid + -&- cid + newConfirmedPaymentIntent <- + confirmPaymentIntent (paymentIntentId newPaymentIntent) + -&- OffSession True + return newConfirmedPaymentIntent + result `shouldSatisfy` isRight + it "Successfully updates a PaymentIntent" $ do + result <- stripe $ do + paymentIntent <- createPaymentIntent (Amount 100) USD + Customer { customerId = cid } <- createCustomer + updatedPaymentIntent <- + updatePaymentIntent (paymentIntentId paymentIntent) + -&- (Amount 100) -&- USD + -&- cid + -&- Description "some description" + -&- (PaymentIntentUsage UseOffSession) + void $ cancelPaymentIntent (paymentIntentId paymentIntent) + void $ deleteCustomer cid + return updatedPaymentIntent + result `shouldSatisfy` isRight + it "Successfully cancels a PaymentIntent" $ do + result <- stripe $ do + paymentIntent <- createPaymentIntent (Amount 100) USD + cancelledPaymentIntent <- cancelPaymentIntent (paymentIntentId paymentIntent) + return cancelledPaymentIntent + result `shouldSatisfy` isRight + it "Successfully gets a PaymentIntent"$ do + result <- stripe $ do + paymentIntent <- createPaymentIntent (Amount 100) USD + paymentIntent' <- getPaymentIntent (paymentIntentId paymentIntent) + void $ cancelPaymentIntent (paymentIntentId paymentIntent) + return paymentIntent' + result `shouldSatisfy` isRight + it "Successfully confirms a PaymentIntent"$ do + result <- stripe $ do + Customer { customerId = cid } <- createCustomer + paymentIntent <- createPaymentIntent (Amount 100) USD -&- cid + Token { tokenId = tkid } <- createCardToken (Just cardinfo) + Card { cardId = CardId cardid } <- createCustomerCardByToken cid tkid + confirmedPaymentIntent <- + confirmPaymentIntent (paymentIntentId paymentIntent) -&- (PaymentMethodId cardid) + void $ deleteCustomer cid + return confirmedPaymentIntent + result `shouldSatisfy` isRight + {- need to do a separate authorization and capture to test this + https://stripe.com/docs/payments/capture-later + it "Successfully captures a PaymentIntent"$ do + result <- stripe $ do + Customer { customerId = cid } <- createCustomer + paymentIntent <- createPaymentIntent (Amount 100) USD -&- cid + Token { tokenId = tkid } <- createCardToken (Just cardinfo) + Card { cardId = CardId cardid } <- createCustomerCardByToken cid tkid + capturedPaymentIntent <- capturePaymentIntent (paymentIntentId paymentIntent) + void $ deleteCustomer cid + return capturedPaymentIntent + result `shouldSatisfy` isRight -} + it "Successfully gets all PaymentIntents"$ do + result <- stripe $ do + paymentIntents <- getPaymentIntents + return paymentIntents + result `shouldSatisfy` isRight + + where + cardinfo = (mkNewCard credit em ey) { newCardCVC = Just cvc } + credit = CardNumber "4242424242424242" + em = ExpMonth 12 + ey = ExpYear 2023 + cvc = CVC "123" diff --git a/stripe-tests/tests/Web/Stripe/Test/PaymentMethod.hs b/stripe-tests/tests/Web/Stripe/Test/PaymentMethod.hs new file mode 100644 index 0000000..c3d7d4a --- /dev/null +++ b/stripe-tests/tests/Web/Stripe/Test/PaymentMethod.hs @@ -0,0 +1,133 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RebindableSyntax #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RankNTypes #-} +module Web.Stripe.Test.PaymentMethod where + +import Data.Either +import Data.Maybe +import Test.Hspec +import Web.Stripe.Card +import Web.Stripe.PaymentMethod +import Web.Stripe.Customer +import Web.Stripe.StripeRequest (Expandable (Id)) +import Web.Stripe.Test.Prelude +import Web.Stripe.Token + +paymentMethodTests :: StripeSpec +paymentMethodTests stripe = do + describe "Card tests" $ do + it "can create a payment method by CardNumber" $ do + result <- stripe $ do + pm <- createPaymentMethod cardinfo + return pm + result `shouldSatisfy` isRight + + it "can create a payment method by TokenId" $ do + result <- stripe $ do + Token { tokenId = tkid } <- createCardToken (Just cardinfo) + pm <- createPaymentMethodByToken tkid (PaymentMethodTypeCard) + return pm + result `shouldSatisfy` isRight + + it "can attach a card to a customer" $ do + result <- stripe $ do + Customer { customerId = cid } <- createCustomer + pm <- createPaymentMethod cardinfo + pm' <- attachPaymentMethod (paymentMethodId pm) cid + void $ deleteCustomer cid + return pm' + result `shouldSatisfy` isRight + + it "Can retrieve a payment method" $ do + result <- stripe $ do + PaymentMethod { paymentMethodId = pmid }<- createPaymentMethod cardinfo + pm <- getPaymentMethod pmid + return pm + result `shouldSatisfy` isRight + let Right pm = result + cardHashLastFour <$> paymentMethodCard pm `shouldBe` Just "4242" + cardHashExpMonth <$> paymentMethodCard pm `shouldBe` Just em + cardHashExpYear <$> paymentMethodCard pm `shouldBe` Just ey + + it "Can retrieve a Customer's Cards" $ do + result <- stripe $ do + Customer { customerId = customerid + } <- createCustomer + pm <- createPaymentMethod cardinfo + pm' <- attachPaymentMethod (paymentMethodId pm) customerid + pms <- getCustomerPaymentMethods customerid + void $ deleteCustomer customerid + return pms + result `shouldSatisfy` isRight + +{- + it "Can retrieve a Customer's Card with expansion" $ do + result <- stripe $ do + Customer { customerId = customerid + , customerCards = StripeList { list = [ Card { cardId = cardid } ] } + } <- createCustomer -&- cardinfo + card <- getCustomerCard customerid cardid -&- ExpandParams ["customer"] + void $ deleteCustomer customerid + return card + result `shouldSatisfy` isRight + let Right Card{..} = result + cardLastFour `shouldBe` "4242" + cardExpMonth `shouldBe` em + cardExpYear `shouldBe` ey +-} + + it "Can detach a Customer's Cards" $ do + result <- stripe $ do + Customer { customerId = customerid } <- createCustomer + PaymentMethod { paymentMethodId = pmid }<- createPaymentMethod cardinfo + pm <- attachPaymentMethod pmid customerid + result <- detachPaymentMethod pmid + void $ deleteCustomer customerid + return result + result `shouldSatisfy` isRight +{- + it "Can update a Customer's Card" $ do + result <- stripe $ do + Customer { customerId = customerid + , customerDefaultCard = Just (Id cardid) + } <- createCustomer -&- cardinfo + result <- updateCustomerCard customerid cardid + -&- cardname + -&- cardcity + -&- cardcountry + -&- cardaddressOne + -&- cardaddressTwo + -&- cardaddressState + -&- cardzip + void $ deleteCustomer customerid + return result + result `shouldSatisfy` isRight + let Right Card{..} = result + cardName `shouldBe` (Just cardname) + cardAddressCity `shouldBe` (Just cardcity) + cardAddressCountry `shouldBe` (Just cardcountry) + cardAddressLine1 `shouldBe` (Just cardaddressOne) + cardAddressLine2 `shouldBe` (Just cardaddressTwo) + cardAddressState `shouldBe` (Just cardaddressState) + cardAddressZip `shouldBe` (Just cardzip) -} + + where + cardinfo = (mkNewCard credit em ey) { newCardCVC = Just cvc } + debitinfo = (mkNewCard debit em ey) { newCardCVC = Just cvc } + credit = CardNumber "4242424242424242" + debit = CardNumber "4000056655665556" + em = ExpMonth 12 + ey = ExpYear 2023 + cvc = CVC "123" + country = Country "US" + routingnumber = RoutingNumber "110000000" + accountnumber = AccountNumber "000123456789" + name = Name "David Johnson" + cardname = Name "cardName" + cardcity = AddressCity "Chicago" + cardcountry = AddressCountry "US" + cardaddressOne = AddressLine1 "123 Fake Street" + cardaddressTwo = AddressLine2 "456 Fake Street" + cardaddressState = AddressState "IL" + cardzip = AddressZip "60610" diff --git a/stripe-tests/tests/Web/Stripe/Test/Prelude.hs b/stripe-tests/tests/Web/Stripe/Test/Prelude.hs index 0c74001..d71f83e 100644 --- a/stripe-tests/tests/Web/Stripe/Test/Prelude.hs +++ b/stripe-tests/tests/Web/Stripe/Test/Prelude.hs @@ -10,6 +10,7 @@ {-# LANGUAGE RankNTypes #-} module Web.Stripe.Test.Prelude ( ($) + , (<$>) , (-&-) , Char , Functor @@ -36,6 +37,7 @@ module Web.Stripe.Test.Prelude , Stripe , StripeRequestF(..) , StripeSpec + , Conf ) where import Data.Aeson (Value, Result(..), FromJSON, fromJSON) @@ -43,7 +45,7 @@ import Data.Either (Either) import Data.String (fromString) import Data.Maybe (Maybe(..)) import GHC.Num (fromInteger) -import Prelude (Bool(..), Eq(..), Functor(..), ($), IO, Char, String, error, undefined, (.), id, length) +import Prelude (Bool(..), Eq(..), Functor(..), ($), (<$>), IO, Char, String, error, undefined, (.), id, length) import Test.Hspec import Test.Hspec.Core.Spec (SpecM) import qualified Control.Monad as M @@ -52,6 +54,9 @@ import qualified Control.Monad.Trans as M import Control.Monad.Trans.Free (FreeT(..), liftF) import Web.Stripe.Client + +type Conf = forall a. StripeConfig -> Stripe a -> IO (Either StripeError a) + ------------------------------------------------------------------------------ -- Stripe free monad diff --git a/stripe-tests/tests/Web/Stripe/Test/Refund.hs b/stripe-tests/tests/Web/Stripe/Test/Refund.hs index 407853b..7e8c5f5 100644 --- a/stripe-tests/tests/Web/Stripe/Test/Refund.hs +++ b/stripe-tests/tests/Web/Stripe/Test/Refund.hs @@ -20,7 +20,7 @@ em :: ExpMonth em = ExpMonth 12 ey :: ExpYear -ey = ExpYear 2020 +ey = ExpYear 2023 cvc :: CVC cvc = CVC "123" diff --git a/stripe-tests/tests/Web/Stripe/Test/SetupIntent.hs b/stripe-tests/tests/Web/Stripe/Test/SetupIntent.hs new file mode 100644 index 0000000..5cf2efe --- /dev/null +++ b/stripe-tests/tests/Web/Stripe/Test/SetupIntent.hs @@ -0,0 +1,106 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RebindableSyntax #-} +{-# LANGUAGE RankNTypes #-} +module Web.Stripe.Test.SetupIntent where + +import Data.Either (Either(..), isRight) +import Test.Hspec +import Web.Stripe.Test.Util (makePlanId) +import Web.Stripe.Test.Prelude + +import Web.Stripe.SetupIntent +import Web.Stripe.PaymentIntent +import Web.Stripe.Card +import Web.Stripe.Customer +import Web.Stripe.Token + +setupIntentTests :: StripeSpec +setupIntentTests stripe = do + describe "Setup intent tests" $ do + it "Succesfully creates a SetupIntent" $ do + result <- stripe $ do + setupIntent <- createSetupIntent -&- (SetupIntentUsage UseOffSession) + void $ cancelSetupIntent (setupIntentId setupIntent) + return setupIntent + result `shouldSatisfy` isRight + it "Successfully updates a SetupIntent" $ do + result <- stripe $ do + setupIntent <- createSetupIntent + Customer { customerId = cid } <- createCustomer + Token { tokenId = tkid } <- createCardToken (Just cardinfo) + Card { cardId = CardId cardid } <- createCustomerCardByToken cid tkid + updatedSetupIntent <- + updateSetupIntent (setupIntentId setupIntent) + -&- cid + -&- Description "some description" + -&- PaymentMethodId cardid + void $ cancelSetupIntent (setupIntentId setupIntent) + void $ deleteCustomer cid + return updatedSetupIntent + result `shouldSatisfy` isRight + it "Successfully cancels a SetupIntent" $ do + result <- stripe $ do + setupIntent <- createSetupIntent + cancelledSetupIntent <- cancelSetupIntent (setupIntentId setupIntent) + return cancelledSetupIntent + result `shouldSatisfy` isRight + it "Successfully gets a SetupIntent"$ do + result <- stripe $ do + setupIntent <- createSetupIntent + setupIntent' <- getSetupIntent (setupIntentId setupIntent) + void $ cancelSetupIntent (setupIntentId setupIntent) + return setupIntent' + result `shouldSatisfy` isRight + it "Successfully confirms a SetupIntent"$ do + result <- stripe $ do + Customer { customerId = cid } <- createCustomer + setupIntent <- createSetupIntent -&- cid + Token { tokenId = tkid } <- createCardToken (Just cardinfo) + Card { cardId = CardId cardid } <- createCustomerCardByToken cid tkid + confirmedSetupIntent <- + confirmSetupIntent (setupIntentId setupIntent) -&- (PaymentMethodId cardid) + void $ deleteCustomer cid + return confirmedSetupIntent + result `shouldSatisfy` isRight + it "Successfully confirms a SetupIntent and charges off-session"$ do + result <- stripe $ do + Customer { customerId = cid } <- createCustomer + setupIntent <- createSetupIntent -&- cid + -&- SetupIntentUsage UseOffSession + Token { tokenId = tkid } <- createCardToken (Just cardinfo) + Card { cardId = CardId cardid } <- createCustomerCardByToken cid tkid + confirmedSetupIntent <- + confirmSetupIntent (setupIntentId setupIntent) + -&- PaymentMethodId cardid + paymentIntent <- createPaymentIntent (Amount 100) USD + -&- PaymentMethodId cardid + -&- OffSession True + -&- cid + -&- Confirm True + void $ deleteCustomer cid + return paymentIntent + result `shouldSatisfy` isRight + {- need to do a separate authorization and capture to test this + https://stripe.com/docs/payments/capture-later + it "Successfully captures a SetupIntent"$ do + result <- stripe $ do + Customer { customerId = cid } <- createCustomer + setupIntent <- createSetupIntent (Amount 100) USD -&- cid + Token { tokenId = tkid } <- createCardToken (Just cardinfo) + Card { cardId = CardId cardid } <- createCustomerCardByToken cid tkid + capturedSetupIntent <- captureSetupIntent (setupIntentId setupIntent) + void $ deleteCustomer cid + return capturedSetupIntent + result `shouldSatisfy` isRight -} + it "Successfully gets all SetupIntents"$ do + result <- stripe $ do + setupIntents <- getSetupIntents + return setupIntents + result `shouldSatisfy` isRight + + where + cardinfo = (mkNewCard credit em ey) { newCardCVC = Just cvc } + credit = CardNumber "4242424242424242" + em = ExpMonth 12 + ey = ExpYear 2023 + cvc = CVC "123" diff --git a/stripe-tests/tests/Web/Stripe/Test/Token.hs b/stripe-tests/tests/Web/Stripe/Test/Token.hs index 048113e..d5e84bb 100644 --- a/stripe-tests/tests/Web/Stripe/Test/Token.hs +++ b/stripe-tests/tests/Web/Stripe/Test/Token.hs @@ -32,7 +32,7 @@ tokenTests stripe = do where cn = CardNumber "4242424242424242" em = ExpMonth 12 - ey = ExpYear 2020 + ey = ExpYear 2023 cvc = CVC "123" cardinfo = (mkNewCard cn em ey) { newCardCVC = Just cvc } bankinfo = NewBankAccount