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
58 changes: 45 additions & 13 deletions lib/mobility-core/src/Kernel/External/Payout/Interface.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Comment on lines +58 to +64
Copy link
Copy Markdown

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

⚠️ Potential issue | 🟠 Major | ⚡ Quick win

Don't leak the merchant platform balance in a client-facing error.

InvalidRequest is surfaced to the API caller. Embedding the platform/merchant account's available balance (and exact required amount) in the message discloses internal financial state to whoever triggers the payout. Log the details internally and return a generic message.

🔒 Proposed fix
-              when (merchantAvail < adjustedAmt) $
-                throwError $
-                  InvalidRequest $
-                    "Merchant platform account has insufficient balance. Available: "
-                      <> show merchantAvail
-                      <> ", Required: "
-                      <> show adjustedAmt
+              when (merchantAvail < adjustedAmt) $ do
+                logError $
+                  "Merchant platform account has insufficient balance. Available: "
+                    <> show merchantAvail
+                    <> ", Required: "
+                    <> show adjustedAmt
+                throwError $
+                  InvalidRequest "Insufficient merchant platform account balance to complete payout."
🤖 Prompt for AI Agents
Verify each finding against current code. Fix only still-valid issues, skip the
rest with a brief reason, keep changes minimal, and validate.

In `@lib/mobility-core/src/Kernel/External/Payout/Interface.hs` around lines 58 -
64, Replace the client-facing error that leaks merchantAvail and adjustedAmt by
logging the exact balances internally and throwing a generic InvalidRequest
message; specifically, in the branch that checks "when (merchantAvail <
adjustedAmt)" record merchantAvail and adjustedAmt to your internal logger at an
appropriate level (e.g., error/debug) and then call "throwError $
InvalidRequest" with a non-sensitive message like "Merchant platform account has
insufficient balance" (omit numeric details).

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
Expand All @@ -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,
Expand All @@ -92,7 +122,8 @@ createPayoutOrder serviceConfig req = case serviceConfig of
refunds = Nothing,
payments = Nothing,
fulfillments = Nothing,
customerId
customerId,
merchantTopUpAmount
}

payoutOrderStatus ::
Expand Down Expand Up @@ -128,7 +159,8 @@ payoutOrderStatus serviceConfig req = case serviceConfig of
refunds = Nothing,
payments = Nothing,
fulfillments = Nothing,
customerId
customerId,
merchantTopUpAmount = Nothing
}

createTransfer ::
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -116,6 +116,7 @@ createPayoutOrder config req = do
transferStatus = Nothing,
transferId = Nothing,
idAssignedByServiceProvider = Nothing,
merchantTopUpAmount = Nothing,
..
}

Expand Down Expand Up @@ -150,6 +151,7 @@ payoutOrderStatus config req = do
transferStatus = Nothing,
transferId = Nothing,
idAssignedByServiceProvider = Nothing,
merchantTopUpAmount = Nothing,
..
}

Expand Down
22 changes: 22 additions & 0 deletions lib/mobility-core/src/Kernel/External/Payout/Interface/Stripe.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,8 @@ module Kernel.External.Payout.Interface.Stripe
( createExternalPayout,
externalPayoutOrderStatus,
createTransfer,
getBalance,
getAvailableForCurrency,
payoutStripeServiceEventWebhook,
castPayoutStatus,
unPayoutId,
Expand Down Expand Up @@ -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]
Comment on lines +152 to +155
Copy link
Copy Markdown

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

⚠️ Potential issue | 🟠 Major | ⚡ Quick win

🧩 Analysis chain

🏁 Script executed:

#!/bin/bash
# Inspect the cents/major-unit converters to confirm scale is currency-agnostic.
ast-grep --pattern 'centsToUsd $_ = $$$'
ast-grep --pattern 'eurToCents $_ = $$$'
ast-grep --pattern 'usdToCents $_ = $$$'
rg -nP --type=haskell -C2 '\b(centsToUsd|eurToCents|usdToCents)\b'

Repository: nammayatri/shared-kernel

Length of output: 12663


🏁 Script executed:

#!/bin/bash
set -euo pipefail

# Find the Interface.hs referenced by the review comment
fd -e hs -a Interface.hs lib/mobility-core/src | head -n 50

# Search for the specific comparison expression
rg -n --type=haskell "fleetAvail\s*\+\s*req\.transferAmount\s*>?=\s*req\.amount" lib/mobility-core/src || true

# If not found, search for fleetAvail usage near transferAmount/amount
rg -n --type=haskell "fleetAvail" lib/mobility-core/src | head -n 50

Repository: nammayatri/shared-kernel

Length of output: 2691


🏁 Script executed:

#!/bin/bash
set -euo pipefail

FILE="lib/mobility-core/src/Kernel/External/Payout/Interface.hs"

# Show the relevant block around the comparison
nl -ba "$FILE" | sed -n '1,140p'

# Find the request record type that contains transferAmount/amount
rg -n --type=haskell "transferAmount" lib/mobility-core/src/Kernel/External/Payout/Interface.hs
rg -n --type=haskell "data .*Transfer.*|data .*Payout.*|record.*Transfer|req\.transferAmount" lib/mobility-core/src/Kernel/External/Payout/Interface.hs

# Broader search for where req.amount / transferAmount are built for payout
rg -n --type=haskell "transferAmount\s*=\s*" lib/mobility-core/src/Kernel/External/Payout lib/mobility-core/src/Kernel/External -S
rg -n --type=haskell "req\.amount" lib/mobility-core/src/Kernel/External/Payout -S

