added on local at 2026-07-01 22:09:46
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # ShopCart - Stripe webhook handler. | |
| 4 | # | |
| 5 | # Endpoint: POST /stripe_webhook.cgi | |
| 6 | # | |
| 7 | # Stripe POSTs JSON with a Stripe-Signature header. We verify the | |
| 8 | # signature against stripe_webhook_secret (read from /private/stripe.conf | |
| 9 | # via Config.pm) before parsing the event. | |
| 10 | # | |
| 11 | # Events handled: | |
| 12 | # payment_intent.succeeded -> route on metadata.kind: | |
| 13 | # 'subscription_invoice' -> mark invoice paid | |
| 14 | # otherwise -> mark order paid + log conversion | |
| 15 | # payment_intent.payment_failed -> same routing as succeeded, opposite outcome | |
| 16 | # charge.refunded -> mark order refunded (or partial) | |
| 17 | # account.updated -> bump stripe_onboarded_at if charges_enabled | |
| 18 | # | |
| 19 | # We always respond 200 OK so Stripe doesn't retry; failures are logged | |
| 20 | # server-side. Stripe's docs explicitly recommend this pattern. | |
| 21 | #====================================================================== | |
| 22 | use strict; | |
| 23 | use warnings; | |
| 24 | ||
| 25 | use lib '/var/www/vhosts/3dshawn.com/shop.3dshawn.com'; | |
| 26 | use CGI; | |
| 27 | use JSON::PP; | |
| 28 | use MODS::DBConnect; | |
| 29 | use MODS::ShopCart::Config; | |
| 30 | use MODS::ShopCart::Stripe; | |
| 31 | use MODS::ShopCart::Experiments; | |
| 32 | use MODS::ShopCart::Promotions; | |
| 33 | use MODS::ShopCart::Billing; | |
| 34 | use MODS::ShopCart::Receipts; | |
| 35 | use MODS::ShopCart::BuyerCredits; | |
| 36 | ||
| 37 | $| = 1; | |
| 38 | ||
| 39 | sub _ok { | |
| 40 | print "Status: 200 OK\nContent-Type: text/plain\n\nok\n"; | |
| 41 | exit; | |
| 42 | } | |
| 43 | sub _esc { | |
| 44 | my $s = shift // ''; | |
| 45 | $s =~ s/\\/\\\\/g; | |
| 46 | $s =~ s/'/''/g; | |
| 47 | return $s; | |
| 48 | } | |
| 49 | ||
| 50 | # Read raw body from STDIN. CGI->new touches STDIN already, so we read | |
| 51 | # it ourselves before constructing CGI for headers. | |
| 52 | my $raw_body; | |
| 53 | { | |
| 54 | local $/; | |
| 55 | $raw_body = <STDIN> // ''; | |
| 56 | } | |
| 57 | ||
| 58 | my $sig = $ENV{HTTP_STRIPE_SIGNATURE} || ''; | |
| 59 | my $stripe = MODS::ShopCart::Stripe->new; | |
| 60 | unless ($stripe->is_configured) { | |
| 61 | # No keys yet -- swallow the request rather than 500ing so Stripe | |
| 62 | # doesn't keep retrying during the bootstrap phase. | |
| 63 | _ok(); | |
| 64 | } | |
| 65 | unless ($stripe->verify_webhook($raw_body, $sig)) { | |
| 66 | print "Status: 400 Bad Request\nContent-Type: text/plain\n\nbad signature\n"; | |
| 67 | exit; | |
| 68 | } | |
| 69 | ||
| 70 | my $event; | |
| 71 | eval { $event = JSON::PP::decode_json($raw_body); 1 } or _ok(); | |
| 72 | my $type = $event->{type} || ''; | |
| 73 | my $obj = $event->{data}{object} || {}; | |
| 74 | ||
| 75 | my $db = MODS::DBConnect->new; | |
| 76 | my $cfg = MODS::ShopCart::Config->new; | |
| 77 | my $DB = $cfg->settings('database_name'); | |
| 78 | my $dbh = $db->db_connect(); | |
| 79 | ||
| 80 | if ($type eq 'payment_intent.succeeded') { | |
| 81 | # Subscription-invoice PI: created by Billing::charge_invoice -> | |
| 82 | # Stripe::create_subscription_charge with metadata.kind set. Handle | |
| 83 | # here and short-circuit so the order branch never tries to look up | |
| 84 | # an order id that does not exist. | |
| 85 | my $kind_meta = $obj->{metadata}{kind} || ''; | |
| 86 | if ($kind_meta eq 'subscription_invoice') { | |
| 87 | my $invoice_id = $obj->{metadata}{invoice_id} || ''; | |
| 88 | $invoice_id =~ s/[^0-9]//g; | |
| 89 | my $pi_id_sub = $obj->{id} || ''; | |
| 90 | $pi_id_sub =~ s/[^A-Za-z0-9_]//g; | |
| 91 | my $amt = $obj->{amount_received} || $obj->{amount} || 0; | |
| 92 | if ($invoice_id) { | |
| 93 | my $bill = MODS::ShopCart::Billing->new; | |
| 94 | $bill->mark_invoice_paid($db, $dbh, $DB, $invoice_id, | |
| 95 | cash_paid_cents => $amt, | |
| 96 | stripe_payment_intent_id => $pi_id_sub, | |
| 97 | ); | |
| 98 | } | |
| 99 | $db->db_disconnect($dbh); | |
| 100 | _ok(); | |
| 101 | } | |
| 102 | ||
| 103 | my $pi_id = $obj->{id} || ''; | |
| 104 | my $oid_meta = $obj->{metadata}{order_id} || ''; | |
| 105 | $pi_id =~ s/'/''/g; | |
| 106 | $oid_meta =~ s/[^0-9]//g; | |
| 107 | ||
| 108 | # Resolve the order. Prefer metadata.order_id (created at intent | |
| 109 | # time) and fall back to the unique stripe_payment_intent_id index. | |
| 110 | # Pull applied_promotion_id + discount_applied_cents so we can write | |
| 111 | # the matching promotion_redemptions row below. | |
| 112 | my $order; | |
| 113 | if ($oid_meta) { | |
| 114 | $order = $db->db_readwrite($dbh, qq~ | |
| 115 | SELECT id, storefront_id, buyer_email, status, | |
| 116 | buyer_account_id, applied_promotion_id, discount_applied_cents | |
| 117 | FROM `${DB}`.orders WHERE id='$oid_meta' LIMIT 1 | |
| 118 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 119 | } | |
| 120 | if (!$order && $pi_id) { | |
| 121 | $order = $db->db_readwrite($dbh, qq~ | |
| 122 | SELECT id, storefront_id, buyer_email, status, | |
| 123 | buyer_account_id, applied_promotion_id, discount_applied_cents | |
| 124 | FROM `${DB}`.orders WHERE stripe_payment_intent_id='$pi_id' LIMIT 1 | |
| 125 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 126 | } | |
| 127 | ||
| 128 | if ($order && $order->{id} && $order->{status} ne 'paid') { | |
| 129 | my $oid = $order->{id}; | |
| 130 | $db->db_readwrite($dbh, qq~ | |
| 131 | UPDATE `${DB}`.orders | |
| 132 | SET status='paid', paid_at=NOW() | |
| 133 | WHERE id='$oid' | |
| 134 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 135 | ||
| 136 | # Promo redemption -- write only on payment success, never on | |
| 137 | # pending/failed, so a declined card doesn't burn the buyer's | |
| 138 | # max_per_user slot. The discount is already baked into | |
| 139 | # total_amount_cents; this row is the audit trail + bump for | |
| 140 | # the promo's redemption counter. | |
| 141 | if ($order->{applied_promotion_id} && $order->{applied_promotion_id} > 0) { | |
| 142 | my $promo_mod = MODS::ShopCart::Promotions->new; | |
| 143 | $promo_mod->redeem($db, $dbh, $DB, | |
| 144 | promotion_id => $order->{applied_promotion_id}, | |
| 145 | target_kind => 'model', | |
| 146 | order_id => $oid, | |
| 147 | buyer_account_id => $order->{buyer_account_id}, | |
| 148 | buyer_email => $order->{buyer_email}, | |
| 149 | discount_applied_cents => $order->{discount_applied_cents} || 0, | |
| 150 | ); | |
| 151 | } | |
| 152 | ||
| 153 | # If a buyer_account exists for this email, retroactively link | |
| 154 | # the order so the buyer can see it on /my_orders.cgi. | |
| 155 | my $email = $order->{buyer_email} || ''; | |
| 156 | my $sid = $order->{storefront_id} || 0; | |
| 157 | if ($email && $sid) { | |
| 158 | my $ba = $db->db_readwrite($dbh, qq~ | |
| 159 | SELECT id FROM `${DB}`.buyer_accounts | |
| 160 | WHERE storefront_id='$sid' AND email='~ . _esc($email) . qq~' | |
| 161 | LIMIT 1 | |
| 162 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 163 | if ($ba && $ba->{id}) { | |
| 164 | $db->db_readwrite($dbh, qq~ | |
| 165 | UPDATE `${DB}`.orders SET buyer_account_id='$ba->{id}' | |
| 166 | WHERE id='$oid' AND buyer_account_id IS NULL | |
| 167 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 168 | } | |
| 169 | } | |
| 170 | ||
| 171 | # Log a conversion event for any running A/B experiments. The | |
| 172 | # visitor hash isn't on the order row -- experiments tie events | |
| 173 | # to visitor_hash, so we look it up from the cart token chain. | |
| 174 | # For now we log a generic 'purchase' event with the order's | |
| 175 | # total dollar amount tied to the most recent visitor view. | |
| 176 | my $total_dollars = ($obj->{amount} || 0) / 100; | |
| 177 | my $vh = $db->db_readwrite($dbh, qq~ | |
| 178 | SELECT visitor_hash FROM `${DB}`.view_events | |
| 179 | WHERE storefront_id='$sid' | |
| 180 | ORDER BY occurred_at DESC LIMIT 1 | |
| 181 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 182 | my $visitor_hash = ($vh && $vh->{visitor_hash}) ? $vh->{visitor_hash} : ''; | |
| 183 | if ($visitor_hash) { | |
| 184 | eval { | |
| 185 | my $exp = MODS::ShopCart::Experiments->new; | |
| 186 | $exp->log_event_for_visitor_experiments( | |
| 187 | $db, $dbh, $DB, $sid, $visitor_hash, 'purchase', $total_dollars | |
| 188 | ); | |
| 189 | }; | |
| 190 | } | |
| 191 | ||
| 192 | # Consume any store credit the buyer authorized at checkout. | |
| 193 | # Idempotent on (related_order_id, reason='order_apply') so a | |
| 194 | # retried webhook is safe. apply_to_order reads | |
| 195 | # orders.store_credit_applied_cents as the source of truth. | |
| 196 | eval { | |
| 197 | my $bc = MODS::ShopCart::BuyerCredits->new; | |
| 198 | $bc->apply_to_order($db, $dbh, $DB, $oid); | |
| 199 | }; | |
| 200 | ||
| 201 | # Decrement physical inventory for every order_items row whose | |
| 202 | # model has finite stock (inventory_qty >= 0). -1 = unlimited | |
| 203 | # print-to-order, so we leave it alone. UPDATE is bounded by | |
| 204 | # `inventory_qty > 0` to prevent the count from going negative | |
| 205 | # on a retried webhook (idempotent). Guarded by an | |
| 206 | # information_schema probe so legacy installs without the | |
| 207 | # variant columns don't crash. | |
| 208 | eval { | |
| 209 | my $oi_has_kind = $db->db_readwrite($dbh, qq~ | |
| 210 | SELECT COUNT(*) AS n FROM information_schema.columns | |
| 211 | WHERE table_schema='$DB' AND table_name='order_items' | |
| 212 | AND column_name='purchase_kind' | |
| 213 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 214 | if ($oi_has_kind && $oi_has_kind->{n}) { | |
| 215 | my @lines = $db->db_readwrite_multiple($dbh, qq~ | |
| 216 | SELECT model_id, quantity FROM `${DB}`.order_items | |
| 217 | WHERE order_id='$oid' AND purchase_kind='physical' | |
| 218 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 219 | foreach my $ln (@lines) { | |
| 220 | my $mid = $ln->{model_id}; $mid =~ s/[^0-9]//g; next unless $mid; | |
| 221 | my $qty = $ln->{quantity}; $qty =~ s/[^0-9]//g; $qty ||= 1; | |
| 222 | $db->db_readwrite($dbh, qq~ | |
| 223 | UPDATE `${DB}`.models | |
| 224 | SET inventory_qty = GREATEST(inventory_qty - $qty, 0) | |
| 225 | WHERE id='$mid' AND inventory_qty >= 0 | |
| 226 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 227 | } | |
| 228 | } | |
| 229 | }; | |
| 230 | ||
| 231 | # Send the buyer their receipt email with signed download | |
| 232 | # links. Wrapped in eval -- a mailer failure (no SMTP, MTA | |
| 233 | # down) must never block the webhook from returning 200, or | |
| 234 | # Stripe will retry and we'd double-process the order. The | |
| 235 | # send_for_order method itself is also defensive: bails on | |
| 236 | # missing config and prints to STDERR. | |
| 237 | eval { | |
| 238 | MODS::ShopCart::Receipts->send_for_order($db, $dbh, $DB, $oid); | |
| 239 | }; | |
| 240 | } | |
| 241 | } | |
| 242 | elsif ($type eq 'payment_intent.payment_failed') { | |
| 243 | my $kind_meta = $obj->{metadata}{kind} || ''; | |
| 244 | if ($kind_meta eq 'subscription_invoice') { | |
| 245 | my $invoice_id = $obj->{metadata}{invoice_id} || ''; | |
| 246 | $invoice_id =~ s/[^0-9]//g; | |
| 247 | my $pi_id_sub = $obj->{id} || ''; | |
| 248 | $pi_id_sub =~ s/[^A-Za-z0-9_]//g; | |
| 249 | my $err = ($obj->{last_payment_error} && $obj->{last_payment_error}{message}) | |
| 250 | ? $obj->{last_payment_error}{message} | |
| 251 | : 'Card declined.'; | |
| 252 | if ($invoice_id) { | |
| 253 | my $bill = MODS::ShopCart::Billing->new; | |
| 254 | $bill->mark_invoice_failed($db, $dbh, $DB, $invoice_id, | |
| 255 | reason => $err, | |
| 256 | stripe_payment_intent_id => $pi_id_sub, | |
| 257 | ); | |
| 258 | } | |
| 259 | $db->db_disconnect($dbh); | |
| 260 | _ok(); | |
| 261 | } | |
| 262 | ||
| 263 | my $pi_id = $obj->{id} || ''; | |
| 264 | $pi_id =~ s/'/''/g; | |
| 265 | $db->db_readwrite($dbh, qq~ | |
| 266 | UPDATE `${DB}`.orders | |
| 267 | SET status='failed' | |
| 268 | WHERE stripe_payment_intent_id='$pi_id' AND status='pending' | |
| 269 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 270 | } | |
| 271 | elsif ($type eq 'charge.refunded') { | |
| 272 | my $pi_id = $obj->{payment_intent} || ''; | |
| 273 | $pi_id =~ s/'/''/g; | |
| 274 | if ($pi_id) { | |
| 275 | my $amount_refunded = $obj->{amount_refunded} || 0; | |
| 276 | my $amount = $obj->{amount} || 0; | |
| 277 | my $new_status = ($amount_refunded >= $amount) ? 'refunded' : 'partially_refunded'; | |
| 278 | # Find the order before we update status so we can pass the id | |
| 279 | # to BuyerCredits->reverse_for_order on full refunds. | |
| 280 | my $ord = $db->db_readwrite($dbh, qq~ | |
| 281 | SELECT id FROM `${DB}`.orders | |
| 282 | WHERE stripe_payment_intent_id='$pi_id' LIMIT 1 | |
| 283 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 284 | $db->db_readwrite($dbh, qq~ | |
| 285 | UPDATE `${DB}`.orders | |
| 286 | SET status='$new_status' | |
| 287 | WHERE stripe_payment_intent_id='$pi_id' | |
| 288 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 289 | # Full refund: return any consumed buyer credit to the buyer's | |
| 290 | # ledger. Partial refund is messier (which line item was | |
| 291 | # refunded?); we skip the reversal for now to avoid silently | |
| 292 | # over-crediting. | |
| 293 | if ($ord && $ord->{id} && $new_status eq 'refunded') { | |
| 294 | eval { | |
| 295 | my $bc = MODS::ShopCart::BuyerCredits->new; | |
| 296 | $bc->reverse_for_order($db, $dbh, $DB, $ord->{id}); | |
| 297 | }; | |
| 298 | } | |
| 299 | } | |
| 300 | } | |
| 301 | elsif ($type eq 'checkout.session.completed') { | |
| 302 | # Buyer's subscription signup completed in Stripe Checkout. Match | |
| 303 | # back to buyer_subscriptions via metadata.buyer_subscription_id, | |
| 304 | # then activate + attach the stripe ids. | |
| 305 | my $mode = $obj->{mode} || ''; | |
| 306 | if ($mode eq 'subscription') { | |
| 307 | my $sub_id = $obj->{metadata}{buyer_subscription_id} || 0; | |
| 308 | my $cust = $obj->{customer} || ''; | |
| 309 | my $stripe_sub = $obj->{subscription} || ''; | |
| 310 | $sub_id =~ s/[^0-9]//g; | |
| 311 | for ($cust, $stripe_sub) { s/'/''/g; } | |
| 312 | if ($sub_id) { | |
| 313 | require MODS::ShopCart::Subscriptions; | |
| 314 | my $sm = MODS::ShopCart::Subscriptions->new; | |
| 315 | $db->db_readwrite($dbh, qq~ | |
| 316 | UPDATE `${DB}`.buyer_subscriptions | |
| 317 | SET stripe_customer_id = '$cust', | |
| 318 | stripe_subscription_id = '$stripe_sub' | |
| 319 | WHERE id='$sub_id' LIMIT 1 | |
| 320 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 321 | $sm->activate_from_stripe($db, $dbh, $DB, | |
| 322 | buyer_sub_id => $sub_id, | |
| 323 | stripe_customer_id => $cust, | |
| 324 | ); | |
| 325 | } | |
| 326 | } | |
| 327 | } | |
| 328 | elsif ($type eq 'invoice.paid' || $type eq 'invoice.payment_succeeded') { | |
| 329 | # Recurring renewal succeeded. Roll the period on the matching | |
| 330 | # buyer_subscriptions row. | |
| 331 | my $stripe_sub = $obj->{subscription} || ''; | |
| 332 | if ($stripe_sub) { | |
| 333 | require MODS::ShopCart::Subscriptions; | |
| 334 | my $sm = MODS::ShopCart::Subscriptions->new; | |
| 335 | my $bs = $sm->by_stripe_subscription_id($db, $dbh, $DB, $stripe_sub); | |
| 336 | if ($bs && $bs->{id}) { | |
| 337 | $sm->activate_from_stripe($db, $dbh, $DB, | |
| 338 | buyer_sub_id => $bs->{id}, | |
| 339 | ); | |
| 340 | } | |
| 341 | } | |
| 342 | } | |
| 343 | elsif ($type eq 'invoice.payment_failed') { | |
| 344 | my $stripe_sub = $obj->{subscription} || ''; | |
| 345 | if ($stripe_sub) { | |
| 346 | my $esc = $stripe_sub; $esc =~ s/'/''/g; | |
| 347 | $db->db_readwrite($dbh, qq~ | |
| 348 | UPDATE `${DB}`.buyer_subscriptions | |
| 349 | SET status='past_due' | |
| 350 | WHERE stripe_subscription_id='$esc' LIMIT 1 | |
| 351 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 352 | } | |
| 353 | } | |
| 354 | elsif ($type eq 'customer.subscription.deleted' | |
| 355 | || $type eq 'customer.subscription.canceled') { | |
| 356 | my $stripe_sub = $obj->{id} || ''; | |
| 357 | if ($stripe_sub) { | |
| 358 | my $esc = $stripe_sub; $esc =~ s/'/''/g; | |
| 359 | $db->db_readwrite($dbh, qq~ | |
| 360 | UPDATE `${DB}`.buyer_subscriptions | |
| 361 | SET status='canceled', canceled_at=NOW() | |
| 362 | WHERE stripe_subscription_id='$esc' LIMIT 1 | |
| 363 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 364 | } | |
| 365 | } | |
| 366 | elsif ($type eq 'account.updated') { | |
| 367 | my $acct_id = $obj->{id} || ''; | |
| 368 | $acct_id =~ s/'/''/g; | |
| 369 | my $charges_enabled = $obj->{charges_enabled} ? 1 : 0; | |
| 370 | my $details_done = $obj->{details_submitted} ? 1 : 0; | |
| 371 | if ($acct_id && $charges_enabled && $details_done) { | |
| 372 | $db->db_readwrite($dbh, qq~ | |
| 373 | UPDATE `${DB}`.storefronts | |
| 374 | SET stripe_onboarded_at=COALESCE(stripe_onboarded_at, NOW()) | |
| 375 | WHERE stripe_account_id='$acct_id' | |
| 376 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 377 | } | |
| 378 | } | |
| 379 | ||
| 380 | $db->db_disconnect($dbh); | |
| 381 | _ok(); |