diff --git a/lib/mobility-core/mobility-core.cabal b/lib/mobility-core/mobility-core.cabal index b693fec69..4d15fc88c 100644 --- a/lib/mobility-core/mobility-core.cabal +++ b/lib/mobility-core/mobility-core.cabal @@ -222,6 +222,8 @@ library Kernel.External.Payout.Stripe.Types.Common Kernel.External.Payout.Stripe.Types.Payout Kernel.External.Payout.Stripe.Types.Transfer + Kernel.External.Payout.Stripe.Types.Webhook + Kernel.External.Payout.Stripe.Webhook Kernel.External.Payout.Types Kernel.External.Plasma Kernel.External.Plasma.Interface diff --git a/lib/mobility-core/src/Kernel/External/Payment/Stripe/Webhook.hs b/lib/mobility-core/src/Kernel/External/Payment/Stripe/Webhook.hs index 670bc154c..c22cec860 100644 --- a/lib/mobility-core/src/Kernel/External/Payment/Stripe/Webhook.hs +++ b/lib/mobility-core/src/Kernel/External/Payment/Stripe/Webhook.hs @@ -15,6 +15,7 @@ module Kernel.External.Payment.Stripe.Webhook ( StripeWebhookAPI, serviceEventWebhook, + verifyStripeWebhookSignature, RawByteString (..), ) where @@ -89,24 +90,21 @@ serviceEventWebhook paymentConfig checkDuplicatedEvent serviceEventHandler mbSig logInfo $ "Stripe webhook parsing failed: " <> show err throwError $ InvalidRequest "STRIPE_WEBHOOK_PARSING_FAILED" -verifyAuth :: +-- | Verify @Stripe-Signature@ for a raw webhook body using the endpoint signing secret +-- (same algorithm for payment and payout Stripe webhook endpoints). +verifyStripeWebhookSignature :: EncFlow m r => - PaymentServiceConfig -> + EncryptedField 'AsEncrypted Text -> + Seconds -> Text -> RawByteString -> m () -verifyAuth config sigHeader (RawByteString rawBody) = do - (secret, tolerance) <- case config of - StripeConfig cfg -> do - webhookEndpointSecret <- cfg.webhookEndpointSecret & fromMaybeM (InternalError "STRIPE_WEBHOOK_SECRET_NOT_FOUND") - s <- decrypt webhookEndpointSecret - pure (s, fromMaybe 300 cfg.webhookToleranceSeconds) - _ -> throwError (InternalError "NOT_STRIPE_CONFIG") - +verifyStripeWebhookSignature encryptedWebhookSecret toleranceSeconds sigHeader (RawByteString rawBody) = do + secret <- decrypt encryptedWebhookSecret (ts, sigsV1) <- parseStripeSignature sigHeader now <- getCurrentTime let tsUtc = posixSecondsToUTCTime (fromIntegral ts) - when (diffUTCTime now tsUtc > fromIntegral tolerance) $ + when (diffUTCTime now tsUtc > fromIntegral toleranceSeconds) $ throwError (InvalidRequest "STRIPE_SIGNATURE_TIMESTAMP_OUT_OF_TOLERANCE") let rawStrictBody = LBS.toStrict rawBody @@ -116,6 +114,19 @@ verifyAuth config sigHeader (RawByteString rawBody) = do unless (any (secureEqHex expected) sigsV1) $ throwError (InvalidRequest "INVALID_STRIPE_SIGNATURE") +verifyAuth :: + EncFlow m r => + PaymentServiceConfig -> + Text -> + RawByteString -> + m () +verifyAuth config sigHeader rawBytes = case config of + StripeConfig cfg -> do + encryptedSecret <- cfg.webhookEndpointSecret & fromMaybeM (InternalError "STRIPE_WEBHOOK_SECRET_NOT_FOUND") + let tolerance = fromMaybe 300 cfg.webhookToleranceSeconds + verifyStripeWebhookSignature encryptedSecret tolerance sigHeader rawBytes + _ -> throwError (InternalError "NOT_STRIPE_CONFIG") + parseStripeSignature :: (MonadThrow m, Log m) => Text -> m (Int, [BS.ByteString]) parseStripeSignature hdr = do -- format: t=1697040000, v1=abcdef..., v1=... 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 2a984d36c..6d5b01fe6 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,10 @@ module Kernel.External.Payout.Interface.Stripe ( createExternalPayout, externalPayoutOrderStatus, createTransfer, + payoutStripeServiceEventWebhook, + castPayoutStatus, + unPayoutId, + module Reexport, ) where @@ -9,14 +13,20 @@ import Control.Applicative ((<|>)) import qualified Data.Text as T import Kernel.External.Encryption import Kernel.External.Payment.Interface.Stripe (centsToUsd, eurToCents, usdToCents) -import Kernel.External.Payout.Interface.Types +import Kernel.External.Payment.Stripe.Types.Common (Event) +import Kernel.External.Payment.Stripe.Webhook (RawByteString (..)) +import Kernel.External.Payout.Interface.Types as IPayout 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 qualified Kernel.External.Payout.Stripe.Types.Webhook as PayoutWh +import qualified Kernel.External.Payout.Stripe.Webhook as PayoutStripeWh import Kernel.Prelude import qualified Kernel.Tools.Metrics.CoreMetrics as Metrics +import Kernel.Types.Beckn.Ack import Kernel.Types.Error +import Kernel.Types.Id import Kernel.Utils.Common createExternalPayout :: @@ -119,3 +129,21 @@ createTransfer config req = do mkCreateTransferResp :: Stripe.TransferObject -> CreateTransferResp mkCreateTransferResp Stripe.TransferObject {..} = CreateTransferResp {transferId = id, transferStatus = TRANSFERRED} + +payoutStripeServiceEventWebhook :: + ( EncFlow m r, + HasRequestId r, + MonadReader r m + ) => + PayoutServiceConfig -> + (Id Event -> m Bool) -> + (PayoutWh.PayoutStripeWebhookReq -> Text -> m AckResponse) -> + Maybe Text -> + RawByteString -> + m AckResponse +payoutStripeServiceEventWebhook serviceConfig checkDuplicatedEvent serviceEventHandler mbSigHeader rawBytes = + case serviceConfig of + IPayout.StripeConfig cfg -> + PayoutStripeWh.payoutServiceEventWebhook cfg checkDuplicatedEvent serviceEventHandler mbSigHeader rawBytes + IPayout.JuspayConfig _ -> + throwError $ InternalError "NOT_STRIPE_PAYOUT_SERVICE_FOR_WEBHOOK" 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 ac87f3c5f..ba0c77da7 100644 --- a/lib/mobility-core/src/Kernel/External/Payout/Stripe/Types.hs +++ b/lib/mobility-core/src/Kernel/External/Payout/Stripe/Types.hs @@ -6,3 +6,4 @@ where import Kernel.External.Payout.Stripe.Types.Common as Reexport import Kernel.External.Payout.Stripe.Types.Payout as Reexport import Kernel.External.Payout.Stripe.Types.Transfer as Reexport +import Kernel.External.Payout.Stripe.Types.Webhook as Reexport diff --git a/lib/mobility-core/src/Kernel/External/Payout/Stripe/Types/Transfer.hs b/lib/mobility-core/src/Kernel/External/Payout/Stripe/Types/Transfer.hs index f4e4ab357..87bac347b 100644 --- a/lib/mobility-core/src/Kernel/External/Payout/Stripe/Types/Transfer.hs +++ b/lib/mobility-core/src/Kernel/External/Payout/Stripe/Types/Transfer.hs @@ -6,10 +6,12 @@ module Kernel.External.Payout.Stripe.Types.Transfer where import Data.Aeson import qualified Data.HashMap.Strict as HM +import Data.OpenApi (ToSchema (declareNamedSchema), genericDeclareNamedSchema) import Data.Time.Clock.POSIX (POSIXTime) import Kernel.External.Payment.Stripe.Types.Common import Kernel.Prelude import Kernel.Utils.JSON +import qualified Kernel.Utils.Schema as S import Web.FormUrlEncoded import Web.HttpApiData (ToHttpApiData (..)) @@ -37,7 +39,6 @@ instance ToForm TransferReq where ("description",) . pure . toQueryParam <$> description ] --- TODO webhook transfer.created, transfer.reversed, transfer.updated -- Currently transfer api would throw error instead of transfer object in case of failure, so there is no status field data TransferObject = TransferObject { id :: TransferId, @@ -54,3 +55,6 @@ instance FromJSON TransferObject where instance ToJSON TransferObject where toJSON = genericToJSON stripPrefixUnderscoreIfAny + +instance ToSchema TransferObject where + declareNamedSchema = genericDeclareNamedSchema S.stripPrefixUnderscoreIfAny diff --git a/lib/mobility-core/src/Kernel/External/Payout/Stripe/Types/Webhook.hs b/lib/mobility-core/src/Kernel/External/Payout/Stripe/Types/Webhook.hs new file mode 100644 index 000000000..dc3556b59 --- /dev/null +++ b/lib/mobility-core/src/Kernel/External/Payout/Stripe/Types/Webhook.hs @@ -0,0 +1,157 @@ +{-# LANGUAGE DerivingStrategies #-} + +-- | Stripe webhook payloads for the dedicated Connect payout webhook endpoint +-- (separate from payment webhooks; separate Stripe config). +-- +-- Includes @payout.*@ events and @transfer.*@ for a future transfer webhook or +-- the same endpoint if both event classes are subscribed. +module Kernel.External.Payout.Stripe.Types.Webhook where + +import Data.Aeson +import qualified Data.Aeson as A +import qualified Data.Bimap as BM +import Data.OpenApi (ToSchema (declareNamedSchema), genericDeclareNamedSchema) +import Data.Time.Clock.POSIX (POSIXTime) +import Kernel.External.Payment.Stripe.Types.Common (Event) +import Kernel.External.Payout.Stripe.Types.Payout (PayoutObject) +import Kernel.External.Payout.Stripe.Types.Transfer (TransferObject) +import Kernel.Prelude +import Kernel.Types.HideSecrets +import Kernel.Types.Id +import qualified Kernel.Utils.JSON as J +import qualified Kernel.Utils.Schema as S + +-- | Stripe @payout.*@ and @transfer.*@ webhook @type@ strings (Connect payout flow). +data PayoutStripeWebhookEventType + = -- Payout (data.object is a payout) + PayoutCanceled + | PayoutCreated + | PayoutFailed + | PayoutPaid + | PayoutReconciliationCompleted + | PayoutUpdated + | -- Transfer (data.object is a transfer); for future transfer webhook + TransferCreated + | TransferReversed + | TransferUpdated + | -- Unknown + PayoutStripeWebhookCustomEvent Text + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (ToSchema) + +payoutStripeWebhookEventTypeBimap :: BM.Bimap PayoutStripeWebhookEventType Text +payoutStripeWebhookEventTypeBimap = + BM.fromList + [ (PayoutCanceled, "payout.canceled"), + (PayoutCreated, "payout.created"), + (PayoutFailed, "payout.failed"), + (PayoutPaid, "payout.paid"), + (PayoutReconciliationCompleted, "payout.reconciliation_completed"), + (PayoutUpdated, "payout.updated"), + (TransferCreated, "transfer.created"), + (TransferReversed, "transfer.reversed"), + (TransferUpdated, "transfer.updated") + ] + +instance FromJSON PayoutStripeWebhookEventType where + parseJSON = withText "PayoutStripeWebhookEventType" $ \txt -> + pure $ fromMaybe (PayoutStripeWebhookCustomEvent txt) $ BM.lookupR txt payoutStripeWebhookEventTypeBimap + +instance ToJSON PayoutStripeWebhookEventType where + toJSON = String . payoutStripeWebhookEventTypeToText + +payoutStripeWebhookEventTypeToText :: PayoutStripeWebhookEventType -> Text +payoutStripeWebhookEventTypeToText eventType = case BM.lookup eventType payoutStripeWebhookEventTypeBimap of + Just txt -> txt + Nothing -> case eventType of + PayoutStripeWebhookCustomEvent t -> t + _ -> show eventType + +data PayoutStripeWebhookReq = PayoutStripeWebhookReq + { id :: Id Event, + _object :: Text, + api_version :: Text, + created :: POSIXTime, + _data :: PayoutStripeWebhookReqData, + livemode :: Bool, + pending_webhooks :: Integer, + request :: PayoutStripeWebhookRequest, + _type :: PayoutStripeWebhookEventType + } + deriving stock (Show, Generic) + +instance HideSecrets PayoutStripeWebhookReq where + hideSecrets PayoutStripeWebhookReq {..} = + PayoutStripeWebhookReq + { _data = hideSecrets @PayoutStripeWebhookReqData _data, + .. + } + +instance FromJSON PayoutStripeWebhookReq where + parseJSON = genericParseJSON J.stripPrefixUnderscoreIfAny + +instance ToJSON PayoutStripeWebhookReq where + toJSON = genericToJSON J.stripPrefixUnderscoreIfAny + +instance ToSchema PayoutStripeWebhookReq where + declareNamedSchema = genericDeclareNamedSchema S.stripPrefixUnderscoreIfAny + +newtype PayoutStripeWebhookReqData = PayoutStripeWebhookReqData + { _object :: PayoutStripeWebhookObject + } + deriving stock (Show, Generic) + +instance HideSecrets PayoutStripeWebhookReqData where + hideSecrets PayoutStripeWebhookReqData {..} = + PayoutStripeWebhookReqData + { _object = hideSecrets @PayoutStripeWebhookObject _object + } + +instance FromJSON PayoutStripeWebhookReqData where + parseJSON = genericParseJSON J.stripPrefixUnderscoreIfAny + +instance ToJSON PayoutStripeWebhookReqData where + toJSON = genericToJSON J.stripPrefixUnderscoreIfAny + +instance ToSchema PayoutStripeWebhookReqData where + declareNamedSchema = genericDeclareNamedSchema S.stripPrefixUnderscoreIfAny + +data PayoutStripeWebhookRequest = PayoutStripeWebhookRequest + { id :: Maybe Text, + idempotency_key :: Maybe Text + } + deriving stock (Show, Generic) + deriving anyclass (FromJSON, ToJSON, ToSchema) + +data PayoutStripeWebhookObject + = ObjectPayout PayoutObject + | ObjectTransfer TransferObject + | PayoutStripeWebhookCustomObject Text Value + deriving (Show, Generic) + deriving anyclass (ToSchema) + +getPayoutStripeWebhookObjectType :: PayoutStripeWebhookObject -> Text +getPayoutStripeWebhookObjectType = \case + ObjectPayout _ -> "payout" + ObjectTransfer obj -> obj._object + PayoutStripeWebhookCustomObject objType _val -> objType + +instance HideSecrets PayoutStripeWebhookObject where + hideSecrets = \case + ObjectPayout a -> ObjectPayout a + ObjectTransfer a -> ObjectTransfer a + PayoutStripeWebhookCustomObject objType _val -> PayoutStripeWebhookCustomObject objType A.Null + +instance ToJSON PayoutStripeWebhookObject where + toJSON = \case + ObjectPayout a -> toJSON @PayoutObject a + ObjectTransfer a -> toJSON @TransferObject a + PayoutStripeWebhookCustomObject _objType val -> val + +instance FromJSON PayoutStripeWebhookObject where + parseJSON val = flip (withObject "PayoutStripeWebhookObject") val $ \obj -> do + objectType :: Text <- obj .: "object" + case objectType of + "payout" -> ObjectPayout <$> parseJSON @PayoutObject val + "transfer" -> ObjectTransfer <$> parseJSON @TransferObject val + unknown -> pure $ PayoutStripeWebhookCustomObject unknown val diff --git a/lib/mobility-core/src/Kernel/External/Payout/Stripe/Webhook.hs b/lib/mobility-core/src/Kernel/External/Payout/Stripe/Webhook.hs new file mode 100644 index 000000000..5287d3619 --- /dev/null +++ b/lib/mobility-core/src/Kernel/External/Payout/Stripe/Webhook.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE DerivingStrategies #-} + +module Kernel.External.Payout.Stripe.Webhook + ( PayoutStripeWebhookAPI, + payoutServiceEventWebhook, + RawByteString (..), + ) +where + +import qualified Data.Aeson as A +import Kernel.External.Payment.Stripe.Types.Common (Event) +import Kernel.External.Payment.Stripe.Webhook (RawByteString (..), verifyStripeWebhookSignature) +import Kernel.External.Payout.Stripe.Config (StripeConfig (..)) +import qualified Kernel.External.Payout.Stripe.Types.Webhook as PayoutWh +import Kernel.Prelude +import Kernel.Types.Beckn.Ack +import Kernel.Types.Error +import Kernel.Types.HideSecrets +import Kernel.Types.Id +import Kernel.Utils.Common +import Servant hiding (throwError) + +type PayoutStripeWebhookAPI = + "service" :> "stripe" :> "payout" + :> Header "Stripe-Signature" Text + :> ReqBody '[OctetStream] RawByteString + :> Post '[JSON] AckResponse + +payoutServiceEventWebhook :: + ( EncFlow m r, + HasRequestId r, + MonadReader r m + ) => + StripeConfig -> + (Id Event -> m Bool) -> + (PayoutWh.PayoutStripeWebhookReq -> Text -> m AckResponse) -> + Maybe Text -> + RawByteString -> + m AckResponse +payoutServiceEventWebhook payoutStripeConfig checkDuplicatedEvent serviceEventHandler mbSigHeader rawBytes = do + withLogTag "stripePayoutWebhook" $ do + let mResp = A.eitherDecode (getRawByteString rawBytes) + case mResp of + Right (resp :: PayoutWh.PayoutStripeWebhookReq) -> withLogTag ("eventId-" <> resp.id.getId) $ do + sigHeader <- mbSigHeader & fromMaybeM (InvalidRequest "Stripe-Signature header did not found") + encryptedSecret <- payoutStripeConfig.webhookEndpointSecret & fromMaybeM (InternalError "STRIPE_PAYOUT_WEBHOOK_SECRET_NOT_FOUND") + let tolerance = fromMaybe (Seconds 300) payoutStripeConfig.webhookToleranceSeconds + void $ verifyStripeWebhookSignature encryptedSecret tolerance sigHeader rawBytes + fork "stripe payout webhook" $ do + isDuplicatedEvent <- checkDuplicatedEvent resp.id + if not isDuplicatedEvent + then do + let respDump = encodeToText $ hideSecrets @PayoutWh.PayoutStripeWebhookReq resp + void $ serviceEventHandler resp respDump + else do + logInfo $ "Duplicated Stripe payout webhook event found; skipping" + pure Ack + Left err -> do + logInfo $ "Stripe payout webhook parsing failed: " <> show err + throwError $ InvalidRequest "STRIPE_PAYOUT_WEBHOOK_PARSING_FAILED"