backend/feat: Stripe payout dynamic transfer top-up for Fleet VA insu…

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

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,
           ..
         }
 

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,

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)

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