From 80643aa76499d6a0f687dd0f8e5e2db3a8ce5d05 Mon Sep 17 00:00:00 2001 From: Roman Bodavsky Date: Thu, 23 Apr 2026 17:25:46 +0300 Subject: [PATCH 1/3] backend/feat: Stripe payouts --- lib/mobility-core/mobility-core.cabal | 6 + .../src/Kernel/External/Payout/Interface.hs | 13 +- .../External/Payout/Interface/Juspay.hs | 16 +- .../External/Payout/Interface/Stripe.hs | 99 ++++++++++ .../Kernel/External/Payout/Interface/Types.hs | 19 +- .../Kernel/External/Payout/Juspay/Webhook.hs | 1 + .../Kernel/External/Payout/Stripe/Config.hs | 35 ++++ .../src/Kernel/External/Payout/Stripe/Flow.hs | 117 ++++++++++++ .../Kernel/External/Payout/Stripe/Types.hs | 7 + .../External/Payout/Stripe/Types/Common.hs | 16 ++ .../External/Payout/Stripe/Types/Payout.hs | 170 ++++++++++++++++++ .../src/Kernel/External/Payout/Types.hs | 16 +- lib/mobility-core/src/Kernel/Utils/TH.hs | 26 +++ 13 files changed, 511 insertions(+), 30 deletions(-) create mode 100644 lib/mobility-core/src/Kernel/External/Payout/Interface/Stripe.hs create mode 100644 lib/mobility-core/src/Kernel/External/Payout/Stripe/Config.hs create mode 100644 lib/mobility-core/src/Kernel/External/Payout/Stripe/Flow.hs create mode 100644 lib/mobility-core/src/Kernel/External/Payout/Stripe/Types.hs create mode 100644 lib/mobility-core/src/Kernel/External/Payout/Stripe/Types/Common.hs create mode 100644 lib/mobility-core/src/Kernel/External/Payout/Stripe/Types/Payout.hs diff --git a/lib/mobility-core/mobility-core.cabal b/lib/mobility-core/mobility-core.cabal index bae8825ef..404396cf1 100644 --- a/lib/mobility-core/mobility-core.cabal +++ b/lib/mobility-core/mobility-core.cabal @@ -192,6 +192,7 @@ library Kernel.External.Payment.Types Kernel.External.Payout.Interface Kernel.External.Payout.Interface.Juspay + Kernel.External.Payout.Interface.Stripe Kernel.External.Payout.Interface.Types Kernel.External.Payout.Juspay.Config Kernel.External.Payout.Juspay.Flow @@ -199,6 +200,11 @@ library Kernel.External.Payout.Juspay.Types.Payout Kernel.External.Payout.Juspay.Types.Webhook Kernel.External.Payout.Juspay.Webhook + Kernel.External.Payout.Stripe.Config + Kernel.External.Payout.Stripe.Flow + Kernel.External.Payout.Stripe.Types + Kernel.External.Payout.Stripe.Types.Common + Kernel.External.Payout.Stripe.Types.Payout Kernel.External.Payout.Types Kernel.External.Plasma Kernel.External.Plasma.Interface diff --git a/lib/mobility-core/src/Kernel/External/Payout/Interface.hs b/lib/mobility-core/src/Kernel/External/Payout/Interface.hs index 7c4fece77..c739f38c1 100644 --- a/lib/mobility-core/src/Kernel/External/Payout/Interface.hs +++ b/lib/mobility-core/src/Kernel/External/Payout/Interface.hs @@ -18,6 +18,7 @@ module Kernel.External.Payout.Interface where import qualified Kernel.External.Payout.Interface.Juspay as Juspay +import qualified Kernel.External.Payout.Interface.Stripe as Stripe import Kernel.External.Payout.Interface.Types as Reexport import Kernel.External.Payout.Types as Reexport import Kernel.Prelude @@ -32,11 +33,11 @@ createPayoutOrder :: HasFlowEnv m r '["selfBaseUrl" ::: BaseUrl] ) => PayoutServiceConfig -> - Maybe Text -> CreatePayoutOrderReq -> m CreatePayoutOrderResp -createPayoutOrder serviceConfig mRoutingId req = case serviceConfig of - JuspayConfig cfg -> Juspay.createPayoutOrder cfg mRoutingId req +createPayoutOrder serviceConfig req = case serviceConfig of + JuspayConfig cfg -> Juspay.createPayoutOrder cfg req + StripeConfig cfg -> Stripe.createPayoutOrder cfg req payoutOrderStatus :: ( EncFlow m r, @@ -45,8 +46,8 @@ payoutOrderStatus :: MonadReader r m ) => PayoutServiceConfig -> - Maybe Text -> PayoutOrderStatusReq -> m PayoutOrderStatusResp -payoutOrderStatus serviceConfig mRoutingId req = case serviceConfig of - JuspayConfig cfg -> Juspay.payoutOrderStatus cfg req.orderId mRoutingId req.mbExpand +payoutOrderStatus serviceConfig req = case serviceConfig of + JuspayConfig cfg -> Juspay.payoutOrderStatus cfg req + StripeConfig cfg -> Stripe.payoutOrderStatus cfg req 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 b26bef8b4..9e87915c3 100644 --- a/lib/mobility-core/src/Kernel/External/Payout/Interface/Juspay.hs +++ b/lib/mobility-core/src/Kernel/External/Payout/Interface/Juspay.hs @@ -51,15 +51,14 @@ createPayoutOrder :: HasFlowEnv m r '["selfBaseUrl" ::: BaseUrl] ) => JuspayConfig -> - Maybe Text -> CreatePayoutOrderReq -> m CreatePayoutOrderResp -createPayoutOrder config mRoutingId req = do +createPayoutOrder config req = do let url = config.url merchantId = config.merchantId apiKey <- decrypt config.apiKey orderReq <- mkCreatePayoutOrderReq req - mkCreatePayoutOrderResp <$> Juspay.createPayoutOrder url apiKey merchantId mRoutingId orderReq + mkCreatePayoutOrderResp <$> Juspay.createPayoutOrder url apiKey merchantId req.mRoutingId orderReq where mkCreatePayoutOrderReq CreatePayoutOrderReq {..} = do webhookDetails <- case isDynamicWebhookRequired of @@ -113,6 +112,7 @@ createPayoutOrder config mRoutingId req = do mkCreatePayoutOrderResp Payout.PayoutOrderResp {..} = do CreatePayoutOrderResp { amount = realToFrac amount, + idAssignedByServiceProvider = Nothing, .. } @@ -134,19 +134,18 @@ payoutOrderStatus :: MonadReader r m ) => JuspayConfig -> - Text -> - Maybe Text -> - Maybe Expand -> + PayoutOrderStatusReq -> m PayoutOrderStatusResp -payoutOrderStatus config orderId' mRoutingId mbExpand = do +payoutOrderStatus config req = do let url = config.url merchantId = config.merchantId apiKey <- decrypt config.apiKey - mkPayoutOrderStatusResp <$> Juspay.payoutOrderStatus url apiKey merchantId mRoutingId orderId' mbExpand + mkPayoutOrderStatusResp <$> Juspay.payoutOrderStatus url apiKey merchantId req.mRoutingId req.orderId req.mbExpand where mkPayoutOrderStatusResp Payout.PayoutOrderResp {..} = do CreatePayoutOrderResp { amount = realToFrac amount, + idAssignedByServiceProvider = Nothing, .. } @@ -170,6 +169,7 @@ mkWebhookOrderStatusPayoutResp payoutReq = case payoutReq.label of | not (T.null (T.strip orderId)) -> OrderStatusPayoutResp { payoutOrderId = orderId, + idAssignedByServiceProvider = Nothing, payoutStatus = payoutReq.info.status, orderType = payoutReq.info._type, merchantCustomerId = payoutReq.info.merchantCustomerId, diff --git a/lib/mobility-core/src/Kernel/External/Payout/Interface/Stripe.hs b/lib/mobility-core/src/Kernel/External/Payout/Interface/Stripe.hs new file mode 100644 index 000000000..bdfb6d4ed --- /dev/null +++ b/lib/mobility-core/src/Kernel/External/Payout/Interface/Stripe.hs @@ -0,0 +1,99 @@ +module Kernel.External.Payout.Interface.Stripe + ( createPayoutOrder, + payoutOrderStatus, + ) +where + +import Control.Applicative ((<|>)) +import qualified Data.Text as T +import Kernel.External.Encryption +import qualified Kernel.External.Payment.Interface.Stripe as PaymentStripe +import Kernel.External.Payout.Interface.Types +import qualified Kernel.External.Payout.Juspay.Types.Payout as Juspay +import Kernel.External.Payout.Stripe.Config as Reexport +import qualified Kernel.External.Payout.Stripe.Flow as Stripe +import qualified Kernel.External.Payout.Stripe.Types as Stripe +import Kernel.Prelude +import qualified Kernel.Tools.Metrics.CoreMetrics as Metrics +import Kernel.Types.Error +import Kernel.Utils.Common + +createPayoutOrder :: + ( Metrics.CoreMetrics m, + EncFlow m r, + HasRequestId r, + MonadReader r m + ) => + StripeConfig -> + CreatePayoutOrderReq -> + m CreatePayoutOrderResp +createPayoutOrder config req = do + apiKey <- decrypt config.apiKey + let url = config.url + stripeResp <- Stripe.createPayout url apiKey req.mConnectedAccountId (mkCreatePayoutReq req) + pure $ mkCreatePayoutOrderResp req.orderId (Just req) stripeResp + where + -- Interface request is payout-order shaped (Juspay), so map to Stripe payout request. + mkCreatePayoutReq CreatePayoutOrderReq {..} = + Stripe.CreatePayoutReq + { amount = PaymentStripe.usdToCents amount, + currency = T.toLower $ show currency, + description = Just remark, + destination = Just customerVpa, + method = Nothing, + source_type = Nothing, + statement_descriptor = Nothing, + metadata = + Just + Stripe.Metadata + { order_id = Just orderId, + customer_id = Just customerId, + order_type = Just orderType + } + } + +payoutOrderStatus :: + ( Metrics.CoreMetrics m, + EncFlow m r, + HasRequestId r, + MonadReader r m + ) => + StripeConfig -> + PayoutOrderStatusReq -> + m PayoutOrderStatusResp +payoutOrderStatus config req = do + apiKey <- decrypt config.apiKey + let url = config.url + payoutId <- req.idAssignedByServiceProvider & fromMaybeM (InvalidRequest "id assigned by service provider required for Stripe payout") + stripeResp <- Stripe.getPayout url apiKey req.mConnectedAccountId (Stripe.PayoutId payoutId) + pure $ mkCreatePayoutOrderResp req.orderId Nothing stripeResp + +mkCreatePayoutOrderResp :: Text -> Maybe CreatePayoutOrderReq -> Stripe.PayoutObject -> CreatePayoutOrderResp +mkCreatePayoutOrderResp reqOrderId mbRequest stripeResp = + CreatePayoutOrderResp + { orderId = fromMaybe reqOrderId $ stripeResp.metadata >>= (.order_id), + idAssignedByServiceProvider = Just $ unPayoutId stripeResp.id, + status = castPayoutStatus stripeResp.status, + orderType = (stripeResp.metadata >>= (.order_type)) <|> (mbRequest <&> (.orderType)), + udf1 = Nothing, + udf2 = Nothing, + udf3 = Nothing, + udf4 = Nothing, + udf5 = Nothing, + amount = PaymentStripe.centsToUsd stripeResp.amount, + refunds = Nothing, + payments = Nothing, + fulfillments = Nothing, + customerId = (stripeResp.metadata >>= (.customer_id)) <|> (mbRequest <&> (.customerId)) + } + +unPayoutId :: Stripe.PayoutId -> Text +unPayoutId (Stripe.PayoutId payoutId) = payoutId + +castPayoutStatus :: Stripe.PayoutStatus -> Juspay.PayoutOrderStatus +castPayoutStatus = \case + Stripe.PAYOUT_PENDING -> Juspay.INITIATED + Stripe.PAYOUT_IN_TRANSIT -> Juspay.INITIATED + Stripe.PAYOUT_PAID -> Juspay.SUCCESS + Stripe.PAYOUT_FAILED -> Juspay.FAILURE + Stripe.PAYOUT_CANCELED -> Juspay.CANCELLED 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 0490bc544..7fdf94f94 100644 --- a/lib/mobility-core/src/Kernel/External/Payout/Interface/Types.hs +++ b/lib/mobility-core/src/Kernel/External/Payout/Interface/Types.hs @@ -25,17 +25,19 @@ where import Kernel.Beam.Lib.UtilsTH (mkBeamInstancesForEnum) import qualified Kernel.External.Payout.Juspay.Config as Juspay import Kernel.External.Payout.Juspay.Types as Reexport (Fulfillment (..), PayoutOrderStatus (..)) +import qualified Kernel.External.Payout.Stripe.Config as Stripe import Kernel.Prelude import Kernel.Storage.Esqueleto (derivePersistField) -import Kernel.Types.Common hiding (Currency) +import Kernel.Types.Common import Servant.API (ToHttpApiData (..)) -data PayoutServiceConfig = JuspayConfig Juspay.JuspayConfig +data PayoutServiceConfig = JuspayConfig Juspay.JuspayConfig | StripeConfig Stripe.StripeConfig deriving (Show, Eq, Generic, ToJSON, FromJSON) data OrderStatusPayoutResp = OrderStatusPayoutResp { payoutOrderId :: Text, + idAssignedByServiceProvider :: Maybe Text, -- Stripe specific payoutStatus :: PayoutOrderStatus, orderType :: Maybe Text, merchantCustomerId :: Maybe Text, @@ -47,9 +49,12 @@ data OrderStatusPayoutResp deriving stock (Show, Read, Eq, Generic) deriving anyclass (FromJSON, ToJSON, ToSchema) +type AccountId = Text + data CreatePayoutOrderReq = CreatePayoutOrderReq { orderId :: Text, amount :: HighPrecMoney, + currency :: Currency, customerPhone :: Text, customerEmail :: Text, customerId :: Text, @@ -57,13 +62,16 @@ data CreatePayoutOrderReq = CreatePayoutOrderReq remark :: Text, customerName :: Text, customerVpa :: Text, - isDynamicWebhookRequired :: Bool + isDynamicWebhookRequired :: Bool, + mRoutingId :: Maybe Text, -- Juspay specific + mConnectedAccountId :: Maybe AccountId -- Stripe specific } deriving stock (Show, Eq, Generic) deriving anyclass (FromJSON, ToJSON, ToSchema) data CreatePayoutOrderResp = CreatePayoutOrderResp { orderId :: Text, + idAssignedByServiceProvider :: Maybe Text, -- Stripe specific status :: PayoutOrderStatus, orderType :: Maybe Text, udf1 :: Maybe Text, @@ -94,7 +102,10 @@ instance ToHttpApiData Expand where data PayoutOrderStatusReq = PayoutOrderStatusReq { orderId :: Text, - mbExpand :: Maybe Expand + idAssignedByServiceProvider :: Maybe Text, -- Stripe specific + mbExpand :: Maybe Expand, -- Juspay specific + mRoutingId :: Maybe Text, -- Juspay specific + mConnectedAccountId :: Maybe AccountId -- Stripe specific } deriving (Show, Generic) deriving anyclass (FromJSON, ToJSON) diff --git a/lib/mobility-core/src/Kernel/External/Payout/Juspay/Webhook.hs b/lib/mobility-core/src/Kernel/External/Payout/Juspay/Webhook.hs index 241d0bf87..04de067ec 100644 --- a/lib/mobility-core/src/Kernel/External/Payout/Juspay/Webhook.hs +++ b/lib/mobility-core/src/Kernel/External/Payout/Juspay/Webhook.hs @@ -57,5 +57,6 @@ verifyAuth config authData = do JuspayConfig cfg -> do cfgPassword <- decrypt cfg.password return (cfg.username, cfgPassword) + StripeConfig _ -> return ("", "") unless (basicAuthUsername authData == DT.encodeUtf8 username && basicAuthPassword authData == DT.encodeUtf8 password) $ throwError (InvalidRequest "INVALID_AUTHORIZATION_HEADER") diff --git a/lib/mobility-core/src/Kernel/External/Payout/Stripe/Config.hs b/lib/mobility-core/src/Kernel/External/Payout/Stripe/Config.hs new file mode 100644 index 000000000..d54ce00ac --- /dev/null +++ b/lib/mobility-core/src/Kernel/External/Payout/Stripe/Config.hs @@ -0,0 +1,35 @@ +{- + This program is free software: you can redistribute it and/or modify it under the terms of the GNU Affero General Public License + + as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is + + distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + + FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more details. You should have received a copy of the GNU Affero + + General Public License along with this program. If not, see . +-} +{-# LANGUAGE DerivingStrategies #-} + +module Kernel.External.Payout.Stripe.Config where + +import Data.Aeson +import Kernel.External.Encryption +import qualified Kernel.External.Payment.Stripe.Config as PaymentConfig +import Kernel.Prelude +import Kernel.Types.Common + +data StripeConfig = StripeConfig + { apiKey :: EncryptedField 'AsEncrypted Text, + -- returnUrl :: BaseUrl, + -- refreshUrl :: BaseUrl, + url :: BaseUrl, + -- businessProfile :: Maybe BusinessProfile, + -- chargeDestination :: ChargeDestination, + webhookEndpointSecret :: Maybe (EncryptedField 'AsEncrypted Text), + webhookToleranceSeconds :: Maybe Seconds, + serviceMode :: Maybe PaymentConfig.ServiceMode + -- useDomainOffers :: Maybe Bool + } + deriving stock (Show, Eq, Generic) + deriving anyclass (FromJSON, ToJSON) diff --git a/lib/mobility-core/src/Kernel/External/Payout/Stripe/Flow.hs b/lib/mobility-core/src/Kernel/External/Payout/Stripe/Flow.hs new file mode 100644 index 000000000..7b82fe04d --- /dev/null +++ b/lib/mobility-core/src/Kernel/External/Payout/Stripe/Flow.hs @@ -0,0 +1,117 @@ +module Kernel.External.Payout.Stripe.Flow where + +import qualified EulerHS.Types as Euler +import qualified Kernel.External.Payment.Stripe.Flow as PaymentFlow +import Kernel.External.Payout.Stripe.Types +import Kernel.Prelude +import Kernel.Tools.Metrics.CoreMetrics as Metrics +import Kernel.Types.Common +import Kernel.Utils.Servant.Client +import Servant hiding (throwError) + +-- Create Payout API +type CreatePayoutAPI = + "v1" + :> "payouts" + :> BasicAuth "secretkey-password" BasicAuthData + :> Header "Stripe-Account" Text -- Optional connected account ID + :> ReqBody '[FormUrlEncoded] CreatePayoutReq + :> Post '[JSON] PayoutObject + +createPayout :: + ( Metrics.CoreMetrics m, + MonadFlow m, + HasRequestId r, + MonadReader r m + ) => + BaseUrl -> + Text -> + Maybe Text -> + CreatePayoutReq -> + m PayoutObject +createPayout url apiKey connectedAccountId payoutReq = do + let proxy = Proxy @CreatePayoutAPI + eulerClient = Euler.client proxy (PaymentFlow.mkBasicAuthData apiKey) connectedAccountId payoutReq + PaymentFlow.callStripeAPI url eulerClient "create-payout" proxy + +-- Get Payout API +type GetPayoutAPI = + "v1" + :> "payouts" + :> BasicAuth "secretkey-password" BasicAuthData + :> Header "Stripe-Account" Text + :> Capture "id" Text + :> Get '[JSON] PayoutObject + +getPayout :: + ( Metrics.CoreMetrics m, + MonadFlow m, + HasRequestId r, + MonadReader r m + ) => + BaseUrl -> + Text -> + Maybe Text -> + PayoutId -> + m PayoutObject +getPayout url apiKey connectedAccountId (PayoutId payoutId) = do + let proxy = Proxy @GetPayoutAPI + eulerClient = Euler.client proxy (PaymentFlow.mkBasicAuthData apiKey) connectedAccountId payoutId + PaymentFlow.callStripeAPI url eulerClient "get-payout" proxy + +-- Cancel Payout API +type CancelPayoutAPI = + "v1" + :> "payouts" + :> BasicAuth "secretkey-password" BasicAuthData + :> Header "Stripe-Account" Text + :> Capture "id" Text + :> "cancel" + :> Post '[JSON] PayoutObject + +cancelPayout :: + ( Metrics.CoreMetrics m, + MonadFlow m, + HasRequestId r, + MonadReader r m + ) => + BaseUrl -> + Text -> + Maybe Text -> + PayoutId -> + m PayoutObject +cancelPayout url apiKey connectedAccountId (PayoutId payoutId) = do + let proxy = Proxy @CancelPayoutAPI + eulerClient = Euler.client proxy (PaymentFlow.mkBasicAuthData apiKey) connectedAccountId payoutId + PaymentFlow.callStripeAPI url eulerClient "cancel-payout" proxy + +-- List Payouts API +type ListPayoutsAPI = + "v1" + :> "payouts" + :> BasicAuth "secretkey-password" BasicAuthData + :> Header "Stripe-Account" Text + :> QueryParam "limit" Int + :> QueryParam "starting_after" Text + :> QueryParam "ending_before" Text + :> QueryParam "status" PayoutStatus + :> Get '[JSON] PayoutList + +listPayouts :: + ( Metrics.CoreMetrics m, + MonadFlow m, + HasRequestId r, + MonadReader r m + ) => + BaseUrl -> + Text -> + Maybe Text -> + Maybe Int -> -- limit + Maybe Text -> -- starting_after + Maybe Text -> -- ending_before + Maybe PayoutStatus -> -- status filter + m PayoutList +listPayouts url apiKey connectedAccountId limit startingAfter endingBefore status = do + let proxy = Proxy @ListPayoutsAPI + eulerClient = Euler.client proxy (PaymentFlow.mkBasicAuthData apiKey) connectedAccountId limit startingAfter endingBefore status + PaymentFlow.callStripeAPI url eulerClient "list-payouts" proxy diff --git a/lib/mobility-core/src/Kernel/External/Payout/Stripe/Types.hs b/lib/mobility-core/src/Kernel/External/Payout/Stripe/Types.hs new file mode 100644 index 000000000..ad3c0f25d --- /dev/null +++ b/lib/mobility-core/src/Kernel/External/Payout/Stripe/Types.hs @@ -0,0 +1,7 @@ +module Kernel.External.Payout.Stripe.Types + ( module Reexport, + ) +where + +import Kernel.External.Payout.Stripe.Types.Common as Reexport +import Kernel.External.Payout.Stripe.Types.Payout as Reexport diff --git a/lib/mobility-core/src/Kernel/External/Payout/Stripe/Types/Common.hs b/lib/mobility-core/src/Kernel/External/Payout/Stripe/Types/Common.hs new file mode 100644 index 000000000..3aef81120 --- /dev/null +++ b/lib/mobility-core/src/Kernel/External/Payout/Stripe/Types/Common.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE DerivingStrategies #-} + +module Kernel.External.Payout.Stripe.Types.Common where + +import Data.Aeson +import Kernel.Prelude + +-- up to 50 custom defined fields +data Metadata = Metadata + { order_id :: Maybe Text, + customer_id :: Maybe Text, + order_type :: Maybe Text + -- payout_request_id :: Maybe Text + } + deriving stock (Show, Eq, Generic, Read) + deriving anyclass (FromJSON, ToJSON, ToSchema) diff --git a/lib/mobility-core/src/Kernel/External/Payout/Stripe/Types/Payout.hs b/lib/mobility-core/src/Kernel/External/Payout/Stripe/Types/Payout.hs new file mode 100644 index 000000000..93969799b --- /dev/null +++ b/lib/mobility-core/src/Kernel/External/Payout/Stripe/Types/Payout.hs @@ -0,0 +1,170 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Kernel.External.Payout.Stripe.Types.Payout where + +import Data.Aeson +import qualified Data.HashMap.Strict as HM +import Data.OpenApi (ToSchema (declareNamedSchema), genericDeclareNamedSchema) +import Kernel.External.Payout.Stripe.Types.Common +import Kernel.Prelude +import Kernel.Utils.JSON +import qualified Kernel.Utils.Schema as S +import Web.FormUrlEncoded +import Web.HttpApiData (FromHttpApiData (..), ToHttpApiData (..)) + +-- Payout Types +newtype PayoutId = PayoutId Text + deriving stock (Generic, Show, Eq) + deriving newtype (FromJSON, ToJSON, ToSchema, FromHttpApiData, ToHttpApiData) + +data PayoutStatus + = PAYOUT_PENDING + | PAYOUT_IN_TRANSIT + | PAYOUT_PAID + | PAYOUT_FAILED + | PAYOUT_CANCELED + deriving stock (Show, Eq, Generic) + deriving anyclass (ToSchema) + +instance FromJSON PayoutStatus where + parseJSON = withText "PayoutStatus" $ \case + "pending" -> pure PAYOUT_PENDING + "in_transit" -> pure PAYOUT_IN_TRANSIT + "paid" -> pure PAYOUT_PAID + "failed" -> pure PAYOUT_FAILED + "canceled" -> pure PAYOUT_CANCELED + _ -> fail "Invalid payout status" + +instance ToJSON PayoutStatus where + toJSON PAYOUT_PENDING = String "pending" + toJSON PAYOUT_IN_TRANSIT = String "in_transit" + toJSON PAYOUT_PAID = String "paid" + toJSON PAYOUT_FAILED = String "failed" + toJSON PAYOUT_CANCELED = String "canceled" + +instance ToHttpApiData PayoutStatus where + toQueryParam PAYOUT_PENDING = "pending" + toQueryParam PAYOUT_IN_TRANSIT = "in_transit" + toQueryParam PAYOUT_PAID = "paid" + toQueryParam PAYOUT_FAILED = "failed" + toQueryParam PAYOUT_CANCELED = "canceled" + +instance FromHttpApiData PayoutStatus where + parseQueryParam "pending" = Right PAYOUT_PENDING + parseQueryParam "in_transit" = Right PAYOUT_IN_TRANSIT + parseQueryParam "paid" = Right PAYOUT_PAID + parseQueryParam "failed" = Right PAYOUT_FAILED + parseQueryParam "canceled" = Right PAYOUT_CANCELED + parseQueryParam _ = Left "Invalid payout status" + +data PayoutType = Card | BankAccount + deriving stock (Show, Eq, Generic) + deriving anyclass (ToSchema) + +instance FromJSON PayoutType where + parseJSON = withText "PayoutType" $ \case + "card" -> pure Card + "bank_account" -> pure BankAccount + _ -> fail "Invalid payout type" + +instance ToJSON PayoutType where + toJSON Card = String "card" + toJSON BankAccount = String "bank_account" + +instance ToHttpApiData PayoutType where + toQueryParam Card = "card" + toQueryParam BankAccount = "bank_account" + +data PayoutMethod = Instant | Standard + deriving stock (Show, Eq, Generic) + deriving anyclass (ToSchema) + +instance ToJSON PayoutMethod where + toJSON Instant = String "instant" + toJSON Standard = String "standard" + +instance FromJSON PayoutMethod where + parseJSON = withText "PayoutMethod" $ \case + "instant" -> pure Instant + "standard" -> pure Standard + _ -> fail "Invalid payout type" + +instance ToHttpApiData PayoutMethod where + toQueryParam Instant = "instant" + toQueryParam Standard = "standard" + +-- Create Payout Request +data CreatePayoutReq = CreatePayoutReq + { amount :: Int, -- Amount in cents + currency :: Text, + description :: Maybe Text, + destination :: Maybe Text, -- Bank account or card ID + method :: Maybe PayoutMethod, + source_type :: Maybe PayoutType, + statement_descriptor :: Maybe Text, + metadata :: Maybe Metadata + } + deriving (Show, Generic) + +instance ToForm CreatePayoutReq where + toForm CreatePayoutReq {..} = + Form $ + HM.fromList $ + [ ("amount", [toQueryParam amount]), + ("currency", [toQueryParam currency]) + ] + <> catMaybes + [ ("description",) . pure <$> description, + ("destination",) . pure <$> destination, + ("method",) . pure . toQueryParam <$> method, + ("source_type",) . pure . toQueryParam <$> source_type, + ("statement_descriptor",) . pure <$> statement_descriptor, + ("metadata[order_id]",) . pure . toQueryParam <$> (metadata >>= (.order_id)), + ("metadata[customer_id]",) . pure . toQueryParam <$> (metadata >>= (.customer_id)), + ("metadata[order_type]",) . pure . toQueryParam <$> (metadata >>= (.order_type)) + ] + +-- Payout Object Response +data PayoutObject = PayoutObject + { id :: PayoutId, + amount :: Int, + currency :: Text, + status :: PayoutStatus, + _type :: PayoutType, + method :: PayoutMethod, + description :: Maybe Text, + destination :: Maybe Text, + created :: UTCTime, + arrival_date :: Maybe UTCTime, + statement_descriptor :: Maybe Text, + metadata :: Maybe Metadata, + failure_code :: Maybe Text, + failure_message :: Maybe Text + } + deriving (Show, Generic) + +instance FromJSON PayoutObject where + parseJSON = genericParseJSON stripPrefixUnderscoreIfAny + +instance ToJSON PayoutObject where + toJSON = genericToJSON stripPrefixUnderscoreIfAny + +instance ToSchema PayoutObject where + declareNamedSchema = genericDeclareNamedSchema S.stripPrefixUnderscoreIfAny + +-- List Payouts Response +data PayoutList = PayoutList + { _data :: [PayoutObject], + has_more :: Bool + } + deriving (Show, Generic) + +instance FromJSON PayoutList where + parseJSON = genericParseJSON stripPrefixUnderscoreIfAny + +instance ToJSON PayoutList where + toJSON = genericToJSON stripPrefixUnderscoreIfAny + +instance ToSchema PayoutList where + declareNamedSchema = genericDeclareNamedSchema S.stripPrefixUnderscoreIfAny diff --git a/lib/mobility-core/src/Kernel/External/Payout/Types.hs b/lib/mobility-core/src/Kernel/External/Payout/Types.hs index 0d641fc84..bd20e297c 100644 --- a/lib/mobility-core/src/Kernel/External/Payout/Types.hs +++ b/lib/mobility-core/src/Kernel/External/Payout/Types.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DerivingStrategies #-} {- Copyright 2022-23, Juspay India Pvt Ltd @@ -20,18 +21,9 @@ import EulerHS.Prelude import Kernel.Beam.Lib.UtilsTH (mkBeamInstancesForEnumAndList) import Kernel.Storage.Esqueleto (derivePersistField) -data PayoutService = AAJuspay | Juspay - deriving (Show, Read, Eq, Ord, Generic) +data PayoutService = AAJuspay | Juspay | Stripe | StripeTest + deriving stock (Show, Read, Eq, Ord, Generic) + deriving anyclass (ToJSON, FromJSON) $(mkBeamInstancesForEnumAndList ''PayoutService) derivePersistField "PayoutService" - --- Generic instances for type with single value will not work -instance FromJSON PayoutService where - parseJSON (String "AAJuspay") = pure AAJuspay - parseJSON (String "Juspay") = pure Juspay - parseJSON (String _) = parseFail "Expected \"Juspay\"" - parseJSON e = typeMismatch "String" e - -instance ToJSON PayoutService where - toJSON = String . show diff --git a/lib/mobility-core/src/Kernel/Utils/TH.hs b/lib/mobility-core/src/Kernel/Utils/TH.hs index a14cac2c1..cc2201704 100644 --- a/lib/mobility-core/src/Kernel/Utils/TH.hs +++ b/lib/mobility-core/src/Kernel/Utils/TH.hs @@ -76,6 +76,32 @@ mkToHttpInstanceForEnum name = do toHeader = BSL.toStrict . encode |] +mkHttpInstancesForListOfEnums :: TH.Name -> TH.Q [TH.Dec] +mkHttpInstancesForListOfEnums name = do + fromInstance <- mkFromHttpInstanceForListOfEnums name + toInstance <- mkToHttpInstanceForListOfEnums name + pure $ fromInstance <> toInstance + +mkFromHttpInstanceForListOfEnums :: TH.Name -> TH.Q [TH.Dec] +mkFromHttpInstanceForListOfEnums name = do + let tyQ = pure (TH.ConT name) + [d| + instance FromHttpApiData [$tyQ] where + parseUrlPiece = parseHeader . DT.encodeUtf8 + parseQueryParam = parseUrlPiece + parseHeader = BF.first T.pack . eitherDecode . BSL.fromStrict + |] + +mkToHttpInstanceForListOfEnums :: TH.Name -> TH.Q [TH.Dec] +mkToHttpInstanceForListOfEnums name = do + let tyQ = pure (TH.ConT name) + [d| + instance ToHttpApiData [$tyQ] where + toUrlPiece = DT.decodeUtf8 . toHeader + toQueryParam = toUrlPiece + toHeader = BSL.toStrict . encode + |] + -- | Generate ToJSON/FromJSON instances that omit Nothing fields from JSON output. -- | Usage: $(deriveJSONOmitNothing ''User) -- | Example: User{name="john", email=Nothing} -> {"name":"john"} From da8d65ab5ad13fa292c3a8ce3e3e44ae625b5bf8 Mon Sep 17 00:00:00 2001 From: Roman Bodavsky Date: Tue, 28 Apr 2026 10:53:30 +0300 Subject: [PATCH 2/3] backend/feat: integrated CRUD apis for external Stripe accounts --- lib/mobility-core/mobility-core.cabal | 1 + .../src/Kernel/External/Payout/Stripe/Flow.hs | 140 ++++++++++++++++++ .../Kernel/External/Payout/Stripe/Types.hs | 1 + .../Payout/Stripe/Types/ExternalAccount.hs | 134 +++++++++++++++++ 4 files changed, 276 insertions(+) create mode 100644 lib/mobility-core/src/Kernel/External/Payout/Stripe/Types/ExternalAccount.hs diff --git a/lib/mobility-core/mobility-core.cabal b/lib/mobility-core/mobility-core.cabal index 404396cf1..a200c0beb 100644 --- a/lib/mobility-core/mobility-core.cabal +++ b/lib/mobility-core/mobility-core.cabal @@ -204,6 +204,7 @@ library Kernel.External.Payout.Stripe.Flow Kernel.External.Payout.Stripe.Types Kernel.External.Payout.Stripe.Types.Common + Kernel.External.Payout.Stripe.Types.ExternalAccount Kernel.External.Payout.Stripe.Types.Payout Kernel.External.Payout.Types Kernel.External.Plasma 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 7b82fe04d..4c4f27085 100644 --- a/lib/mobility-core/src/Kernel/External/Payout/Stripe/Flow.hs +++ b/lib/mobility-core/src/Kernel/External/Payout/Stripe/Flow.hs @@ -115,3 +115,143 @@ listPayouts url apiKey connectedAccountId limit startingAfter endingBefore statu let proxy = Proxy @ListPayoutsAPI eulerClient = Euler.client proxy (PaymentFlow.mkBasicAuthData apiKey) connectedAccountId limit startingAfter endingBefore status PaymentFlow.callStripeAPI url eulerClient "list-payouts" proxy + +-- CRUD apis for exernal accounts + +-- List External Accounts (READ) +type ListExternalAccountsAPI = + "v1" + :> "accounts" + :> Capture "account_id" AccountId + :> "external_accounts" + :> BasicAuth "secretkey-password" BasicAuthData + :> QueryParam "object" Text -- "bank_account" or "card" + :> QueryParam "limit" Int + :> QueryParam "starting_after" Text + :> QueryParam "ending_before" Text + :> Get '[JSON] ExternalAccountList + +listExternalAccounts :: + ( Metrics.CoreMetrics m, + MonadFlow m, + HasRequestId r, + MonadReader r m + ) => + BaseUrl -> + Text -> + AccountId -> + Maybe Text -> -- "bank_account" or "card" + Maybe Int -> -- limit + Maybe Text -> -- starting_after + Maybe Text -> -- ending_before + m ExternalAccountList +listExternalAccounts url apiKey accountId objectType limit startingAfter endingBefore = do + let proxy = Proxy @ListExternalAccountsAPI + eulerClient = Euler.client proxy accountId (PaymentFlow.mkBasicAuthData apiKey) objectType limit startingAfter endingBefore + PaymentFlow.callStripeAPI url eulerClient "list-external-accounts" proxy + +-- Create External Account (CREATE) +type CreateExternalAccountAPI = + "v1" + :> "accounts" + :> Capture "account_id" AccountId + :> "external_accounts" + :> BasicAuth "secretkey-password" BasicAuthData + :> ReqBody '[FormUrlEncoded] ExternalAccountReq + :> Post '[JSON] ExternalAccountObject + +createExternalAccount :: + ( Metrics.CoreMetrics m, + MonadFlow m, + HasRequestId r, + MonadReader r m + ) => + BaseUrl -> + Text -> + AccountId -> + ExternalAccountReq -> + m ExternalAccountObject +createExternalAccount url apiKey accountId externalAccountReq = do + let proxy = Proxy @CreateExternalAccountAPI + eulerClient = Euler.client proxy accountId (PaymentFlow.mkBasicAuthData apiKey) externalAccountReq + PaymentFlow.callStripeAPI url eulerClient "create-external-account" proxy + +-- Get External Account (READ) +type GetExternalAccountAPI = + "v1" + :> "accounts" + :> Capture "account_id" AccountId + :> "external_accounts" + :> Capture "id" Text + :> BasicAuth "secretkey-password" BasicAuthData + :> Get '[JSON] ExternalAccountObject + +getExternalAccount :: + ( Metrics.CoreMetrics m, + MonadFlow m, + HasRequestId r, + MonadReader r m + ) => + BaseUrl -> + Text -> + AccountId -> + ExternalAccountId -> + m ExternalAccountObject +getExternalAccount url apiKey accountId (ExternalAccountId externalAccountId) = do + let proxy = Proxy @GetExternalAccountAPI + eulerClient = Euler.client proxy accountId externalAccountId (PaymentFlow.mkBasicAuthData apiKey) + PaymentFlow.callStripeAPI url eulerClient "get-external-account" proxy + +-- Update External Account (UPDATE) +type UpdateExternalAccountAPI = + "v1" + :> "accounts" + :> Capture "account_id" AccountId + :> "external_accounts" + :> Capture "id" Text + :> BasicAuth "secretkey-password" BasicAuthData + :> ReqBody '[FormUrlEncoded] UpdateExternalAccountReq + :> Post '[JSON] ExternalAccountObject + +updateExternalAccount :: + ( Metrics.CoreMetrics m, + MonadFlow m, + HasRequestId r, + MonadReader r m + ) => + BaseUrl -> + Text -> + AccountId -> + ExternalAccountId -> + UpdateExternalAccountReq -> + m ExternalAccountObject +updateExternalAccount url apiKey accountId (ExternalAccountId externalAccountId) updateReq = do + let proxy = Proxy @UpdateExternalAccountAPI + eulerClient = Euler.client proxy accountId externalAccountId (PaymentFlow.mkBasicAuthData apiKey) updateReq + PaymentFlow.callStripeAPI url eulerClient "update-external-account" proxy + +-- Delete External Account (DELETE) +type DeleteExternalAccountAPI = + "v1" + :> "accounts" + :> Capture "account_id" AccountId + :> "external_accounts" + :> Capture "id" Text + :> BasicAuth "secretkey-password" BasicAuthData + :> Delete '[JSON] DeletedExternalAccount + +deleteExternalAccount :: + ( Metrics.CoreMetrics m, + MonadFlow m, + HasRequestId r, + MonadReader r m + ) => + BaseUrl -> + Text -> + AccountId -> + ExternalAccountId -> + m DeletedExternalAccount +deleteExternalAccount url apiKey accountId (ExternalAccountId externalAccountId) = do + let proxy = Proxy @DeleteExternalAccountAPI + eulerClient = Euler.client proxy accountId externalAccountId (PaymentFlow.mkBasicAuthData apiKey) + PaymentFlow.callStripeAPI url eulerClient "delete-external-account" proxy diff --git a/lib/mobility-core/src/Kernel/External/Payout/Stripe/Types.hs b/lib/mobility-core/src/Kernel/External/Payout/Stripe/Types.hs index ad3c0f25d..69c48a59f 100644 --- a/lib/mobility-core/src/Kernel/External/Payout/Stripe/Types.hs +++ b/lib/mobility-core/src/Kernel/External/Payout/Stripe/Types.hs @@ -4,4 +4,5 @@ module Kernel.External.Payout.Stripe.Types where import Kernel.External.Payout.Stripe.Types.Common as Reexport +import Kernel.External.Payout.Stripe.Types.ExternalAccount as Reexport import Kernel.External.Payout.Stripe.Types.Payout as Reexport diff --git a/lib/mobility-core/src/Kernel/External/Payout/Stripe/Types/ExternalAccount.hs b/lib/mobility-core/src/Kernel/External/Payout/Stripe/Types/ExternalAccount.hs new file mode 100644 index 000000000..3066237dc --- /dev/null +++ b/lib/mobility-core/src/Kernel/External/Payout/Stripe/Types/ExternalAccount.hs @@ -0,0 +1,134 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Kernel.External.Payout.Stripe.Types.ExternalAccount where + +import Data.Aeson +import qualified Data.HashMap.Strict as HM +import Data.OpenApi (ToSchema (declareNamedSchema), genericDeclareNamedSchema) +import Kernel.External.Payout.Stripe.Types.Common +import Kernel.Prelude +import Kernel.Utils.JSON +import qualified Kernel.Utils.Schema as S +import Web.FormUrlEncoded +import Web.HttpApiData (FromHttpApiData (..), ToHttpApiData (..)) + +type AccountId = Text + +newtype ExternalAccountId = ExternalAccountId Text + deriving newtype (Show, Eq, ToHttpApiData, FromHttpApiData) + +data ExternalAccountReq = ExternalAccountReq + { _object :: Text, -- "bank_account" or "card" + country :: Text, + currency :: Text, + account_number :: Maybe Text, -- For bank accounts: SENSITIVE + routing_number :: Maybe Text, -- For bank accounts: SENSITIVE + number :: Maybe Text, -- For cards: SENSITIVE + exp_month :: Maybe Int, -- For cards: SENSITIVE + exp_year :: Maybe Int, -- For cards: SENSITIVE + cvc :: Maybe Text, -- For cards: SENSITIVE + default_for_currency :: Maybe Bool, + metadata :: Maybe Metadata + } + deriving stock (Generic) + +instance ToForm ExternalAccountReq where + toForm ExternalAccountReq {..} = + Form $ + HM.fromList $ + [ ("external_account[object]", [toQueryParam _object]), + ("external_account[country]", [toQueryParam country]), + ("external_account[currency]", [toQueryParam currency]) + ] + <> catMaybes + [ ("external_account[account_number]",) . pure <$> account_number, + ("external_account[routing_number]",) . pure <$> routing_number, + ("external_account[number]",) . pure . toQueryParam <$> number, + ("external_account[exp_month]",) . pure . toQueryParam <$> exp_month, + ("external_account[exp_year]",) . pure . toQueryParam <$> exp_year, + ("external_account[cvc]",) . pure <$> cvc, + ("external_account[metadata][order_id]",) . pure . toQueryParam <$> (metadata >>= (.order_id)), + ("external_account[metadata][customer_id]",) . pure . toQueryParam <$> (metadata >>= (.customer_id)), + ("external_account[metadata][order_type]",) . pure . toQueryParam <$> (metadata >>= (.order_type)) + ] + +data ExternalAccountObject = ExternalAccountObject + { id :: Text, + _object :: Text, -- "bank_account" or "card" + account :: Text, -- The account this external account is attached to + account_holder_name :: Maybe Text, + account_holder_type :: Maybe Text, -- "individual" or "company" + account_type :: Maybe Text, -- "checking", "savings", etc. + available_payout_methods :: Maybe [Text], + bank_name :: Maybe Text, + country :: Text, + currency :: Text, + default_for_currency :: Maybe Bool, + fingerprint :: Maybe Text, + last4 :: Text, + metadata :: Maybe Metadata, + routing_number :: Maybe Text, + status :: Text -- "new", "validated", "verified", "verification_failed", "errored" + } + deriving stock (Show, Generic) + +instance FromJSON ExternalAccountObject where + parseJSON = genericParseJSON stripPrefixUnderscoreIfAny + +instance ToJSON ExternalAccountObject where + toJSON = genericToJSON stripPrefixUnderscoreIfAny + +instance ToSchema ExternalAccountObject where + declareNamedSchema = genericDeclareNamedSchema S.stripPrefixUnderscoreIfAny + +data ExternalAccountList = ExternalAccountList + { _object :: Text, -- Always "list" + _data :: [ExternalAccountObject], + has_more :: Bool, + url :: Text, -- API endpoint URL + total_count :: Maybe Int + } + deriving stock (Show, Generic) + +instance FromJSON ExternalAccountList where + parseJSON = genericParseJSON stripPrefixUnderscoreIfAny + +instance ToJSON ExternalAccountList where + toJSON = genericToJSON stripPrefixUnderscoreIfAny + +instance ToSchema ExternalAccountList where + declareNamedSchema = genericDeclareNamedSchema S.stripPrefixUnderscoreIfAny + +data UpdateExternalAccountReq = UpdateExternalAccountReq + { default_for_currency :: Maybe Bool, + metadata :: Maybe Metadata + } + deriving stock (Show, Generic) + +instance ToForm UpdateExternalAccountReq where + toForm UpdateExternalAccountReq {..} = + Form $ + HM.fromList $ + catMaybes + [ ("default_for_currency",) . pure . toQueryParam <$> default_for_currency, + ("metadata[order_id]",) . pure . toQueryParam <$> (metadata >>= (.order_id)), + ("metadata[customer_id]",) . pure . toQueryParam <$> (metadata >>= (.customer_id)), + ("metadata[order_type]",) . pure . toQueryParam <$> (metadata >>= (.order_type)) + ] + +data DeletedExternalAccount = DeletedExternalAccount + { id :: Text, + _object :: Text, + deleted :: Bool + } + deriving stock (Show, Generic) + +instance FromJSON DeletedExternalAccount where + parseJSON = genericParseJSON stripPrefixUnderscoreIfAny + +instance ToJSON DeletedExternalAccount where + toJSON = genericToJSON stripPrefixUnderscoreIfAny + +instance ToSchema DeletedExternalAccount where + declareNamedSchema = genericDeclareNamedSchema S.stripPrefixUnderscoreIfAny From cba56ea03129cfe068ad21d66e4966bb73180c9d Mon Sep 17 00:00:00 2001 From: Roman Bodavsky Date: Tue, 28 Apr 2026 12:36:37 +0300 Subject: [PATCH 3/3] backend/feat: interface functions for Stripe external account --- .../src/Kernel/External/Payout/Interface.hs | 66 +++++++++ .../External/Payout/Interface/Stripe.hs | 127 ++++++++++++++++++ .../Kernel/External/Payout/Interface/Types.hs | 98 +++++++++++++- 3 files changed, 289 insertions(+), 2 deletions(-) diff --git a/lib/mobility-core/src/Kernel/External/Payout/Interface.hs b/lib/mobility-core/src/Kernel/External/Payout/Interface.hs index c739f38c1..c880eff9a 100644 --- a/lib/mobility-core/src/Kernel/External/Payout/Interface.hs +++ b/lib/mobility-core/src/Kernel/External/Payout/Interface.hs @@ -23,6 +23,7 @@ import Kernel.External.Payout.Interface.Types as Reexport import Kernel.External.Payout.Types as Reexport import Kernel.Prelude import Kernel.Tools.Metrics.CoreMetrics (CoreMetrics) +import Kernel.Types.Error (GenericError (InvalidRequest)) import Kernel.Utils.Common createPayoutOrder :: @@ -51,3 +52,68 @@ payoutOrderStatus :: payoutOrderStatus serviceConfig req = case serviceConfig of JuspayConfig cfg -> Juspay.payoutOrderStatus cfg req StripeConfig cfg -> Stripe.payoutOrderStatus cfg req + +listExternalAccounts :: + ( EncFlow m r, + CoreMetrics m, + HasRequestId r, + MonadReader r m + ) => + PayoutServiceConfig -> + ListExternalAccountsReq -> + m ListExternalAccountsResp +listExternalAccounts serviceConfig req = case serviceConfig of + JuspayConfig _ -> throwError $ InvalidRequest "Juspay List External Accounts not supported." + StripeConfig cfg -> Stripe.listExternalAccounts cfg req + +createExternalAccount :: + ( EncFlow m r, + CoreMetrics m, + HasRequestId r, + MonadReader r m + ) => + PayoutServiceConfig -> + CreateExternalAccountReq -> + m CreateExternalAccountResp +createExternalAccount serviceConfig req = case serviceConfig of + JuspayConfig _ -> throwError $ InvalidRequest "Juspay Create External Account not supported." + StripeConfig cfg -> Stripe.createExternalAccount cfg req + +getExternalAccount :: + ( EncFlow m r, + CoreMetrics m, + HasRequestId r, + MonadReader r m + ) => + PayoutServiceConfig -> + GetExternalAccountReq -> + m GetExternalAccountResp +getExternalAccount serviceConfig req = case serviceConfig of + JuspayConfig _ -> throwError $ InvalidRequest "Juspay Get External Account not supported." + StripeConfig cfg -> Stripe.getExternalAccount cfg req + +updateExternalAccount :: + ( EncFlow m r, + CoreMetrics m, + HasRequestId r, + MonadReader r m + ) => + PayoutServiceConfig -> + UpdateExternalAccountReq -> + m UpdateExternalAccountResp +updateExternalAccount serviceConfig req = case serviceConfig of + JuspayConfig _ -> throwError $ InvalidRequest "Juspay Update External Account not supported" + StripeConfig cfg -> Stripe.updateExternalAccount cfg req + +deleteExternalAccount :: + ( EncFlow m r, + CoreMetrics m, + HasRequestId r, + MonadReader r m + ) => + PayoutServiceConfig -> + DeleteExternalAccountReq -> + m DeleteExternalAccountResp +deleteExternalAccount serviceConfig req = case serviceConfig of + JuspayConfig _ -> throwError $ InvalidRequest "Juspay Delete External Account not supported." + StripeConfig cfg -> Stripe.deleteExternalAccount cfg req 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 bdfb6d4ed..db61001af 100644 --- a/lib/mobility-core/src/Kernel/External/Payout/Interface/Stripe.hs +++ b/lib/mobility-core/src/Kernel/External/Payout/Interface/Stripe.hs @@ -1,6 +1,11 @@ module Kernel.External.Payout.Interface.Stripe ( createPayoutOrder, payoutOrderStatus, + listExternalAccounts, + createExternalAccount, + getExternalAccount, + updateExternalAccount, + deleteExternalAccount, ) where @@ -97,3 +102,125 @@ castPayoutStatus = \case Stripe.PAYOUT_PAID -> Juspay.SUCCESS Stripe.PAYOUT_FAILED -> Juspay.FAILURE Stripe.PAYOUT_CANCELED -> Juspay.CANCELLED + +listExternalAccounts :: + ( Metrics.CoreMetrics m, + EncFlow m r, + HasRequestId r, + MonadReader r m + ) => + StripeConfig -> + ListExternalAccountsReq -> + m ListExternalAccountsResp +listExternalAccounts config ListExternalAccountsReq {..} = do + apiKey <- decrypt config.apiKey + stripeResp <- Stripe.listExternalAccounts config.url apiKey accountId objectType limit startingAfter endingBefore + pure $ mkListExternalAccountsResp stripeResp + +createExternalAccount :: + ( Metrics.CoreMetrics m, + EncFlow m r, + HasRequestId r, + MonadReader r m + ) => + StripeConfig -> + CreateExternalAccountReq -> + m CreateExternalAccountResp +createExternalAccount config CreateExternalAccountReq {..} = do + apiKey <- decrypt config.apiKey + stripeResp <- Stripe.createExternalAccount config.url apiKey accountId (mkStripeExternalAccountReq CreateExternalAccountReq {..}) + pure $ mkExternalAccountResp stripeResp + +getExternalAccount :: + ( Metrics.CoreMetrics m, + EncFlow m r, + HasRequestId r, + MonadReader r m + ) => + StripeConfig -> + GetExternalAccountReq -> + m GetExternalAccountResp +getExternalAccount config GetExternalAccountReq {..} = do + apiKey <- decrypt config.apiKey + stripeResp <- Stripe.getExternalAccount config.url apiKey accountId (Stripe.ExternalAccountId externalAccountId) + pure $ mkExternalAccountResp stripeResp + +updateExternalAccount :: + ( Metrics.CoreMetrics m, + EncFlow m r, + HasRequestId r, + MonadReader r m + ) => + StripeConfig -> + UpdateExternalAccountReq -> + m UpdateExternalAccountResp +updateExternalAccount config UpdateExternalAccountReq {..} = do + apiKey <- decrypt config.apiKey + stripeResp <- Stripe.updateExternalAccount config.url apiKey accountId (Stripe.ExternalAccountId externalAccountId) (mkStripeUpdateExternalAccountReq UpdateExternalAccountReq {..}) + pure $ mkExternalAccountResp stripeResp + +deleteExternalAccount :: + ( Metrics.CoreMetrics m, + EncFlow m r, + HasRequestId r, + MonadReader r m + ) => + StripeConfig -> + DeleteExternalAccountReq -> + m DeleteExternalAccountResp +deleteExternalAccount config DeleteExternalAccountReq {..} = do + apiKey <- decrypt config.apiKey + stripeResp <- Stripe.deleteExternalAccount config.url apiKey accountId (Stripe.ExternalAccountId externalAccountId) + pure $ mkDeleteExternalAccountResp stripeResp + +mkStripeExternalAccountReq :: CreateExternalAccountReq -> Stripe.ExternalAccountReq +mkStripeExternalAccountReq CreateExternalAccountReq {..} = + Stripe.ExternalAccountReq + { _object = externalAccountObject, + country = externalAccountCountry, + currency = T.toLower $ show externalAccountCurrency, + account_number = externalBankAccountNumber, + routing_number = externalBankRoutingNumber, + number = externalAccountNumber, + exp_month = externalAccountExpMonth, + exp_year = externalAccountExpYear, + cvc = externalAccountCvc, + default_for_currency = externalAccountDefaultForCurrency, + metadata = externalAccountMetadata + } + +mkStripeUpdateExternalAccountReq :: UpdateExternalAccountReq -> Stripe.UpdateExternalAccountReq +mkStripeUpdateExternalAccountReq UpdateExternalAccountReq {..} = + Stripe.UpdateExternalAccountReq + { default_for_currency = externalAccountDefaultForCurrency, + metadata = externalAccountMetadata + } + +mkExternalAccountResp :: Stripe.ExternalAccountObject -> ExternalAccount +mkExternalAccountResp Stripe.ExternalAccountObject {..} = + ExternalAccount + { id = id, + externalAccountObject = _object, + account = account, + bankName = bank_name, + country = country, + -- currency = currency, + defaultForCurrency = default_for_currency, + last4 = last4, + status = status + } + +mkListExternalAccountsResp :: Stripe.ExternalAccountList -> ListExternalAccountsResp +mkListExternalAccountsResp Stripe.ExternalAccountList {..} = + ListExternalAccountsResp + { accounts = mkExternalAccountResp <$> _data, + hasMore = has_more + } + +mkDeleteExternalAccountResp :: Stripe.DeletedExternalAccount -> DeleteExternalAccountResp +mkDeleteExternalAccountResp Stripe.DeletedExternalAccount {..} = + DeleteExternalAccountResp + { externalAccountId = id, + externalAccountObject = _object, + externalAccountDeleted = deleted + } 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 7fdf94f94..4e7f767fa 100644 --- a/lib/mobility-core/src/Kernel/External/Payout/Interface/Types.hs +++ b/lib/mobility-core/src/Kernel/External/Payout/Interface/Types.hs @@ -25,13 +25,14 @@ where import Kernel.Beam.Lib.UtilsTH (mkBeamInstancesForEnum) import qualified Kernel.External.Payout.Juspay.Config as Juspay import Kernel.External.Payout.Juspay.Types as Reexport (Fulfillment (..), PayoutOrderStatus (..)) -import qualified Kernel.External.Payout.Stripe.Config as Stripe +import qualified Kernel.External.Payout.Stripe.Config as StripeCfg +import qualified Kernel.External.Payout.Stripe.Types as Stripe import Kernel.Prelude import Kernel.Storage.Esqueleto (derivePersistField) import Kernel.Types.Common import Servant.API (ToHttpApiData (..)) -data PayoutServiceConfig = JuspayConfig Juspay.JuspayConfig | StripeConfig Stripe.StripeConfig +data PayoutServiceConfig = JuspayConfig Juspay.JuspayConfig | StripeConfig StripeCfg.StripeConfig deriving (Show, Eq, Generic, ToJSON, FromJSON) data OrderStatusPayoutResp @@ -111,3 +112,96 @@ data PayoutOrderStatusReq = PayoutOrderStatusReq deriving anyclass (FromJSON, ToJSON) type PayoutOrderStatusResp = CreatePayoutOrderResp + +data ListExternalAccountsReq = ListExternalAccountsReq + { accountId :: AccountId, + objectType :: Maybe Text, + limit :: Maybe Int, + startingAfter :: Maybe Text, + endingBefore :: Maybe Text + } + +-- deriving stock (Show, Eq, Generic) +-- deriving anyclass (FromJSON, ToJSON, ToSchema) + +data ExternalAccount = ExternalAccount + { id :: Text, + externalAccountObject :: Text, + account :: Text, + bankName :: Maybe Text, + country :: Text, + -- currency :: Currency, + defaultForCurrency :: Maybe Bool, + last4 :: Text, + status :: Text + } + +-- deriving stock (Show, Eq, Generic) +-- deriving anyclass (FromJSON, ToJSON, ToSchema) + +data ListExternalAccountsResp = ListExternalAccountsResp + { accounts :: [ExternalAccount], + hasMore :: Bool + } + +-- deriving stock (Show, Eq, Generic) +-- deriving anyclass (FromJSON, ToJSON, ToSchema) + +data CreateExternalAccountReq = CreateExternalAccountReq + { accountId :: AccountId, + externalAccountObject :: Text, -- "bank_account" or "card" + externalAccountCountry :: Text, + externalAccountCurrency :: Currency, + externalAccountNumber :: Maybe Text, -- card number + externalAccountExpMonth :: Maybe Int, + externalAccountExpYear :: Maybe Int, + externalAccountCvc :: Maybe Text, + externalBankAccountNumber :: Maybe Text, + externalBankRoutingNumber :: Maybe Text, + externalAccountDefaultForCurrency :: Maybe Bool, + externalAccountMetadata :: Maybe Stripe.Metadata + } + +-- deriving stock (Show, Generic) +-- deriving anyclass (FromJSON, ToJSON, ToSchema) + +type CreateExternalAccountResp = ExternalAccount + +data GetExternalAccountReq = GetExternalAccountReq + { accountId :: AccountId, + externalAccountId :: Text + } + +-- deriving stock (Show, Eq, Generic) +-- deriving anyclass (FromJSON, ToJSON, ToSchema) + +type GetExternalAccountResp = ExternalAccount + +data UpdateExternalAccountReq = UpdateExternalAccountReq + { accountId :: AccountId, + externalAccountId :: Text, + externalAccountDefaultForCurrency :: Maybe Bool, + externalAccountMetadata :: Maybe Stripe.Metadata + } + +-- deriving stock (Show, Generic) +-- deriving anyclass (FromJSON, ToJSON, ToSchema) + +type UpdateExternalAccountResp = ExternalAccount + +data DeleteExternalAccountReq = DeleteExternalAccountReq + { accountId :: AccountId, + externalAccountId :: Text + } + +-- deriving stock (Show, Eq, Generic) +-- deriving anyclass (FromJSON, ToJSON, ToSchema) + +data DeleteExternalAccountResp = DeleteExternalAccountResp + { externalAccountId :: Text, + externalAccountObject :: Text, + externalAccountDeleted :: Bool + } + +-- deriving stock (Show, Eq, Generic) +-- deriving anyclass (FromJSON, ToJSON, ToSchema)