Repository: nammayatri/shared-kernel

Length of output: 111


🏁 Script executed:

#!/bin/bash
set -euo pipefail

FILE="lib/mobility-core/src/Kernel/External/Payout/Interface.hs"

# Line-numbered view without nl
cat -n "$FILE" | sed -n '1,120p'

# Find request/type definitions and uses
rg -n --type=haskell "transferAmount" "$FILE"
rg -n --type=haskell "req\.amount|req\.transferAmount|amount\s*=|transferAmount\s*=" lib/mobility-core/src/Kernel/External/Payout -S
rg -n --type=haskell "data .*Payout|data .*Transfer|Create.*Payout|Transfer.*Req|Payout.*Req|record .*Payout" lib/mobility-core/src/Kernel/External/Payout -S

Repository: nammayatri/shared-kernel

Length of output: 25372


🏁 Script executed:

#!/bin/bash
set -euo pipefail

# Inspect payout request types
rg -n --type=haskell "data CreatePayoutOrderReq" lib/mobility-core/src/Kernel/External/Payout/Interface/Types.hs
cat -n lib/mobility-core/src/Kernel/External/Payout/Interface/Types.hs | sed -n '1,220p'

# Inspect Stripe payout conversion of req.amount/transferAmount to Stripe minor units
cat -n lib/mobility-core/src/Kernel/External/Payout/Interface/Stripe.hs | sed -n '1,220p'

# Find Currency definition and any decimal/minor-unit scaling logic
rg -n --type=haskell "data Currency|newtype Currency|type Currency" lib/mobility-core/src/Kernel | head -n 50
rg -n --type=haskell "Currency" lib/mobility-core/src/Kernel | rg -n "decim|minor|zero|scale|fraction" | head -n 50 || true
rg -n --type=haskell "zero[-_ ]?decimal|minor unit|decimal" lib/mobility-core/src/Kernel | head -n 50 || true

Repository: nammayatri/shared-kernel

Length of output: 19012


🏁 Script executed:

#!/bin/bash
set -euo pipefail
rg -n --type=haskell "HighPrecMoney" lib/mobility-core/src/Kernel/Types/Price.hs lib/mobility-core/src/Kernel | head -n 50
rg -n --type=haskell "newtype HighPrecMoney|type HighPrecMoney" lib/mobility-core/src/Kernel | head -n 50
rg -n --type=haskell "HighPrecMoney.*cents|cents.*HighPrecMoney|minor.*HighPrecMoney" lib/mobility-core/src/Kernel | head -n 50

Repository: nammayatri/shared-kernel

Length of output: 6407


🏁 Script executed:

#!/bin/bash
set -euo pipefail

FILE="lib/mobility-core/src/Kernel/Types/Price.hs"

# show around HighPrecMoney definition
sed -n '1,140p' "$FILE" | cat -n | sed -n '40,110p'
# show rest where cents/minor may be defined
sed -n '140,260p' "$FILE" | cat -n | head -n 160

Repository: nammayatri/shared-kernel

Length of output: 8353


🏁 Script executed:

#!/bin/bash
set -euo pipefail

rg -n --type=haskell "getAvailableForCurrency|centsToUsd|usdToCents|eurToCents" lib/mobility-core/src/Kernel/External/Payout/Interface/Stripe.hs lib/mobility-core/src/Kernel/External/Payout/Interface.hs lib/mobility-core/src/Kernel/External/Payment/Interface/Stripe.hs
rg -n --type=haskell "getAccuracy\s+INR|data Currency\s*=\s*INR\s*\|" lib/mobility-core/src/Kernel/Types/Price.hs

Repository: nammayatri/shared-kernel

Length of output: 4628


Fix currency minor-unit conversion in getAvailableForCurrency (INR is broken by hardcoded /100).

getAvailableForCurrency filters by f.currency == currencyText, but still converts every matching Stripe amount with centsToUsd:

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]

centsToUsd is hardcoded to / 100, and both usdToCents/eurToCents are hardcoded to * 100—so for Currency = INR (0-decimal in getAccuracy INR = 0), fleetAvail (and the top-up logic guarded by fleetAvail + req.transferAmount >= req.amount in Kernel/External/Payout/Interface.hs) will use the wrong scale.

🤖 Prompt for AI Agents
Verify each finding against current code. Fix only still-valid issues, skip the
rest with a brief reason, keep changes minimal, and validate.

In `@lib/mobility-core/src/Kernel/External/Payout/Interface/Stripe.hs` around
lines 152 - 155, getAvailableForCurrency is converting Stripe minor-unit amounts
with the hardcoded centsToUsd (/100), which breaks currencies like INR that have
different decimal accuracy; replace the hardcoded conversion by using the
currency's accuracy (e.g. getAccuracy or existing currency-decimal helper) to
compute scale = 10 ^ accuracy and convert each f.amount from minor units to
HighPrecMoney by dividing by that scale (instead of using centsToUsd), keeping
the currency filter on f.currency; update any helper conversions
(usdToCents/eurToCents) or replace them with a generic minorUnit <-> money
converter so fleetAvail and the transferAmount comparison use the correct scale.


payoutStripeServiceEventWebhook ::
( EncFlow m r,
HasRequestId r,
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
40 changes: 40 additions & 0 deletions lib/mobility-core/src/Kernel/External/Payout/Stripe/Flow.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,5 @@
{-# LANGUAGE DerivingStrategies #-}

module Kernel.External.Payout.Stripe.Flow where

import qualified EulerHS.Types as Euler
Expand Down Expand Up @@ -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
Loading