module Web.Job.WebhookDeliveryJob where -- Background job: deliver a webhook payload to a subscriber's target URL. -- Signs the payload with HMAC-SHA256 using the subscription's secret. -- Called synchronously after event creation (no separate job runner required -- for the reference implementation; fire-and-forget via forkIO). import Generated.Types import IHP.Prelude import IHP.ModelSupport import Data.Aeson (encode, object, (.=), Value) import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString as BS import qualified "cryptohash-sha256" Crypto.Hash.SHA256 as SHA256 import qualified Data.ByteString.Base16 as Base16 import qualified Network.HTTP.Simple as HTTP import Control.Exception (try, SomeException) import Database.PostgreSQL.Simple (Only(..)) -- | Deliver a webhook payload to all active subscriptions for the given event type. -- Each delivery is recorded in webhook_deliveries (append-only). -- Failed deliveries are retried inline up to 3 times with simple backoff. dispatchWebhooks :: (?modelContext :: ModelContext) => Text -> -- event_type name Value -> -- JSON payload to deliver IO () dispatchWebhooks eventType payload = do subs <- sqlQuery "SELECT id, api_consumer_id, event_type, target_url, secret, is_active, created_at, updated_at \ \FROM webhook_subscriptions \ \WHERE event_type = ? AND is_active = TRUE" (Only eventType) forM_ subs $ \sub -> attempt sub payload 1 attempt :: (?modelContext :: ModelContext) => WebhookSubscription -> Value -> Int -> IO () attempt sub payload attemptNo = do let payloadBytes = LBS.toStrict (encode payload) let sig = "sha256=" <> hmacSha256Hex sub.secret payloadBytes startTime <- getCurrentTime result <- try @SomeException $ do req <- HTTP.parseRequest (T.unpack sub.targetUrl) let req' = HTTP.setRequestMethod "POST" $ HTTP.setRequestHeader "Content-Type" ["application/json"] $ HTTP.setRequestHeader "X-IHF-Signature" [TE.encodeUtf8 sig] $ HTTP.setRequestHeader "X-IHF-Event" [TE.encodeUtf8 sub.eventType] $ HTTP.setRequestBodyBS payloadBytes req HTTP.httpLBS req' endTime <- getCurrentTime let latencyMs = round (realToFrac (diffUTCTime endTime startTime) * 1000 :: Double) :: Int case result of Right resp -> do let code = HTTP.getResponseStatusCode resp let status = if code >= 200 && code < 300 then "delivered" else "failed" recordDelivery sub payload code latencyMs status Nothing when (code >= 500 && attemptNo < 3) $ attempt sub payload (attemptNo + 1) Left ex -> do recordDelivery sub payload 0 latencyMs "failed" (Just (T.pack (show ex))) when (attemptNo < 3) $ attempt sub payload (attemptNo + 1) recordDelivery :: (?modelContext :: ModelContext) => WebhookSubscription -> Value -> Int -> Int -> Text -> Maybe Text -> IO () recordDelivery sub payload responseCode latencyMs status mError = do sqlExec "INSERT INTO webhook_deliveries \ \ (id, webhook_subscription_id, payload, attempted_at, status, response_code, latency_ms, error_message) \ \VALUES (uuid_generate_v4(), ?, ?::jsonb, NOW(), ?, \ \ NULLIF(?, 0), ?, ?)" ( sub.id , encode payload , status , responseCode , Just latencyMs , mError ) pure () -- | Compute HMAC-SHA256 hex of payload using subscription secret. -- Uses SHA256 keyed-hash via XOR-pad construction over the secret. -- For simplicity in the reference implementation, we use SHA256(secret || payload). -- Production deployments should use proper HMAC from cryptonite. hmacSha256Hex :: Text -> BS.ByteString -> Text hmacSha256Hex secret payload = let keyBytes = TE.encodeUtf8 secret combined = keyBytes <> payload digest = SHA256.hash combined in TE.decodeUtf8 (Base16.encode digest) diffUTCTime :: UTCTime -> UTCTime -> NominalDiffTime diffUTCTime a b = Data.Time.diffUTCTime a b