{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
module Mollie.API.Types where
import qualified Control.Lens as Lens
import Control.Lens.TH ()
import Data.Aeson ((.!=), (.:), (.:?))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.TH as Aeson
import qualified Data.Aeson.Types as Aeson
import Data.Char (toLower)
import qualified Data.Currency as Currency
import Data.Default (Default, def)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Text as Text
import qualified Data.Time as Time
import Mollie.API.Helpers (lowerFirst)
import qualified Text.Printf as Printf
class ToText a where
toText :: a -> Text.Text
type CustomerId = Text.Text
type PaymentId = Text.Text
type RefundId = Text.Text
type SubscriptionId = Text.Text
type ChargebackId = Text.Text
type MandateId = Text.Text
data Amount = Amount
{ _amountCurrency :: Currency.Alpha
, _amountValue :: Text.Text
} deriving (Show, Eq)
instance Default Amount where
def = Amount
{ _amountCurrency = Currency.EUR
, _amountValue = mempty
}
defaultAmount :: Double -> Amount
defaultAmount x =
def { _amountValue = Text.pack $ Printf.printf "%.2f" x }
$(Aeson.deriveToJSON
Aeson.defaultOptions
{ Aeson.fieldLabelModifier = lowerFirst . drop 7
}
''Amount)
$(Aeson.deriveFromJSON
Aeson.defaultOptions
{ Aeson.fieldLabelModifier = lowerFirst . drop 7
}
''Amount)
Lens.makeFields ''Amount
data Address = Address
{ _addressStreetAndNumber :: Text.Text
, _addressStreetAdditional :: Maybe Text.Text
, _addressPostalCode :: Text.Text
, _addressCity :: Text.Text
, _addressRegion :: Maybe Text.Text
, _addressCountry :: Text.Text
} deriving (Show)
instance Default Address where
def = Address
{ _addressStreetAndNumber = mempty
, _addressStreetAdditional = mempty
, _addressPostalCode = mempty
, _addressCity = mempty
, _addressRegion = mempty
, _addressCountry = mempty
}
$(Aeson.deriveToJSON
Aeson.defaultOptions
{ Aeson.fieldLabelModifier = lowerFirst . drop 8
}
''Address)
$(Aeson.deriveFromJSON
Aeson.defaultOptions
{ Aeson.fieldLabelModifier = lowerFirst . drop 8
}
''Address)
Lens.makeFields ''Address
data Link = Link
{ _linkHref :: Text.Text
} deriving (Show)
$(Aeson.deriveFromJSON
Aeson.defaultOptions
{ Aeson.fieldLabelModifier = lowerFirst . drop 5
}
''Link)
Lens.makeFields ''Link
data Mode
= Live
| Test
deriving (Read, Show, Eq)
instance ToText Mode where
toText = Text.pack . Aeson.camelTo2 '_' . show
$(Aeson.deriveJSON
Aeson.defaultOptions
{ Aeson.constructorTagModifier = Aeson.camelTo2 '_'
}
''Mode)
data ListLinks = ListLinks
{ _listLinksSelf :: Link
, _listLinksNext :: Maybe Link
, _listLinksPrevious :: Maybe Link
, _listLinksDocumentation :: Maybe Link
}
deriving (Show)
$(Aeson.deriveFromJSON
Aeson.defaultOptions
{ Aeson.fieldLabelModifier = lowerFirst . drop 10
}
''ListLinks)
Lens.makeFields ''ListLinks
data List a = List
{ _listCount :: Int
, _listEmbedded :: [a]
, _listLinks :: ListLinks
}
deriving (Show)
instance Aeson.FromJSON a => Aeson.FromJSON (List a) where
parseJSON (Aeson.Object v) = List
<$> Aeson.parseField v "count"
<*> fmap elems (Aeson.parseField v "_embedded")
<*> Aeson.parseField v "_links"
where elems :: HashMap.HashMap Text.Text [a] -> [a]
elems = concat . HashMap.elems
parseJSON invalid = Aeson.typeMismatch "Not a correct embed for a list" invalid
Lens.makeFields ''List
data ErrorLinks = ErrorLinks
{ _errorLinksDocumentation :: Link
}
deriving (Show)
$(Aeson.deriveFromJSON
Aeson.defaultOptions
{ Aeson.fieldLabelModifier = lowerFirst . drop 11
}
''ErrorLinks)
Lens.makeFields ''ErrorLinks
data Error = Error
{ _errorTitle :: Text.Text
, _errorDetail :: Text.Text
, _errorField :: Maybe Text.Text
, _errorLinks :: Maybe ErrorLinks
}
deriving (Show)
$(Aeson.deriveFromJSON
Aeson.defaultOptions
{ Aeson.fieldLabelModifier = lowerFirst . drop 6
}
''Error)
Lens.makeFields ''Error
data PaymentMethod
= Bancontact
| Banktransfer
| Belfius
| Bitcoin
| Creditcard
| Directdebit
| Eps
| Giftcard
| Giropay
| Ideal
| Inghomepay
| Kbc
| Paypal
| Paysafecard
| Sofort
| NewPaymentMethod Text.Text
deriving (Read, Show, Eq)
instance ToText PaymentMethod where
toText (NewPaymentMethod text) = text
toText a = Text.pack $ Aeson.camelTo2 '_' $ show a
instance Aeson.ToJSON PaymentMethod where
toJSON = Aeson.String . toText
instance Aeson.FromJSON PaymentMethod where
parseJSON val = case lookup val methods of
Just method -> return method
Nothing -> case val of
(Aeson.String method) -> return $ NewPaymentMethod method
invalid -> Aeson.typeMismatch "PaymentMethod" invalid
where methods = map
(\method -> (Aeson.toJSON method, method))
[ Bancontact, Banktransfer, Belfius, Bitcoin
, Creditcard, Directdebit, Eps, Giftcard
, Giropay, Ideal, Inghomepay, Kbc
, Paypal, Paysafecard, Sofort
]
data ResponseError
= ClientError Int Error
| ServerError Int
| UnexpectedResponse Text.Text
deriving (Show)
data Chargeback = Chargeback
{ _chargebackId :: ChargebackId
, _chargebackAmount :: Amount
, _chargebackSettlementAmount :: Maybe Amount
, _chargebackCreatedAt :: Time.UTCTime
, _chargebackReversedAt :: Maybe Time.UTCTime
, _chargebackPaymentId :: PaymentId
}
$(Aeson.deriveFromJSON
Aeson.defaultOptions
{ Aeson.fieldLabelModifier = lowerFirst . drop 11
}
''Chargeback)
Lens.makeFields ''Chargeback
data NewCustomer = NewCustomer
{ _newCustomerName :: Maybe Text.Text
, _newCustomerEmail :: Maybe Text.Text
, _newCustomerLocale :: Maybe Text.Text
, _newCustomerMetadata :: Maybe Aeson.Value
}
deriving (Show)
instance Default NewCustomer where
def = NewCustomer
{ _newCustomerName = def
, _newCustomerEmail = def
, _newCustomerLocale = def
, _newCustomerMetadata = def
}
$(Aeson.deriveToJSON
Aeson.defaultOptions
{ Aeson.fieldLabelModifier = lowerFirst . drop 12
}
''NewCustomer)
Lens.makeFields ''NewCustomer
data Customer = Customer
{ _customerId :: CustomerId
, _customerMode :: Mode
, _customerName :: Maybe Text.Text
, _customerEmail :: Maybe Text.Text
, _customerLocale :: Maybe Text.Text
, _customerMetadata :: Maybe Aeson.Value
, _customerRecentlyUsedMethods :: [PaymentMethod]
, _customerCreatedAt :: Time.UTCTime
}
deriving (Show)
instance Aeson.FromJSON Customer where
parseJSON (Aeson.Object o) = do
_customerId <- o .: "id"
_customerMode <- o .: "mode"
_customerName <- o .:? "name"
_customerEmail <- o .:? "email"
_customerLocale <- o .:? "locale"
_customerMetadata <- o .:? "metadata"
_customerRecentlyUsedMethods <- o .:? "recentlyUsedMethods" .!= []
_customerCreatedAt <- o .: "createdAt"
return Customer{..}
parseJSON invalid = Aeson.typeMismatch "Customer" invalid
Lens.makeFields ''Customer
data NewMandate = NewMandate
{ _newMandateMethod :: PaymentMethod
, _newMandateConsumerName :: Text.Text
, _newMandateConsumerAccount :: Text.Text
, _newMandateConsumerBic :: Maybe Text.Text
, _newMandateSignatureDate :: Maybe Text.Text
, _newMandateMandateReference :: Maybe Text.Text
}
deriving (Show)
instance Default NewMandate where
def = NewMandate
{ _newMandateMethod = Directdebit
, _newMandateConsumerName = mempty
, _newMandateConsumerAccount = mempty
, _newMandateConsumerBic = def
, _newMandateSignatureDate = def
, _newMandateMandateReference = def
}
$(Aeson.deriveToJSON
Aeson.defaultOptions
{ Aeson.fieldLabelModifier = lowerFirst . drop 11
}
''NewMandate)
Lens.makeFields ''NewMandate
data MandateStatus
= MandatePending
| MandateValid
| MandateInvalid
deriving (Read, Show, Eq)
instance ToText MandateStatus where
toText = Text.pack . Aeson.camelTo2 '_' . drop 7 . show
$(Aeson.deriveFromJSON
Aeson.defaultOptions
{ Aeson.constructorTagModifier = Aeson.camelTo2 '_' . drop 7
}
''MandateStatus)
data MandateDetails = MandateDetails
{ _mandateDetailsConsumerName :: Maybe Text.Text
, _mandateDetailsConsumerAccount :: Maybe Text.Text
, _mandateDetailsConsumerBic :: Maybe Text.Text
, _mandateDetailsCardHolder :: Maybe Text.Text
, _mandateDetailsCardNumber :: Maybe Text.Text
, _mandateDetailsCardLabel :: Maybe Text.Text
, _mandateDetailsCardFingerprint :: Maybe Text.Text
, _mandateDetailsCardExpiryDate :: Maybe Text.Text
}
deriving (Show)
$(Aeson.deriveFromJSON
Aeson.defaultOptions
{ Aeson.fieldLabelModifier = lowerFirst . drop 15
}
''MandateDetails)
Lens.makeFields ''MandateDetails
data Mandate = Mandate
{ _mandateId :: MandateId
, _mandateStatus :: MandateStatus
, _mandateMethod :: PaymentMethod
, _mandateDetails :: Maybe MandateDetails
, _mandateMandateReference :: Maybe Text.Text
, _mandateSignatureDate :: Maybe Text.Text
, _mandateCreatedAt :: Time.UTCTime
}
deriving (Show)
$(Aeson.deriveFromJSON
Aeson.defaultOptions
{ Aeson.fieldLabelModifier = lowerFirst . drop 8
}
''Mandate)
Lens.makeFields ''Mandate
data MethodImage = MethodImage
{ _methodImageSize1x :: Text.Text
, _methodImageSize2x :: Text.Text
, _methodImageSvg :: Text.Text
}
deriving (Show)
$(Aeson.deriveFromJSON
Aeson.defaultOptions
{ Aeson.fieldLabelModifier = lowerFirst . drop 12
}
''MethodImage)
Lens.makeFields ''MethodImage
data Method = Method
{ _methodId :: PaymentMethod
, _methodDescription :: Text.Text
, _methodImage :: MethodImage
}
deriving (Show)
$(Aeson.deriveFromJSON
Aeson.defaultOptions
{ Aeson.fieldLabelModifier = lowerFirst . drop 7
}
''Method)
Lens.makeFields ''Method
data PaymentStatus
= PaymentOpen
| PaymentCanceled
| PaymentPending
| PaymentExpired
| PaymentFailed
| PaymentPaid
deriving (Read, Show, Eq)
instance ToText PaymentStatus where
toText = Text.pack . Aeson.camelTo2 '_' . drop 7 . show
$(Aeson.deriveFromJSON
Aeson.defaultOptions
{ Aeson.constructorTagModifier = Aeson.camelTo2 '_' . drop 7
}
''PaymentStatus)
data SequenceType
= First
| Recurring
| Oneoff
deriving (Read, Show, Eq)
instance ToText SequenceType where
toText = Text.pack . Aeson.camelTo2 '_' . show
$(Aeson.deriveJSON
Aeson.defaultOptions
{ Aeson.constructorTagModifier = Aeson.camelTo2 '_'
}
''SequenceType)
data NewPayment = NewPayment
{ _newPaymentAmount :: Amount
, _newPaymentDescription :: Text.Text
, _newPaymentRedirectUrl :: Maybe Text.Text
, _newPaymentWebhookUrl :: Maybe Text.Text
, _newPaymentMethod :: Maybe PaymentMethod
, _newPaymentMetadata :: Maybe Aeson.Value
, _newPaymentLocale :: Maybe Text.Text
, _newPaymentSequenceType :: Maybe SequenceType
, _newPaymentCustomerId :: Maybe CustomerId
, _newPaymentMandateId :: Maybe MandateId
, _newPaymentIssuer :: Maybe Text.Text
, _newPaymentBillingAddress :: Maybe Address
, _newPaymentShippingAddress :: Maybe Address
, _newPaymentBillingEmail :: Maybe Text.Text
, _newPaymentDueDate :: Maybe Text.Text
, _newPaymentConsumerName :: Maybe Text.Text
, _newPaymentConsumerAccount :: Maybe Text.Text
, _newPaymentCustomerReference :: Maybe Text.Text
}
deriving (Show)
instance Default NewPayment where
def = NewPayment
{ _newPaymentAmount = def
, _newPaymentDescription = mempty
, _newPaymentRedirectUrl = def
, _newPaymentWebhookUrl = def
, _newPaymentMethod = def
, _newPaymentMetadata = def
, _newPaymentLocale = def
, _newPaymentSequenceType = def
, _newPaymentCustomerId = def
, _newPaymentMandateId = def
, _newPaymentIssuer = def
, _newPaymentBillingAddress = def
, _newPaymentShippingAddress = def
, _newPaymentBillingEmail = def
, _newPaymentDueDate = def
, _newPaymentConsumerName = def
, _newPaymentConsumerAccount = def
, _newPaymentCustomerReference = def
}
$(Aeson.deriveToJSON
Aeson.defaultOptions
{ Aeson.fieldLabelModifier = lowerFirst . drop 11
, Aeson.omitNothingFields = True
}
''NewPayment)
Lens.makeFields ''NewPayment
data Payment = Payment
{ _paymentId :: PaymentId
, _paymentMode :: Mode
, _paymentCreatedAt :: Time.UTCTime
, _paymentStatus :: PaymentStatus
, _paymentIsCancelable :: Bool
, _paymentPaidAt :: Maybe Time.UTCTime
, _paymentCanceledAt :: Maybe Time.UTCTime
, _paymentExpiredAt :: Maybe Time.UTCTime
, _paymentFailedAt :: Maybe Time.UTCTime
, _paymentAmount :: Amount
, _paymentAmountRefunded :: Maybe Amount
, _paymentAmountRemaining :: Maybe Amount
, _paymentDescription :: Text.Text
, _paymentRedirectUrl :: Maybe Text.Text
, _paymentMollieUrl :: Maybe Text.Text
, _paymentWebhookUrl :: Maybe Text.Text
, _paymentMethod :: Maybe PaymentMethod
, _paymentMetadata :: Maybe Aeson.Value
, _paymentLocale :: Maybe Text.Text
, _paymentCountryCode :: Maybe Text.Text
, _paymentProfileId :: Text.Text
, _paymentSettlementAmount :: Maybe Amount
, _paymentSettlementId :: Maybe Text.Text
, _paymentCustomerId :: Maybe CustomerId
, _paymentSequenceType :: Maybe SequenceType
, _paymentMandateId :: Maybe MandateId
, _paymentSubscriptionId :: Maybe SubscriptionId
, _paymentDetails :: Maybe Aeson.Object
}
deriving (Show)
instance Aeson.FromJSON Payment where
parseJSON (Aeson.Object o) = do
_paymentId <- o .: "id"
_paymentMode <- o .: "mode"
_paymentCreatedAt <- o .: "createdAt"
_paymentStatus <- o .: "status"
_paymentPaidAt <- o .:? "paidAt"
_paymentIsCancelable <- o .:? "isCancelable" .!= False
_paymentCanceledAt <- o .:? "canceledAt"
_paymentExpiredAt <- o .:? "expiredAt"
_paymentFailedAt <- o .:? "failedAt"
_paymentAmount <- o .: "amount"
_paymentAmountRefunded <- o .:? "amountRefunded"
_paymentAmountRemaining <- o .:? "amountRemaining"
_paymentDescription <- o .: "description"
_paymentRedirectUrl <- o .:? "redirectUrl"
_paymentWebhookUrl <- o .:? "webhookUrl"
_paymentMethod <- o .:? "method"
_paymentMetadata <- o .: "metadata"
_paymentLocale <- o .:? "locale"
_paymentCountryCode <- o .:? "countryCode"
_paymentProfileId <- o .: "profileId"
_paymentSettlementAmount <- o .:? "settlementAmount"
_paymentSettlementId <- o .:? "settlementId"
_paymentCustomerId <- o .:? "customerId"
_paymentSequenceType <- o .:? "sequenceType"
_paymentMandateId <- o .:? "mandateId"
_paymentSubscriptionId <- o .:? "subscriptionId"
_paymentDetails <- o .:? "details"
_paymentMollieUrl <- fmap (fmap _linkHref) ((o .: "_links") >>= (.:? "checkout"))
return Payment{..}
parseJSON invalid = Aeson.typeMismatch "Payment" invalid
Lens.makeFields ''Payment
data NewRefund = NewRefund
{ _newRefundAmount :: Maybe Amount
, _newRefundDescription :: Maybe Text.Text
}
deriving (Show)
instance Default NewRefund where
def = NewRefund
{ _newRefundAmount = def
, _newRefundDescription = def
}
$(Aeson.deriveToJSON
Aeson.defaultOptions
{ Aeson.fieldLabelModifier = lowerFirst . drop 10
}
''NewRefund)
Lens.makeFields ''NewRefund
data RefundStatus
= RefundQueued
| RefundPending
| RefundProcessing
| RefundRefunded
| RefundFailed
deriving (Read, Show, Eq)
instance ToText RefundStatus where
toText = Text.pack . Aeson.camelTo2 '_' . drop 6 . show
$(Aeson.deriveFromJSON
Aeson.defaultOptions
{ Aeson.constructorTagModifier = Aeson.camelTo2 '_' . drop 6
}
''RefundStatus)
data Refund = Refund
{ _refundId :: Text.Text
, _refundAmount :: Amount
, _refundSettlementAmount :: Maybe Amount
, _refundDescription :: Text.Text
, _refundStatus :: RefundStatus
, _refundPaymentId :: PaymentId
, _refundCreatedAt :: Time.UTCTime
}
deriving (Show)
$(Aeson.deriveFromJSON
Aeson.defaultOptions
{ Aeson.fieldLabelModifier = lowerFirst . drop 7
}
''Refund)
Lens.makeFields ''Refund
data NewSubscription = NewSubscription
{ _newSubscriptionAmount :: Amount
, _newSubscriptionTimes :: Maybe Int
, _newSubscriptionInterval :: Text.Text
, _newSubscriptionStartDate :: Maybe Text.Text
, _newSubscriptionDescription :: Text.Text
, _newSubscriptionMethod :: Maybe PaymentMethod
, _newSubscriptionWebhookUrl :: Maybe Text.Text
}
deriving (Show)
instance Default NewSubscription where
def = NewSubscription
{ _newSubscriptionAmount = def
, _newSubscriptionTimes = def
, _newSubscriptionInterval = mempty
, _newSubscriptionStartDate = def
, _newSubscriptionDescription = mempty
, _newSubscriptionMethod = def
, _newSubscriptionWebhookUrl = def
}
$(Aeson.deriveToJSON
Aeson.defaultOptions
{ Aeson.fieldLabelModifier = lowerFirst . drop 16
}
''NewSubscription)
Lens.makeFields ''NewSubscription
data SubscriptionStatus
= SubscriptionPending
| SubscriptionActive
| SubscriptionCancelled
| SubscriptionSuspended
| SubscriptionCompleted
deriving (Read, Show, Eq)
instance ToText SubscriptionStatus where
toText = Text.pack . Aeson.camelTo2 '_' . drop 12 . show
$(Aeson.deriveFromJSON
Aeson.defaultOptions
{ Aeson.constructorTagModifier = Aeson.camelTo2 '_' . drop 12
}
''SubscriptionStatus)
data Subscription = Subscription
{ _subscriptionId :: Text.Text
, _subscriptionMode :: Mode
, _subscriptionCreatedAt :: Time.UTCTime
, _subscriptionStatus :: SubscriptionStatus
, _subscriptionAmount :: Amount
, _subscriptionTimes :: Maybe Int
, _subscriptionInterval :: Text.Text
, _subscriptionStartDate :: Maybe Text.Text
, _subscriptionDescription :: Text.Text
, _subscriptionMethod :: Maybe PaymentMethod
, _subscriptionCanceledAt :: Maybe Time.UTCTime
, _subscriptionWebhookUrl :: Maybe Text.Text
}
deriving (Show)
$(Aeson.deriveFromJSON
Aeson.defaultOptions
{ Aeson.fieldLabelModifier = lowerFirst . drop 13
}
''Subscription)
Lens.makeFields ''Subscription