Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions lib/mobility-core/mobility-core.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -172,6 +172,7 @@ library
Kernel.External.Payment.Stripe.Types.PaymentIntent
Kernel.External.Payment.Stripe.Types.Refund
Kernel.External.Payment.Stripe.Types.SetupIntent
Kernel.External.Payment.Stripe.Types.Transfer
Kernel.External.Payment.Stripe.Types.Webhook
Kernel.External.Payment.Stripe.Webhook
Kernel.External.Payment.Types
Expand Down
25 changes: 19 additions & 6 deletions lib/mobility-core/src/Kernel/External/Payment/Interface.hs
Original file line number Diff line number Diff line change
Expand Up @@ -406,9 +406,9 @@ createRefund ::
PaymentServiceConfig ->
CreateRefundReq ->
m CreateRefundResp
createRefund config paymentIntentId = case config of
createRefund config req = case config of
JuspayConfig _ -> throwError $ InternalError "Juspay Create Refund not supported."
StripeConfig cfg -> Stripe.createRefund cfg paymentIntentId
StripeConfig cfg -> Stripe.createRefund cfg req

getRefund ::
( CoreMetrics m,
Expand All @@ -419,9 +419,9 @@ getRefund ::
PaymentServiceConfig ->
GetRefundReq ->
m GetRefundResp
getRefund config paymentIntentId = case config of
getRefund config req = case config of
JuspayConfig _ -> throwError $ InternalError "Juspay Get Refund not supported."
StripeConfig cfg -> Stripe.getRefund cfg paymentIntentId
StripeConfig cfg -> Stripe.getRefund cfg req

cancelRefund ::
( CoreMetrics m,
Expand All @@ -432,9 +432,22 @@ cancelRefund ::
PaymentServiceConfig ->
CancelRefundReq ->
m CancelRefundResp
cancelRefund config paymentIntentId = case config of
cancelRefund config req = case config of
JuspayConfig _ -> throwError $ InternalError "Juspay Cancel Refund not supported."
StripeConfig cfg -> Stripe.cancelRefund cfg paymentIntentId
StripeConfig cfg -> Stripe.cancelRefund cfg req

createTransfer ::
( CoreMetrics m,
EncFlow m r,
HasRequestId r,
MonadReader r m
) =>
PaymentServiceConfig ->
CreateTransferReq ->
m CreateTransferResp
createTransfer config req = case config of
JuspayConfig _ -> throwError $ InternalError "Juspay Create Refund not supported."
StripeConfig cfg -> Stripe.createTransfer cfg req

verifyVPA ::
( CoreMetrics m,
Expand Down
39 changes: 33 additions & 6 deletions lib/mobility-core/src/Kernel/External/Payment/Interface/Stripe.hs
Original file line number Diff line number Diff line change
Expand Up @@ -253,7 +253,7 @@ createPaymentIntent config req = do
ConnectedAccount -> createConnectedAccountCharge url apiKey req
where
-- Platform Charge: No cloning, no on_behalf_of
createPlatformCharge url apiKey CreatePaymentIntentReq {amount = amonutInUsd, ..} = do
createPlatformCharge url apiKey CreatePaymentIntentReq {amount = amountInUsd, ..} = do
let paymentIntentReq = mkPlatformPaymentIntentReq
paymentIntentResp <- Stripe.createPaymentIntent url apiKey paymentIntentReq
let paymentIntentId = paymentIntentResp.id
Expand All @@ -264,7 +264,7 @@ createPaymentIntent config req = do
mkPlatformPaymentIntentReq :: Stripe.PaymentIntentReq
mkPlatformPaymentIntentReq =
let application_fee_amount = eurToCents applicationFeeAmount
amountInCents = eurToCents amonutInUsd
amountInCents = eurToCents amountInUsd
payment_method = paymentMethod -- Use original payment method (NO cloning)
receipt_email = receiptEmail
on_behalf_of = Nothing -- OMIT for platform charges
Expand Down Expand Up @@ -293,9 +293,9 @@ createPaymentIntent config req = do
return $ CreatePaymentIntentResp {..}
where
mkPaymentIntentReq :: PaymentMethodId -> CreatePaymentIntentReq -> Stripe.PaymentIntentReq
mkPaymentIntentReq clonedPaymentMethodId CreatePaymentIntentReq {amount = amonutInUsd, ..} = do
mkPaymentIntentReq clonedPaymentMethodId CreatePaymentIntentReq {amount = amountInUsd, ..} = do
let application_fee_amount = usdToCents applicationFeeAmount
let amountInCents = usdToCents amonutInUsd
let amountInCents = usdToCents amountInUsd
let payment_method = clonedPaymentMethodId
let receipt_email = receiptEmail
let on_behalf_of = Just driverAccountId
Expand Down Expand Up @@ -668,10 +668,10 @@ createRefund config req = do
mkRefundResp <$> Stripe.createRefund url apiKey (Just req.driverAccountId) refundReq

mkRefundReq :: CreateRefundReq -> Maybe Bool -> Stripe.RefundReq
mkRefundReq CreateRefundReq {amount = amonutInUsd, ..} reverse_transfer =
mkRefundReq CreateRefundReq {amount = amountInUsd, ..} reverse_transfer =
let charge = Nothing
payment_intent = Just req.paymentIntentId
amountInCents = eurToCents <$> amonutInUsd
amountInCents = eurToCents <$> amountInUsd
metadata = Metadata {order_short_id = Just orderShortId, order_id = Just orderId, refunds_id = Just refundsId}
refund_application_fee = Just req.refundApplicationFee
instructions_email = req.email
Expand Down Expand Up @@ -736,3 +736,30 @@ mkGetRefundResp Stripe.RefundObject {..} =
reverseTransferId = transfer_reversal,
errorCode = failure_reason
}

createTransfer ::
forall m r.
( Metrics.CoreMetrics m,
EncFlow m r,
HasRequestId r,
MonadReader r m
) =>
StripeCfg ->
CreateTransferReq ->
m CreateTransferResp
createTransfer config req = do
let url = config.url
apiKey <- decrypt config.apiKey
transferReq <- buildCreateTransferReq req
mkCreateTransferResp <$> Stripe.createTransfer url apiKey (Just req.senderConnectedAccountId) transferReq
where
buildCreateTransferReq :: CreateTransferReq -> m Stripe.TransferReq
buildCreateTransferReq CreateTransferReq {amount = amountInUsd, ..} = do
let amountInCents = eurToCents amountInUsd
destination <- case destinationAccount of
TransferConnectedAccount accountId -> pure accountId
TransferPlatformAccount -> config.platformAccountId & fromMaybeM (InternalError "STRIPE_PLATFORM_ACCOUNT_ID_NOT_FOUND")
pure Stripe.TransferReq {amount = amountInCents, metadata = Nothing, ..}

mkCreateTransferResp :: Stripe.TransferObject -> CreateTransferResp
mkCreateTransferResp Stripe.TransferObject {..} = CreateTransferResp {transferId = id, status}
15 changes: 15 additions & 0 deletions lib/mobility-core/src/Kernel/External/Payment/Interface/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -783,3 +783,18 @@ type CancelRefundResp = GetRefundResp
derivePersistField "RefundStatus"

$(mkBeamInstancesForEnum ''RefundStatus)

data TransferAccount = TransferConnectedAccount AccountId | TransferPlatformAccount

data CreateTransferReq = CreateTransferReq
{ amount :: HighPrecMoney,
currency :: Currency,
senderConnectedAccountId :: AccountId,
destinationAccount :: TransferAccount,
description :: Maybe Text
}

data CreateTransferResp = CreateTransferResp
{ transferId :: TransferId,
status :: TransferStatus
}
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,7 @@ where
import Data.Aeson
import Kernel.External.Encryption
import Kernel.External.Payment.Stripe.Types.Accounts as Reexport (BusinessProfile (..))
import Kernel.External.Payment.Stripe.Types.Common (AccountId)
import Kernel.Prelude
import Kernel.Types.Common

Expand All @@ -38,7 +39,8 @@ data StripeCfg = StripeCfg
chargeDestination :: ChargeDestination,
webhookEndpointSecret :: Maybe (EncryptedField 'AsEncrypted Text),
webhookToleranceSeconds :: Maybe Seconds,
serviceMode :: Maybe ServiceMode
serviceMode :: Maybe ServiceMode,
platformAccountId :: Maybe AccountId
}
deriving stock (Show, Eq, Generic)
deriving anyclass (FromJSON, ToJSON)
Expand Down
24 changes: 24 additions & 0 deletions lib/mobility-core/src/Kernel/External/Payment/Stripe/Flow.hs
Original file line number Diff line number Diff line change
Expand Up @@ -618,3 +618,27 @@ cancelRefund url apiKey connectedAccountId refundId = do
let proxy = Proxy @CancelRefundAPI
eulerClient = Euler.client proxy (mkBasicAuthData apiKey) connectedAccountId refundId
callStripeAPI url eulerClient "cancel-refund" proxy

type CreateTransferAPI =
"v1"
:> "transfers"
:> BasicAuth "secretkey-password" BasicAuthData
:> Header "Stripe-Account" Text
:> ReqBody '[FormUrlEncoded] TransferReq
:> Post '[JSON] TransferObject

createTransfer ::
( Metrics.CoreMetrics m,
MonadFlow m,
HasRequestId r,
MonadReader r m
) =>
BaseUrl ->
Text ->
Maybe Text ->
TransferReq ->
m TransferObject
createTransfer url apiKey connectedAccountId transferReq = do
let proxy = Proxy @CreateTransferAPI
eulerClient = Euler.client proxy (mkBasicAuthData apiKey) connectedAccountId transferReq
callStripeAPI url eulerClient "create-transfer" proxy
Original file line number Diff line number Diff line change
Expand Up @@ -25,4 +25,5 @@ import Kernel.External.Payment.Stripe.Types.Error as Reexport
import Kernel.External.Payment.Stripe.Types.PaymentIntent as Reexport
import Kernel.External.Payment.Stripe.Types.Refund as Reexport
import Kernel.External.Payment.Stripe.Types.SetupIntent as Reexport
import Kernel.External.Payment.Stripe.Types.Transfer as Reexport
import Kernel.External.Payment.Stripe.Types.Webhook as Reexport
Original file line number Diff line number Diff line change
@@ -0,0 +1,91 @@
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}

module Kernel.External.Payment.Stripe.Types.Transfer where

import Data.Aeson
import qualified Data.HashMap.Strict as HM
import Kernel.Beam.Lib.UtilsTH (mkBeamInstancesForEnum)
import Kernel.External.Payment.Stripe.Types.Common
import Kernel.Prelude
import Kernel.Storage.Esqueleto (derivePersistField)
import Kernel.Types.Price (Currency)
import Kernel.Utils.JSON
import Web.FormUrlEncoded
import Web.HttpApiData (ToHttpApiData (..))

newtype TransferId = TransferId {getTransferId :: Text}
deriving stock (Generic, Show, Eq)
deriving newtype (FromJSON, ToJSON, ToSchema)

data TransferReq = TransferReq
{ amount :: Int,
currency :: Currency,
destination :: AccountId,
metadata :: Maybe Metadata,
description :: Maybe Text
}
deriving stock (Show, Generic)

instance ToForm TransferReq where
toForm TransferReq {..} =
Form $
HM.fromList $
catMaybes
[ Just . ("amount",) . pure $ toQueryParam amount,
Just . ("currency",) . pure $ toQueryParam currency,
Just . ("destination",) . pure $ toQueryParam destination,
("description",) . pure . toQueryParam <$> description
]

-- TODO webhook transfer.created transfer.failed transfer.reversed transfer.updated
data TransferObject = TransferObject
{ id :: TransferId,
_object :: Text,
amount :: Int,
created :: UTCTime,
currency :: Currency,
destination :: AccountId,
status :: TransferStatus
}
deriving stock (Show, Generic)

instance FromJSON TransferObject where
parseJSON = genericParseJSON stripPrefixUnderscoreIfAny

instance ToJSON TransferObject where
toJSON = genericToJSON stripPrefixUnderscoreIfAny

data TransferStatus
= TRANSFER_PENDING
| TRANSFER_IN_TRANSIT
| TRANSFER_CANCELED
| TRANSFER_FAILED
| TRANSFER_SUCCEEDED
| TRANSFER_REVERSED
deriving stock (Show, Eq, Ord, Generic, Read)
deriving anyclass (ToSchema)

transferStatusJsonOptions :: Options
transferStatusJsonOptions =
defaultOptions
{ constructorTagModifier = \case
"TRANSFER_PENDING" -> "pending"
"TRANSFER_IN_TRANSIT" -> "in_transit"
"TRANSFER_CANCELED" -> "canceled"
"TRANSFER_FAILED" -> "failed"
"TRANSFER_SUCCEEDED" -> "succeeded"
"TRANSFER_REVERSED" -> "reversed"
x -> x
}

instance FromJSON TransferStatus where
parseJSON = genericParseJSON transferStatusJsonOptions

instance ToJSON TransferStatus where
toJSON = genericToJSON transferStatusJsonOptions

derivePersistField "TransferStatus"

$(mkBeamInstancesForEnum ''TransferStatus)