From c78e78c3a8604ab62086f9e0e278c17b7c1ba20e Mon Sep 17 00:00:00 2001 From: Karan Date: Tue, 2 Jun 2026 12:57:09 +0530 Subject: [PATCH] backend/feat: Stripe payout dynamic transfer top-up for Fleet VA insufficient balance MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit When a Fleet VA (Stripe connected account) has insufficient available balance to cover a payout, compute the shortfall and increase the platform → VA transfer accordingly. Verify the merchant platform account has enough before proceeding. Persist the extra top-up amount as merchantTopUpAmount in CreatePayoutOrderResp. - Stripe/Flow.hs: add BalanceFund, BalanceResp types and GET /v1/balance API - Interface/Stripe.hs: add getBalance wrapper and getAvailableForCurrency helper - Interface/Types.hs: add merchantTopUpAmount :: Maybe HighPrecMoney to CreatePayoutOrderResp - Interface.hs: balance-check + adjusted-transfer logic in Stripe createPayoutOrder path - Interface/Juspay.hs: set merchantTopUpAmount = Nothing in Juspay responses Co-Authored-By: Claude Sonnet 4.6 --- .../src/Kernel/External/Payout/Interface.hs | 58 ++++++++++++++----- .../External/Payout/Interface/Juspay.hs | 2 + .../External/Payout/Interface/Stripe.hs | 22 +++++++ .../Kernel/External/Payout/Interface/Types.hs | 3 +- .../src/Kernel/External/Payout/Stripe/Flow.hs | 40 +++++++++++++ 5 files changed, 111 insertions(+), 14 deletions(-) diff --git a/lib/mobility-core/src/Kernel/External/Payout/Interface.hs b/lib/mobility-core/src/Kernel/External/Payout/Interface.hs index 0940712ec..f39369b7f 100644 --- a/lib/mobility-core/src/Kernel/External/Payout/Interface.hs +++ b/lib/mobility-core/src/Kernel/External/Payout/Interface.hs @@ -41,7 +41,39 @@ createPayoutOrder serviceConfig req = case serviceConfig of JuspayConfig cfg -> Juspay.createPayoutOrder cfg req StripeConfig cfg -> do connectedAccountId <- req.mConnectedAccountId & fromMaybeM (InvalidRequest "connectedAccountId required for Stripe payout") - createTransferResp <- Stripe.createTransfer cfg (mkTransferReq connectedAccountId req) + + -- Check Fleet VA available balance and compute adjusted transfer amount if needed. + -- If fleetAvail + transferAmount < payoutAmount, top up the transfer to cover the shortfall. + let computeAdjustedTransfer = do + fleetBalance <- Stripe.getBalance cfg (Just connectedAccountId) + let fleetAvail = Stripe.getAvailableForCurrency req.currency fleetBalance + if fleetAvail + req.transferAmount >= req.amount + then pure (req.transferAmount, Nothing) + else do + let topUp = req.amount - fleetAvail - req.transferAmount + adjustedAmt = req.transferAmount + topUp + -- Verify merchant (platform) VA can cover the increased transfer + merchantBalance <- Stripe.getBalance cfg Nothing + let merchantAvail = Stripe.getAvailableForCurrency req.currency merchantBalance + when (merchantAvail < adjustedAmt) $ + throwError $ + InvalidRequest $ + "Merchant platform account has insufficient balance. Available: " + <> show merchantAvail + <> ", Required: " + <> show adjustedAmt + logInfo $ + "Fleet VA balance insufficient (available: " + <> show fleetAvail + <> "). Topping up transfer by " + <> show topUp + <> " -> adjusted transfer: " + <> show adjustedAmt + pure (adjustedAmt, Just topUp) + + (adjustedTransferAmount, merchantTopUpAmount) <- computeAdjustedTransfer + + createTransferResp <- Stripe.createTransfer cfg (mkTransferReq connectedAccountId adjustedTransferAmount req) -- In case if external payout api call failed, we still need to store transferId and transferStatus result <- withTryCatch "createExternalPayout" $ Stripe.createExternalPayout cfg req createExternalPayoutResp <- case result of @@ -60,22 +92,20 @@ createPayoutOrder serviceConfig req = case serviceConfig of amount = req.amount, customerId = Just req.customerId } - pure $ mkCreatePayoutOrderResp createTransferResp createExternalPayoutResp + pure $ mkCreatePayoutOrderResp merchantTopUpAmount createTransferResp createExternalPayoutResp where - mkTransferReq :: Text -> CreatePayoutOrderReq -> CreateTransferReq - mkTransferReq connectedAccountId CreatePayoutOrderReq {..} = do - let senderAccountId = TransferPlatformAccount - destinationAccount = TransferConnectedAccount connectedAccountId + mkTransferReq :: Text -> HighPrecMoney -> CreatePayoutOrderReq -> CreateTransferReq + mkTransferReq connectedAccountId adjustedTransferAmount CreatePayoutOrderReq {..} = CreateTransferReq - { amount = transferAmount, + { amount = adjustedTransferAmount, currency, - senderAccountId, - destinationAccount, + senderAccountId = TransferPlatformAccount, + destinationAccount = TransferConnectedAccount connectedAccountId, description = Just remark } - mkCreatePayoutOrderResp :: CreateTransferResp -> CreateExternalPayoutResp -> CreatePayoutOrderResp - mkCreatePayoutOrderResp CreateTransferResp {transferId, transferStatus} CreateExternalPayoutResp {..} = + mkCreatePayoutOrderResp :: Maybe HighPrecMoney -> CreateTransferResp -> CreateExternalPayoutResp -> CreatePayoutOrderResp + mkCreatePayoutOrderResp merchantTopUpAmount CreateTransferResp {transferId, transferStatus} CreateExternalPayoutResp {..} = CreatePayoutOrderResp { orderId, status, @@ -92,7 +122,8 @@ createPayoutOrder serviceConfig req = case serviceConfig of refunds = Nothing, payments = Nothing, fulfillments = Nothing, - customerId + customerId, + merchantTopUpAmount } payoutOrderStatus :: @@ -128,7 +159,8 @@ payoutOrderStatus serviceConfig req = case serviceConfig of refunds = Nothing, payments = Nothing, fulfillments = Nothing, - customerId + customerId, + merchantTopUpAmount = Nothing } createTransfer :: diff --git a/lib/mobility-core/src/Kernel/External/Payout/Interface/Juspay.hs b/lib/mobility-core/src/Kernel/External/Payout/Interface/Juspay.hs index cc98021e3..76904099c 100644 --- a/lib/mobility-core/src/Kernel/External/Payout/Interface/Juspay.hs +++ b/lib/mobility-core/src/Kernel/External/Payout/Interface/Juspay.hs @@ -116,6 +116,7 @@ createPayoutOrder config req = do transferStatus = Nothing, transferId = Nothing, idAssignedByServiceProvider = Nothing, + merchantTopUpAmount = Nothing, .. } @@ -150,6 +151,7 @@ payoutOrderStatus config req = do transferStatus = Nothing, transferId = Nothing, idAssignedByServiceProvider = Nothing, + merchantTopUpAmount = Nothing, .. } diff --git a/lib/mobility-core/src/Kernel/External/Payout/Interface/Stripe.hs b/lib/mobility-core/src/Kernel/External/Payout/Interface/Stripe.hs index 2c286769d..9f62d9744 100644 --- a/lib/mobility-core/src/Kernel/External/Payout/Interface/Stripe.hs +++ b/lib/mobility-core/src/Kernel/External/Payout/Interface/Stripe.hs @@ -2,6 +2,8 @@ module Kernel.External.Payout.Interface.Stripe ( createExternalPayout, externalPayoutOrderStatus, createTransfer, + getBalance, + getAvailableForCurrency, payoutStripeServiceEventWebhook, castPayoutStatus, unPayoutId, @@ -132,6 +134,26 @@ createTransfer config req = do mkCreateTransferResp :: Stripe.TransferObject -> CreateTransferResp mkCreateTransferResp Stripe.TransferObject {..} = CreateTransferResp {transferId = id, transferStatus = TRANSFERRED} +getBalance :: + ( Metrics.CoreMetrics m, + EncFlow m r, + HasRequestId r, + MonadReader r m + ) => + StripeConfig -> + Maybe Text -> + m Stripe.BalanceResp +getBalance config mbConnectedAccountId = do + apiKey <- decrypt config.apiKey + Stripe.getBalance config.url apiKey mbConnectedAccountId + +-- | Extract available balance for a specific currency from a Stripe BalanceResp. +-- Stripe amounts are in smallest currency unit (cents); converts to HighPrecMoney. +getAvailableForCurrency :: Currency -> Stripe.BalanceResp -> HighPrecMoney +getAvailableForCurrency currency Stripe.BalanceResp {available} = + let currencyText = T.toLower $ show currency + in sum [centsToUsd f.amount | f <- available, f.currency == currencyText] + payoutStripeServiceEventWebhook :: ( EncFlow m r, HasRequestId r, diff --git a/lib/mobility-core/src/Kernel/External/Payout/Interface/Types.hs b/lib/mobility-core/src/Kernel/External/Payout/Interface/Types.hs index 223e7b365..18c92d2ec 100644 --- a/lib/mobility-core/src/Kernel/External/Payout/Interface/Types.hs +++ b/lib/mobility-core/src/Kernel/External/Payout/Interface/Types.hs @@ -88,7 +88,8 @@ data CreatePayoutOrderResp = CreatePayoutOrderResp refunds :: Maybe [Text], payments :: Maybe [Text], fulfillments :: Maybe [Fulfillment], - customerId :: Maybe Text + customerId :: Maybe Text, + merchantTopUpAmount :: Maybe HighPrecMoney -- Stripe specific: extra amount transferred to cover Fleet VA shortfall } deriving (Show, Generic) deriving anyclass (FromJSON, ToJSON, ToSchema) diff --git a/lib/mobility-core/src/Kernel/External/Payout/Stripe/Flow.hs b/lib/mobility-core/src/Kernel/External/Payout/Stripe/Flow.hs index 32589ead9..06580f3bb 100644 --- a/lib/mobility-core/src/Kernel/External/Payout/Stripe/Flow.hs +++ b/lib/mobility-core/src/Kernel/External/Payout/Stripe/Flow.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DerivingStrategies #-} + module Kernel.External.Payout.Stripe.Flow where import qualified EulerHS.Types as Euler @@ -139,3 +141,41 @@ createTransfer url apiKey connectedAccountId transferReq = do let proxy = Proxy @CreateTransferAPI eulerClient = Euler.client proxy (PaymentFlow.mkBasicAuthData apiKey) connectedAccountId transferReq PaymentFlow.callStripeAPI url eulerClient "create-transfer" proxy + +-- Balance types +data BalanceFund = BalanceFund + { amount :: Int, -- Stripe amount in smallest currency unit (e.g. cents) + currency :: Text -- lowercase currency code, e.g. "eur" + } + deriving stock (Show, Generic) + deriving anyclass (FromJSON, ToJSON) + +data BalanceResp = BalanceResp + { available :: [BalanceFund], + pending :: [BalanceFund] + } + deriving stock (Show, Generic) + deriving anyclass (FromJSON, ToJSON) + +-- GET /v1/balance +type GetBalanceAPI = + "v1" + :> "balance" + :> BasicAuth "secretkey-password" BasicAuthData + :> Header "Stripe-Account" Text -- Nothing = platform account, Just accountId = connected account + :> Get '[JSON] BalanceResp + +getBalance :: + ( Metrics.CoreMetrics m, + MonadFlow m, + HasRequestId r, + MonadReader r m + ) => + BaseUrl -> + Text -> + Maybe Text -> + m BalanceResp +getBalance url apiKey connectedAccountId = do + let proxy = Proxy @GetBalanceAPI + eulerClient = Euler.client proxy (PaymentFlow.mkBasicAuthData apiKey) connectedAccountId + PaymentFlow.callStripeAPI url eulerClient "get-balance" proxy