backend/feat/international: stripe transfer api

Author: roman-bodavskiy

lib/mobility-core/mobility-core.cabal

@@ -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

lib/mobility-core/src/Kernel/External/Payment/Interface.hs

@@ -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,
@@ -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,
@@ -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,

lib/mobility-core/src/Kernel/External/Payment/Interface/Stripe.hs

@@ -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
@@ -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
@@ -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
@@ -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
@@ -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}

lib/mobility-core/src/Kernel/External/Payment/Interface/Types.hs

@@ -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
+  }

lib/mobility-core/src/Kernel/External/Payment/Stripe/Config.hs

@@ -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
 
@@ -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)

lib/mobility-core/src/Kernel/External/Payment/Stripe/Flow.hs

@@ -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

lib/mobility-core/src/Kernel/External/Payment/Stripe/Types.hs

@@ -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

lib/mobility-core/src/Kernel/External/Payment/Stripe/Types/Transfer.hs

@@ -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)