diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 0000000..89523f6 --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,12 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: [] +snapshots: +- completed: + size: 535471 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/9/5.yaml + sha256: 452763f820c6cf01f7c917c71dd4e172578d7e53a7763bce863b99f9a8bc843d + original: lts-9.5 diff --git a/stripe-core/src/Web/Stripe/Client.hs b/stripe-core/src/Web/Stripe/Client.hs index 93fc4da..13092e4 100644 --- a/stripe-core/src/Web/Stripe/Client.hs +++ b/stripe-core/src/Web/Stripe/Client.hs @@ -93,17 +93,17 @@ handleStream handleStream decodeValue statusCode r = case statusCode of 200 -> case r of - Error message -> parseFail message + Error message -> parseFail message Nothing (Success value) -> case decodeValue value of - (Error message) -> parseFail message + (Error message) -> parseFail message (Just value) (Success a) -> (Right a) code | code >= 400 -> case r of - Error message -> parseFail message + Error message -> parseFail message Nothing (Success value) -> case fromJSON value of - (Error message) -> parseFail message + (Error message) -> parseFail message (Just value) (Success stripeError) -> Left $ setErrorHTTP code stripeError _ -> unknownCode @@ -119,16 +119,17 @@ attemptDecode code = code == 200 || code >= 400 -- | lift a parser error to be a StripeError parseFail :: String -- ^ error message + -> Maybe Value -> Either StripeError a -parseFail errorMessage = - Left $ StripeError ParseFailure (T.pack errorMessage) Nothing Nothing Nothing +parseFail errorMessage mval = + Left $ StripeError ParseFailure (T.pack errorMessage) Nothing Nothing Nothing mval ------------------------------------------------------------------------------ -- | `StripeError` to return when we don't know what to do with the -- received HTTP status code. unknownCode :: Either StripeError a unknownCode = - Left $ StripeError UnknownErrorType mempty Nothing Nothing Nothing + Left $ StripeError UnknownErrorType mempty Nothing Nothing Nothing Nothing ------------------------------------------------------------------------------ -- | set the `errorHTTP` field of the `StripeError` based on the HTTP diff --git a/stripe-core/src/Web/Stripe/Error.hs b/stripe-core/src/Web/Stripe/Error.hs index a76c105..2326b63 100644 --- a/stripe-core/src/Web/Stripe/Error.hs +++ b/stripe-core/src/Web/Stripe/Error.hs @@ -69,6 +69,7 @@ data StripeError = StripeError { , errorCode :: Maybe StripeErrorCode , errorParam :: Maybe Text , errorHTTP :: Maybe StripeErrorHTTPCode + , errorValue :: Maybe Value } deriving (Show, Typeable) instance Exception StripeError @@ -109,5 +110,6 @@ instance FromJSON StripeError where msg <- e .: "message" code <- fmap toErrorCode <$> e .:? "code" param <- e .:? "param" - return $ StripeError typ msg code param Nothing + value <- e .:? "value" + return $ StripeError typ msg code param Nothing value parseJSON _ = mzero diff --git a/stripe-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..358593d --- /dev/null +++ b/stripe-core/src/Web/Stripe/PaymentIntent.hs @@ -0,0 +1,161 @@ +{-# 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 (..) + , Charge (..) + , ChargeId (..) + , EndingBefore (..) + , ExpandParams (..) + , PaymentIntent (..) + , PaymentIntentId (..) + , PaymentMethodTypes (..) + , PaymentMethodType (..) + , StripeList (..) + ) where + +import Web.Stripe.StripeRequest (Method (GET, POST), + StripeHasParam, StripeReturn, + StripeRequest (..), toStripeParam, mkStripeRequest) +import Web.Stripe.Util (()) +import Web.Stripe.Types (Amount(..), Charge (..), ChargeId (..), Currency(..), CustomerId(..), + EndingBefore(..), Limit(..), + MetaData(..), PaymentIntent (..), PaymentMethodTypes(..), PaymentMethodType(..), + PaymentIntentId (..), ReceiptEmail(..), + StartingAfter(..), ExpandParams(..), + StripeList (..)) + +------------------------------------------------------------------------------ +-- | 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 ReceiptEmail +instance StripeHasParam CreatePaymentIntent PaymentMethodTypes + +------------------------------------------------------------------------------ +-- | 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 + +confirmPaymentIntent + :: PaymentIntentId + -> StripeRequest ConfirmPaymentIntent +confirmPaymentIntent + (PaymentIntentId paymentIntentid) + = request + where request = mkStripeRequest POST url params + url = "payment_intents" paymentIntentid "confirm" + params = [] + +data ConfirmPaymentIntent +type instance StripeReturn ConfirmPaymentIntent = PaymentIntent +instance StripeHasParam ConfirmPaymentIntent MetaData + +capturePaymentIntent + :: PaymentIntentId + -> StripeRequest CapturePaymentIntent +capturePaymentIntent + (PaymentIntentId paymentIntentid) + = request + where request = mkStripeRequest POST url params + url = "payment_intents" paymentIntentid "capture" + params = [] + +data CapturePaymentIntent +type instance StripeReturn CapturePaymentIntent = PaymentIntent +instance StripeHasParam CapturePaymentIntent MetaData + +cancelPaymentIntent + :: PaymentIntentId + -> StripeRequest CancelPaymentIntent +cancelPaymentIntent + (PaymentIntentId paymentIntentid) + = request + where request = mkStripeRequest POST url params + url = "payment_intents" paymentIntentid "cancel" + params = [] + +data CancelPaymentIntent +type instance StripeReturn CancelPaymentIntent = PaymentIntent +instance StripeHasParam CancelPaymentIntent MetaData + +------------------------------------------------------------------------------ +-- | Retrieve a 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/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/StripeRequest.hs b/stripe-core/src/Web/Stripe/StripeRequest.hs index ac27b89..930576d 100644 --- a/stripe-core/src/Web/Stripe/StripeRequest.hs +++ b/stripe-core/src/Web/Stripe/StripeRequest.hs @@ -48,17 +48,17 @@ import Web.Stripe.Types (AccountBalance(..), AccountNumber(..), Capture(..), ChargeId(..), Closed(..), CouponId(..), Country(..), Created(..), Currency(..), - CustomerId(..), CVC(..), Date(..), + CustomerId(..), CustomerEmail(..), ClientReferenceId(..), CVC(..), Date(..), DefaultCard(..), Description(..), Duration(..), DurationInMonths(..), - Email(..), EndingBefore(..), EventId(..), + Email(..), EndingBefore(..), EventId(..), EventType(..), Evidence(..), Expandable(..), ExpandParams(..), ExpMonth(..), ExpYear(..), Forgiven(..), Interval(..), IntervalCount(..), InvoiceId(..), InvoiceItemId(..), InvoiceLineItemId(..), - IsVerified(..), MetaData(..), PlanId(..), + IsVerified(..), MetaData(..), PaymentIntentId(..), PaymentMethodTypes(..), PaymentMethodType(..), PlanId(..), PlanName(..), Prorate(..), Limit(..), MaxRedemptions(..), Name(..), NewBankAccount(..), NewCard(..), @@ -68,13 +68,13 @@ import Web.Stripe.Types (AccountBalance(..), AccountNumber(..), RefundApplicationFee(..), RefundReason(..), RoutingNumber(..), StartingAfter(..), StatementDescription(..), Source(..), - SubscriptionId(..), TaxID(..), + 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, toExpandable,toMetaData, encodeList, toSeconds, getParams, toText) ------------------------------------------------------------------------------ @@ -202,6 +202,14 @@ instance ToStripeParam CustomerId where toStripeParam (CustomerId cid) = (("customer", Text.encodeUtf8 cid) :) +instance ToStripeParam ClientReferenceId where + toStripeParam (ClientReferenceId cid) = + (("client_reference_id", Text.encodeUtf8 cid) :) + +instance ToStripeParam CustomerEmail where + toStripeParam (CustomerEmail cid) = + (("customer_email", Text.encodeUtf8 cid) :) + instance ToStripeParam CouponId where toStripeParam (CouponId cid) = (("coupon", Text.encodeUtf8 cid) :) @@ -238,6 +246,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) :) @@ -318,6 +330,10 @@ instance ToStripeParam NewCard where , ("card[address_zip]", (\(AddressZip x) -> x) <$> newCardAddressZip ) ]) ++) +instance ToStripeParam PaymentIntentId where + toStripeParam (PaymentIntentId rid) = + (("payment_intent", Text.encodeUtf8 rid) :) + instance ToStripeParam (Param Text Text) where toStripeParam (Param (k,v)) = ((Text.encodeUtf8 k, Text.encodeUtf8 v) :) @@ -427,6 +443,47 @@ 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 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 ++) diff --git a/stripe-core/src/Web/Stripe/Types.hs b/stripe-core/src/Web/Stripe/Types.hs index 98c30c4..915dd5c 100644 --- a/stripe-core/src/Web/Stripe/Types.hs +++ b/stripe-core/src/Web/Stripe/Types.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RecordWildCards #-} @@ -17,16 +18,16 @@ module Web.Stripe.Types where ------------------------------------------------------------------------------ import Control.Applicative (pure, (<$>), (<*>), (<|>)) -import Control.Monad (mzero) -import Data.Aeson (FromJSON (parseJSON), ToJSON(..), - Value (String, Object, Bool), (.:), +import Data.Aeson (FromJSON (parseJSON), ToJSON(..), withText, withObject, + Value (String, Bool), (.:), (.:?)) -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 Data.Monoid ((<>)) import Numeric (fromRat, showFFloat) import Text.Read (lexP, pfail) import qualified Text.Read as R @@ -51,13 +52,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 ------------------------------------------------------------------------------ @@ -105,13 +110,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` @@ -152,7 +151,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") @@ -176,7 +175,6 @@ instance FromJSON Charge where <*> o .:? "statement_description" <*> o .:? "receipt_email" <*> o .:? "receipt_number" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | Capture for `Charge` @@ -204,7 +202,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" @@ -213,7 +211,6 @@ instance FromJSON Refund where <*> o .: "charge" <*> o .:? "balance_transaction" <*> o .: "metadata" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `RefundApplicationFee` @@ -233,13 +230,7 @@ data RefundReason -- | `CustomerId` for a `Customer` newtype CustomerId = CustomerId Text - deriving (Read, Show, Eq, Ord, Data, Typeable) - ------------------------------------------------------------------------------- --- | JSON Instance for `CustomerId` -instance FromJSON CustomerId where - parseJSON (String x) = pure (CustomerId x) - parseJSON _ = mzero + deriving (Read, Show, Eq, Ord, Data, Typeable, FromJSON) ------------------------------------------------------------------------------ -- | `Customer` object @@ -266,8 +257,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 @@ -285,7 +276,6 @@ instance FromJSON Customer where <*> o .:? "currency" <*> o .:? "default_card" <*> o .: "metadata") - parseJSON o = typeMismatch "Customer" o ------------------------------------------------------------------------------ -- | AccountBalance for a `Customer` @@ -295,24 +285,12 @@ newtype AccountBalance = AccountBalance Int ------------------------------------------------------------------------------ -- | CardId for a `Customer` newtype CardId = CardId Text - deriving (Eq, Ord, Read, Show, Data, Typeable) + deriving (Eq, Ord, Read, Show, Data, Typeable, FromJSON) ------------------------------------------------------------------------------ -- | CardId for a `Recipient` newtype RecipientCardId = RecipientCardId Text - deriving (Eq, Ord, Read, Show, Data, Typeable) - ------------------------------------------------------------------------------- --- | JSON Instance for `CardId` -instance FromJSON CardId where - parseJSON (String x) = pure $ CardId x - parseJSON _ = mzero - ------------------------------------------------------------------------------- --- | JSON Instance for `RecipientCardId` -instance FromJSON RecipientCardId where - parseJSON (String x) = pure $ RecipientCardId x - parseJSON _ = mzero + deriving (Eq, Ord, Read, Show, Data, Typeable, FromJSON) ------------------------------------------------------------------------------ -- | Number associated with a `Card` @@ -373,13 +351,14 @@ data Brand = Visa ------------------------------------------------------------------------------ -- | JSON Instance for `Brand` instance FromJSON Brand where - parseJSON (String "American Express") = pure AMEX - parseJSON (String "MasterCard") = pure MasterCard - parseJSON (String "Discover") = pure Discover - parseJSON (String "JCB") = pure JCB - parseJSON (String "Visa") = pure Visa - parseJSON (String "DinersClub") = pure DinersClub - parseJSON _ = mzero + parseJSON = withText "Brand" $ \t -> case t of + "American Express" -> pure AMEX + "MasterCard" -> pure MasterCard + "Discover" -> pure Discover + "JCB" -> pure JCB + "Visa" -> pure Visa + "DinersClub" -> pure DinersClub + _ -> fail $ "Unknown brand: " <> T.unpack t ------------------------------------------------------------------------------ -- | `Card` Object @@ -434,7 +413,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" @@ -456,12 +435,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" @@ -482,7 +460,6 @@ instance FromJSON RecipientCard where <*> o .:? "address_line1_check" <*> o .:? "address_zip_check" <*> o .:? "recipient" - parseJSON _ = mzero ------------------------------------------------------------------------------ @@ -535,13 +512,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 @@ -569,7 +631,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" @@ -588,7 +650,6 @@ instance FromJSON Subscription where <*> o .:? "discount" <*> o .: "metadata" <*> o .:? "tax_percent" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | Status of a `Subscription` @@ -603,12 +664,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` @@ -639,7 +701,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") @@ -652,7 +714,6 @@ instance FromJSON Plan where <*> o .:? "trial_period_days" <*> o .: "metadata" <*> o .:? "statement_description" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `TrialPeriod` for a Plan @@ -670,11 +731,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` @@ -721,11 +783,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 @@ -748,7 +810,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" @@ -762,7 +824,6 @@ instance FromJSON Coupon where <*> o .:? "duration_in_months" <*> o .: "valid" <*> o .: "metadata" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `CouponId` for a `Coupon` @@ -817,31 +878,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 @@ -874,8 +928,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") @@ -903,7 +957,6 @@ instance FromJSON Invoice where <*> o .:? "statement_description" <*> o .:? "description" <*> o .: "metadata" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `InvoiceItemId` for `InvoiceItem` @@ -916,7 +969,7 @@ newtype InvoiceItemId data InvoiceItem = InvoiceItem { invoiceItemObject :: Text , invoiceItemId :: InvoiceItemId - , invoiceItemDate :: UTCTime + , invoiceItemDate :: Maybe UTCTime , invoiceItemAmount :: Int , invoiceItemLiveMode :: Bool , invoiceItemProration :: Bool @@ -932,10 +985,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" @@ -946,7 +999,6 @@ instance FromJSON InvoiceItem where <*> (fmap Quantity <$> o .:? "quantity") <*> o .:? "subscription" <*> o .: "metadata" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `InvoiceLineItemId` for an `InvoiceLineItem` @@ -963,9 +1015,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 @@ -994,15 +1047,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" @@ -1015,7 +1067,6 @@ instance FromJSON InvoiceLineItem where <*> o .:? "plan" <*> o .:? "description" <*> o .: "metadata" - parseJSON _ = mzero ------------------------------------------------------------------------------ @@ -1045,14 +1096,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` @@ -1070,14 +1122,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 @@ -1104,7 +1157,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") @@ -1118,7 +1171,6 @@ instance FromJSON Dispute where <*> (fromSeconds <$> o .: "evidence_due_by") <*> (fmap Evidence <$> o .:? "evidence") <*> o .: "metadata" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `TransferId` @@ -1130,6 +1182,7 @@ newtype TransferId = data TransferStatus = TransferPaid | TransferPending + | TransferInTransit | TransferCanceled | TransferFailed deriving (Read, Show, Eq, Ord, Data, Typeable) @@ -1144,17 +1197,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 @@ -1162,7 +1218,7 @@ data Transfer = Transfer { transferId :: TransferId , transferObject :: Text , transferCreated :: UTCTime - , transferDate :: UTCTime + , transferDate :: Maybe UTCTime , transferLiveMode :: Bool , transferAmount :: Int , transferCurrency :: Currency @@ -1181,11 +1237,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" @@ -1199,7 +1255,6 @@ instance FromJSON Transfer where <*> o .:? "statement_description" <*> o .:? "recipient" <*> o .: "metadata" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `BankAccount` Object @@ -1217,7 +1272,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" @@ -1226,7 +1281,6 @@ instance FromJSON BankAccount where <*> o .:? "status" <*> o .:? "fingerprint" <*> o .: "bank_name" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `BankAccountId` for `BankAccount` @@ -1242,11 +1296,12 @@ data BankAccountStatus = ------------------------------------------------------------------------------ -- | `BankAccountStatus` JSON instance instance FromJSON BankAccountStatus where - parseJSON (String "new") = pure $ New - parseJSON (String "validated") = pure Validated - parseJSON (String "verified") = pure Verified - parseJSON (String "errored") = pure Errored - parseJSON _ = mzero + parseJSON = withText "BankAccountStatus" $ \t -> case t of + "new" -> pure $ New + "validated" -> pure Validated + "verified" -> pure Verified + "errored" -> pure Errored + _ -> fail $ "Unknown BankAccountStatus: " <> T.unpack t ------------------------------------------------------------------------------ -- | Routing Number for Bank Account @@ -1291,13 +1346,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` @@ -1329,9 +1378,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 @@ -1356,7 +1406,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") @@ -1374,8 +1424,6 @@ instance FromJSON Recipient where <$> o .:? "deleted" <*> (RecipientId <$> o .: "id") - parseJSON _ = mzero - ------------------------------------------------------------------------------ -- | `PlanId` for a `Plan` newtype ApplicationFeeId = ApplicationFeeId Text deriving (Read, Show, Eq, Ord, Data, Typeable) @@ -1413,12 +1461,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") @@ -1433,7 +1481,6 @@ instance FromJSON ApplicationFee where <*> (ApplicationId <$> o .: "application") <*> o .: "charge" <*> o .: "metadata" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `FeeId` for objects with Fees @@ -1457,7 +1504,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" @@ -1466,19 +1514,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 @@ -1504,7 +1545,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" @@ -1521,7 +1562,6 @@ instance FromJSON Account where <*> o .:? "business_url" <*> o .:? "business_logo" <*> o .:? "support_phone" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `Balance` Object @@ -1535,12 +1575,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 @@ -1552,10 +1591,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 @@ -1578,7 +1616,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" @@ -1592,18 +1630,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 @@ -1618,13 +1649,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 @@ -1646,15 +1676,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" @@ -1697,6 +1728,7 @@ data EventType = | CustomerDiscountCreatedEvent | CustomerDiscountUpdatedEvent | CustomerDiscountDeletedEvent + | CheckoutSessionCompletedEvent | InvoiceCreatedEvent | InvoiceUpdatedEvent | InvoicePaymentSucceededEvent @@ -1704,6 +1736,12 @@ data EventType = | InvoiceItemCreatedEvent | InvoiceItemUpdatedEvent | InvoiceItemDeletedEvent + | PaymentIntentAmountCapturableUpdated + | PaymentIntentCanceled + | PaymentIntentCreated + | PaymentIntentPaymentFailed + | PaymentIntentProcessing + | PaymentIntentSucceeded | PlanCreatedEvent | PlanUpdatedEvent | PlanDeletedEvent @@ -1719,66 +1757,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 @@ -1799,14 +1907,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 @@ -1814,19 +1924,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" @@ -1856,6 +1966,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" @@ -1863,6 +1974,12 @@ instance FromJSON Event where "invoiceitem.created" -> InvoiceItemEvent <$> obj .: "object" "invoiceitem.updated" -> InvoiceItemEvent <$> obj .: "object" "invoiceitem.deleted" -> InvoiceItemEvent <$> obj .: "object" + "payment_intent.amount_capturable_updated" -> PaymentIntentEvent <$> obj .: "object" + "payment_intent.canceled" -> PaymentIntentEvent <$> obj .: "object" + "payment_intent.created" -> PaymentIntentEvent <$> obj .: "object" + "payment_intent.payment_failed" -> PaymentIntentEvent <$> obj .: "object" + "payment_intent.processing" -> PaymentIntentEvent <$> obj .: "object" + "payment_intent.succeeded" -> PaymentIntentEvent <$> obj .: "object" "plan.created" -> PlanEvent <$> obj .: "object" "plan.updated" -> PlanEvent <$> obj .: "object" "plan.deleted" -> PlanEvent <$> obj .: "object" @@ -1878,12 +1995,220 @@ 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) + , paymentInventInvoice :: Maybe (Expandable InvoiceId) + , paymentIntentLastPaymentError :: Maybe TODO + , paymentIntentLiveMode :: Maybe Bool + , paymentIntentMetadata :: Maybe MetaData + , paymentIntentNextAction :: Maybe TODO + , paymentIntentOnBehalfOf :: Maybe (Expandable AccountId) + , paymentIntentPaymentMethod :: Maybe TODO + , paymentIntentPaymentOptions :: Maybe TODO + , paymentIntentPaymentMethodTypes :: [Text] + , paymentIntentReceiptEmail :: Maybe ReceiptEmail + , paymentIntentReview :: Maybe TODO + , paymentIntentSetupFutureUsage :: Maybe Text + , paymentIntentShipping :: Maybe TODO + , paymentIntentStatementDescriptor :: Maybe StatementDescription + , paymentIntentStatementDescriptorSuffix :: Maybe StatementDescription + , paymentIntentStatus :: PaymentIntentStatus + , 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" + <*> o .:? "setup_future_usage" + <*> o .:? "shipping" + <*> o .:? "statement_descriptor" + <*> o .:? "statement_descriptor_suffix" + <*> o .: "status" + <*> o .:? "transfer_data" + <*> o .:? "transfer_group" + +data TODO = TODO + deriving (Read, Show, Eq, Ord, Data, Typeable) + +instance FromJSON TODO where + parseJSON _ = pure TODO + +data 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 PaymentIntentStatus + = PaymentIntentStatusCanceled + | PaymentIntentStatusProcessing + | PaymentIntentStatusRequiresAction + | PaymentIntentStatusRequiresCapture + | PaymentIntentStatusRequiresConfirmation + | PaymentIntentStatusRequiresSource + | PaymentIntentStatusRequiresPaymentMethod + | PaymentIntentStatusSucceeded + deriving (Read, Show, Eq, Ord, Data, Typeable) + +instance FromJSON PaymentIntentStatus where + parseJSON = withText "PaymentIntentStatus" $ \t -> case t of + "canceled" -> pure PaymentIntentStatusCanceled + "processing" -> pure PaymentIntentStatusProcessing + "requires_action" -> pure PaymentIntentStatusRequiresAction + "requires_capture" -> pure PaymentIntentStatusRequiresCapture + "requires_confirmation" -> pure PaymentIntentStatusRequiresConfirmation + "requires_payment_method" -> pure PaymentIntentStatusRequiresPaymentMethod + "requires_source" -> pure PaymentIntentStatusRequiresSource + "succeeded" -> pure PaymentIntentStatusSucceeded + _ -> fail $ "Unknown PaymentIntentStatus: " <> T.unpack t + +newtype PaymentMethodId = + PaymentMethodId Text deriving (Read, Show, Eq, Ord, Data, Typeable) + + +data PaymentMethod = PaymentMethod { + paymentMethodId :: PaymentMethodId + , paymentMethodBillingDetails :: TODO + , paymentMethodCard :: Maybe TODO + , 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 + "PaymentMethodTypeCard" -> pure PaymentMethodTypeCard + "PaymentMethodTypeCardPresent" -> pure PaymentMethodTypeCardPresent + "PaymentMethodTypeIdeal" -> pure PaymentMethodTypeIdeal + "PaymentMethodTypeFPX" -> pure PaymentMethodTypeFPX + "PaymentMethodTypeBacsDebit" -> pure PaymentMethodTypeBacsDebit + "PaymentMethodTypeBancontact" -> pure PaymentMethodTypeBancontact + "PaymentMethodTypeGiropay" -> pure PaymentMethodTypeGiropay + "PaymentMethodTypeP24" -> pure PaymentMethodTypeP24 + "PaymentMethodTypeSepaDebit" -> pure PaymentMethodTypeSepaDebit + _ -> fail $ "Unknown PaymentMethodType: " <> T.unpack t + ------------------------------------------------------------------------------ -- | Connect Application @@ -1896,11 +2221,10 @@ data ConnectApp = ConnectApp { ------------------------------------------------------------------------------ -- | Connect Application JSON instance instance FromJSON ConnectApp where - parseJSON (Object o) = + parseJSON = withObject "ConnectApp" $ \o -> ConnectApp <$> o .:? "id" <*> o .: "object" <*> o .: "name" - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | `TokenId` of a `Token` @@ -1917,9 +2241,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 @@ -1936,7 +2261,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" @@ -1951,9 +2276,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 @@ -1968,13 +2292,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` @@ -2001,10 +2324,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 @@ -2073,6 +2395,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 = @@ -2382,36 +2708,35 @@ data BitcoinReceiver = BitcoinReceiver { , btcMetadata :: MetaData , btcRefundAddress :: Maybe Text , btcTransactions :: Maybe Transactions - , btcPayment :: Maybe PaymentId + , btcPayment :: Maybe PaymentId , btcCustomer :: Maybe CustomerId } deriving (Show, Eq) ------------------------------------------------------------------------------ -- | FromJSON for BitcoinReceiverId instance FromJSON BitcoinReceiver where - parseJSON (Object o) = + parseJSON = withObject "BitcoinReceiver" $ \o -> BitcoinReceiver <$> (BitcoinReceiverId <$> o .: "id") - <*> o .: "object" - <*> (fromSeconds <$> o .: "created") - <*> o .: "livemode" - <*> o .: "active" - <*> o .: "amount" - <*> o .: "amount_received" - <*> o .: "bitcoin_amount" - <*> o .: "bitcoin_amount_received" - <*> o .: "bitcoin_uri" - <*> o .: "currency" - <*> o .: "filled" - <*> o .: "inbound_address" - <*> o .: "uncaptured_funds" - <*> o .:? "description" - <*> o .: "email" + <*> o .: "object" + <*> (fromSeconds <$> o .: "created") + <*> o .: "livemode" + <*> o .: "active" + <*> o .: "amount" + <*> o .: "amount_received" + <*> o .: "bitcoin_amount" + <*> o .: "bitcoin_amount_received" + <*> o .: "bitcoin_uri" + <*> o .: "currency" + <*> o .: "filled" + <*> o .: "inbound_address" + <*> o .: "uncaptured_funds" + <*> o .:? "description" + <*> o .: "email" <*> (MetaData . H.toList <$> o .: "metadata") - <*> o .:? "refund_address" + <*> o .:? "refund_address" <*> o .:? "transactions" <*> (fmap PaymentId <$> o .:? "payment") <*> (fmap CustomerId <$> o .:? "customer") - parseJSON _ = mzero ------------------------------------------------------------------------------ -- | Bitcoin Transactions @@ -2426,13 +2751,12 @@ data Transactions = Transactions { ------------------------------------------------------------------------------ -- | Bitcoin Transactions data instance FromJSON Transactions where - parseJSON (Object o) = - Transactions <$> o .: "object" - <*> o .: "total_count" - <*> o .: "has_more" - <*> o .: "url" - <*> o .: "data" - parseJSON _ = mzero + parseJSON = withObject "Transactions" $ \o -> + Transactions <$> o .: "object" + <*> o .: "total_count" + <*> o .: "has_more" + <*> o .: "url" + <*> o .: "data" ------------------------------------------------------------------------------ -- | Bitcoin Transaction @@ -2449,7 +2773,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") @@ -2457,41 +2781,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..5852931 100644 --- a/stripe-core/src/Web/Stripe/Util.hs +++ b/stripe-core/src/Web/Stripe/Util.hs @@ -14,6 +14,7 @@ module Web.Stripe.Util , toTextLower , getParams , toBytestring + , encodeList , () , toMetaData , toExpandable @@ -92,6 +93,15 @@ getParams xs = [ (x, T.encodeUtf8 y) | (x, Just y) <- xs ] toBytestring :: Show a => a -> ByteString toBytestring = B8.pack . show +------------------------------------------------------------------------------ +-- | EncodeList +encodeList :: Text -> [a] -> (a -> [(ByteString, ByteString)]) -> [(ByteString, ByteString)] +encodeList name items func = + concat $ map (uncurry go) $ zip [0..] $ map func items + where + go :: Int -> [(ByteString, ByteString)] -> [(ByteString, ByteString)] + go i = map $ \(key, val) -> (T.encodeUtf8 name <> "[" <> toBytestring i <> "][" <> key <> "]", val) + ------------------------------------------------------------------------------ -- | To MetaData toMetaData :: [(Text, Text)] -> [(ByteString, ByteString)] diff --git a/stripe-core/stripe-core.cabal b/stripe-core/stripe-core.cabal index d72495e..60d9fec 100644 --- a/stripe-core/stripe-core.cabal +++ b/stripe-core/stripe-core.cabal @@ -47,9 +47,11 @@ library Web.Stripe.Event Web.Stripe.Invoice Web.Stripe.InvoiceItem + Web.Stripe.PaymentIntent Web.Stripe.Plan Web.Stripe.Recipient Web.Stripe.Refund + Web.Stripe.Session Web.Stripe.StripeRequest Web.Stripe.Subscription Web.Stripe.Token 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 =