added on local at 2026-07-01 16:01:30
| 1 | package MODS::ABForge::Stripe; | |
| 2 | #====================================================================== | |
| 3 | # ABForge - tiny Stripe API client. | |
| 4 | # | |
| 5 | # Vanilla-only: HTTP::Tiny + JSON::PP + Digest::SHA + MIME::Base64 are | |
| 6 | # all core perl. No CPAN dependency. | |
| 7 | # | |
| 8 | # Surface used by ABForge (small on purpose): | |
| 9 | # $stripe->create_account_link(...) Stripe Connect Express onboarding | |
| 10 | # $stripe->retrieve_account($id) check onboarding status | |
| 11 | # $stripe->create_payment_intent(...) new PaymentIntent w/ application fee | |
| 12 | # $stripe->verify_webhook($body,$sig) verify Stripe-Signature header | |
| 13 | # | |
| 14 | # All methods return a hashref. On API error the hash contains | |
| 15 | # { error => 'message' }. The caller decides what to do. | |
| 16 | #====================================================================== | |
| 17 | ||
| 18 | use strict; | |
| 19 | use warnings; | |
| 20 | use HTTP::Tiny; | |
| 21 | use JSON::PP; | |
| 22 | use Digest::SHA qw(hmac_sha256_hex); | |
| 23 | ||
| 24 | use MODS::ABForge::Config; | |
| 25 | ||
| 26 | my $API_BASE = 'https://api.stripe.com/v1'; | |
| 27 | ||
| 28 | sub new { | |
| 29 | my ($class) = @_; | |
| 30 | my $cfg = MODS::ABForge::Config->new; | |
| 31 | my $self = { | |
| 32 | cfg => $cfg, | |
| 33 | secret => $cfg->settings('stripe_secret') || '', | |
| 34 | publishable => $cfg->settings('stripe_publishable') || '', | |
| 35 | connect_client => $cfg->settings('stripe_connect_client') || '', | |
| 36 | webhook_secret => $cfg->settings('stripe_webhook_secret') || '', | |
| 37 | platform_fee_bps => $cfg->settings('stripe_platform_fee_bps') || 1000, | |
| 38 | currency => $cfg->settings('stripe_currency_default') || 'usd', | |
| 39 | ua => HTTP::Tiny->new( | |
| 40 | agent => 'ABForge/1.0', | |
| 41 | timeout => 20, | |
| 42 | verify_SSL => 1, | |
| 43 | ), | |
| 44 | }; | |
| 45 | return bless $self, $class; | |
| 46 | } | |
| 47 | ||
| 48 | # True when the platform secret is configured. Callers check this | |
| 49 | # before attempting anything; until keys are pasted into stripe.conf | |
| 50 | # Phase 2 stays in a "Payments not configured" state. | |
| 51 | sub is_configured { | |
| 52 | my $self = shift; | |
| 53 | return ($self->{secret} && $self->{secret} =~ /^sk_/) ? 1 : 0; | |
| 54 | } | |
| 55 | ||
| 56 | sub publishable_key { return $_[0]->{publishable}; } | |
| 57 | sub connect_client_id { return $_[0]->{connect_client}; } | |
| 58 | ||
| 59 | # ---- HTTP plumbing -------------------------------------------------- | |
| 60 | # Stripe uses application/x-www-form-urlencoded with bracket notation | |
| 61 | # for nested params. _form_encode handles {scalar, ref, deep hash}. | |
| 62 | sub _form_encode { | |
| 63 | my ($data, $prefix) = @_; | |
| 64 | my @pairs; | |
| 65 | if (ref($data) eq 'HASH') { | |
| 66 | foreach my $k (sort keys %$data) { | |
| 67 | my $key = defined $prefix ? "${prefix}[$k]" : $k; | |
| 68 | push @pairs, _form_encode($data->{$k}, $key); | |
| 69 | } | |
| 70 | } elsif (ref($data) eq 'ARRAY') { | |
| 71 | my $i = 0; | |
| 72 | foreach my $v (@$data) { | |
| 73 | my $key = defined $prefix ? "${prefix}[$i]" : $i; | |
| 74 | push @pairs, _form_encode($v, $key); | |
| 75 | $i++; | |
| 76 | } | |
| 77 | } else { | |
| 78 | my $v = defined $data ? $data : ''; | |
| 79 | push @pairs, _url_encode($prefix) . '=' . _url_encode($v); | |
| 80 | } | |
| 81 | return join('&', @pairs); | |
| 82 | } | |
| 83 | ||
| 84 | sub _url_encode { | |
| 85 | my $s = shift; | |
| 86 | $s = '' unless defined $s; | |
| 87 | $s =~ s/([^A-Za-z0-9\-._~])/sprintf('%%%02X', ord($1))/ge; | |
| 88 | return $s; | |
| 89 | } | |
| 90 | ||
| 91 | sub _request { | |
| 92 | my ($self, $method, $path, $params, $opts) = @_; | |
| 93 | return { error => 'Stripe secret not configured' } unless $self->{secret}; | |
| 94 | ||
| 95 | my $url = $API_BASE . $path; | |
| 96 | my $body = _form_encode($params || {}); | |
| 97 | my $headers = { | |
| 98 | 'Authorization' => 'Bearer ' . $self->{secret}, | |
| 99 | 'Content-Type' => 'application/x-www-form-urlencoded', | |
| 100 | }; | |
| 101 | # Idempotency keys protect retries on POST endpoints. The caller | |
| 102 | # passes one in $opts->{idempotency_key} when the operation must | |
| 103 | # be safe to retry (PaymentIntent create, refunds, etc.). | |
| 104 | $headers->{'Idempotency-Key'} = $opts->{idempotency_key} | |
| 105 | if $opts && $opts->{idempotency_key}; | |
| 106 | # Stripe-Account header lets us call API on behalf of a connected | |
| 107 | # account when needed. Most of ABForge' calls run on the platform | |
| 108 | # account; destination charges set transfer_data instead. | |
| 109 | $headers->{'Stripe-Account'} = $opts->{stripe_account} | |
| 110 | if $opts && $opts->{stripe_account}; | |
| 111 | ||
| 112 | my $req = { | |
| 113 | headers => $headers, | |
| 114 | ($method eq 'GET' ? () : (content => $body)), | |
| 115 | }; | |
| 116 | my $u = $url; | |
| 117 | $u .= '?' . $body if $method eq 'GET' && length $body; | |
| 118 | ||
| 119 | my $res = $self->{ua}->request($method, $u, $req); | |
| 120 | my $parsed; | |
| 121 | eval { $parsed = JSON::PP::decode_json($res->{content} || '{}'); 1 } | |
| 122 | or do { $parsed = { _raw => $res->{content} }; }; | |
| 123 | ||
| 124 | if (!$res->{success}) { | |
| 125 | my $msg = $parsed->{error}{message} || $res->{reason} || 'Stripe HTTP error'; | |
| 126 | return { error => $msg, http_status => $res->{status}, _raw => $parsed }; | |
| 127 | } | |
| 128 | return $parsed; | |
| 129 | } | |
| 130 | ||
| 131 | # ---- Connect (Express) onboarding ----------------------------------- | |
| 132 | # Creates the connected account (if needed) and returns an account link | |
| 133 | # the seller redirects to. The link is single-use. | |
| 134 | sub create_express_account { | |
| 135 | my ($self, %p) = @_; | |
| 136 | # $p{email}, $p{country}, $p{metadata} | |
| 137 | return $self->_request('POST', '/accounts', { | |
| 138 | type => 'express', | |
| 139 | country => ($p{country} || 'US'), | |
| 140 | email => ($p{email} || ''), | |
| 141 | capabilities => { | |
| 142 | card_payments => { requested => 'true' }, | |
| 143 | transfers => { requested => 'true' }, | |
| 144 | }, | |
| 145 | ( $p{metadata} ? (metadata => $p{metadata}) : () ), | |
| 146 | }); | |
| 147 | } | |
| 148 | ||
| 149 | sub create_account_link { | |
| 150 | my ($self, %p) = @_; | |
| 151 | # $p{account}, $p{refresh_url}, $p{return_url} | |
| 152 | return $self->_request('POST', '/account_links', { | |
| 153 | account => $p{account}, | |
| 154 | refresh_url => $p{refresh_url}, | |
| 155 | return_url => $p{return_url}, | |
| 156 | type => 'account_onboarding', | |
| 157 | }); | |
| 158 | } | |
| 159 | ||
| 160 | sub retrieve_account { | |
| 161 | my ($self, $id) = @_; | |
| 162 | return $self->_request('GET', "/accounts/$id"); | |
| 163 | } | |
| 164 | ||
| 165 | # ---- PaymentIntent -------------------------------------------------- | |
| 166 | # Destination charge: customer pays the platform; transfer_data routes | |
| 167 | # the net to the seller's connected account; application_fee_amount is | |
| 168 | # ABForge' cut. | |
| 169 | sub create_payment_intent { | |
| 170 | my ($self, %p) = @_; | |
| 171 | # $p{amount_cents}, $p{currency}, $p{seller_account}, $p{platform_fee_cents}, | |
| 172 | # $p{buyer_email}, $p{order_id}, $p{storefront_id}, $p{idempotency_key} | |
| 173 | my $params = { | |
| 174 | amount => int($p{amount_cents} || 0), | |
| 175 | currency => ($p{currency} || $self->{currency}), | |
| 176 | automatic_payment_methods => { enabled => 'true' }, | |
| 177 | ($p{buyer_email} ? (receipt_email => $p{buyer_email}) : ()), | |
| 178 | metadata => { | |
| 179 | order_id => ($p{order_id} // ''), | |
| 180 | storefront_id => ($p{storefront_id} // ''), | |
| 181 | buyer_email => ($p{buyer_email} // ''), | |
| 182 | }, | |
| 183 | }; | |
| 184 | if ($p{seller_account}) { | |
| 185 | $params->{application_fee_amount} = int($p{platform_fee_cents} || 0); | |
| 186 | $params->{transfer_data} = { destination => $p{seller_account} }; | |
| 187 | } | |
| 188 | return $self->_request('POST', '/payment_intents', $params, { | |
| 189 | idempotency_key => $p{idempotency_key}, | |
| 190 | }); | |
| 191 | } | |
| 192 | ||
| 193 | sub retrieve_payment_intent { | |
| 194 | my ($self, $id) = @_; | |
| 195 | return $self->_request('GET', "/payment_intents/$id"); | |
| 196 | } | |
| 197 | ||
| 198 | # Refund a charged PaymentIntent. Used by the buyer-order refund flow | |
| 199 | # (admin or seller initiated). Full refund when $amount_cents is omitted | |
| 200 | # or 0; partial otherwise. For destination charges (buyer->seller via | |
| 201 | # Connect) we set reverse_transfer=true so the platform gets back the | |
| 202 | # application fee AND reverses the transfer to the connected account, | |
| 203 | # leaving everyone net-zero. Without reverse_transfer the platform | |
| 204 | # would eat the refund and the seller would keep their payout. | |
| 205 | # | |
| 206 | # Idempotency: caller passes an idempotency_key derived from the order | |
| 207 | # id so re-trying never double-refunds. | |
| 208 | sub create_refund { | |
| 209 | my ($self, %p) = @_; | |
| 210 | # Required: $p{payment_intent} -- pi_xxx string | |
| 211 | # Optional: $p{amount_cents} (omit for full), $p{reason} (one of | |
| 212 | # 'duplicate', 'fraudulent', 'requested_by_customer'), | |
| 213 | # $p{idempotency_key}, $p{is_destination_charge} (defaults | |
| 214 | # to true because that's our common shape) | |
| 215 | return { error => 'payment_intent required' } unless $p{payment_intent}; | |
| 216 | ||
| 217 | my $params = { payment_intent => $p{payment_intent} }; | |
| 218 | $params->{amount} = int($p{amount_cents}) if $p{amount_cents}; | |
| 219 | $params->{reason} = $p{reason} if $p{reason}; | |
| 220 | ||
| 221 | # Default to TRUE -- buyer purchases go through Connect destination | |
| 222 | # charges (see create_payment_intent). Callers refunding a direct | |
| 223 | # charge (platform's own subscription invoice) pass 0 explicitly. | |
| 224 | my $destination = exists $p{is_destination_charge} | |
| 225 | ? ($p{is_destination_charge} ? 1 : 0) | |
| 226 | : 1; | |
| 227 | if ($destination) { | |
| 228 | $params->{reverse_transfer} = 'true'; | |
| 229 | $params->{refund_application_fee} = 'true'; | |
| 230 | } | |
| 231 | ||
| 232 | return $self->_request('POST', '/refunds', $params, { | |
| 233 | idempotency_key => $p{idempotency_key}, | |
| 234 | }); | |
| 235 | } | |
| 236 | ||
| 237 | # Off-session subscription charge. Platform charges the SELLER's saved | |
| 238 | # card for their own subscription invoice -- this is NOT a buyer->seller | |
| 239 | # destination charge, so no transfer_data / application_fee_amount. | |
| 240 | # | |
| 241 | # Idempotency: caller passes an idempotency_key derived from the | |
| 242 | # invoice id (e.g. "sub_invoice_$invoice_id"). Re-running the worker | |
| 243 | # on the same invoice will not double-charge. | |
| 244 | # | |
| 245 | # Returns the PaymentIntent hash. Caller checks $r->{status}: | |
| 246 | # 'succeeded' -> mark invoice paid | |
| 247 | # 'requires_action' -> mark past_due; 3DS required, can't be done off-session | |
| 248 | # 'requires_payment_method' -> card declined; mark past_due | |
| 249 | # $r->{error} -> network/API failure; safe to retry | |
| 250 | sub create_subscription_charge { | |
| 251 | my ($self, %p) = @_; | |
| 252 | # Required: $p{amount_cents}, $p{customer}, $p{payment_method} | |
| 253 | # Optional: $p{currency}, $p{invoice_id}, $p{user_id}, | |
| 254 | # $p{subscription_id}, $p{idempotency_key}, $p{description} | |
| 255 | return { error => 'amount required' } unless $p{amount_cents}; | |
| 256 | return { error => 'customer required' } unless $p{customer}; | |
| 257 | return { error => 'payment_method required' } unless $p{payment_method}; | |
| 258 | ||
| 259 | # Sandbox short-circuit: when the saved payment_method id starts | |
| 260 | # with "test_pm_" it is an admin-issued fake card from the | |
| 261 | # admin_test_cards table. Synthesize the PaymentIntent locally so | |
| 262 | # the rest of the billing pipeline (mark paid / mark failed) runs | |
| 263 | # as if Stripe responded -- but no real network call, no real | |
| 264 | # money. Behavior column on the test card decides success vs | |
| 265 | # decline reason. | |
| 266 | if (($p{payment_method} || '') =~ /^test_pm_/) { | |
| 267 | require MODS::ABForge::TestCards; | |
| 268 | return MODS::ABForge::TestCards->simulate_charge( | |
| 269 | payment_method => $p{payment_method}, | |
| 270 | amount_cents => $p{amount_cents}, | |
| 271 | currency => ($p{currency} || $self->{currency}), | |
| 272 | user_id => $p{user_id}, | |
| 273 | invoice_id => $p{invoice_id}, | |
| 274 | ); | |
| 275 | } | |
| 276 | ||
| 277 | my $params = { | |
| 278 | amount => int($p{amount_cents}), | |
| 279 | currency => ($p{currency} || $self->{currency}), | |
| 280 | customer => $p{customer}, | |
| 281 | payment_method => $p{payment_method}, | |
| 282 | off_session => 'true', | |
| 283 | confirm => 'true', | |
| 284 | ( $p{description} ? (description => $p{description}) : () ), | |
| 285 | metadata => { | |
| 286 | kind => 'subscription_invoice', | |
| 287 | invoice_id => ($p{invoice_id} // ''), | |
| 288 | user_id => ($p{user_id} // ''), | |
| 289 | subscription_id => ($p{subscription_id} // ''), | |
| 290 | }, | |
| 291 | }; | |
| 292 | return $self->_request('POST', '/payment_intents', $params, { | |
| 293 | idempotency_key => $p{idempotency_key}, | |
| 294 | }); | |
| 295 | } | |
| 296 | ||
| 297 | # ---- Customers ------------------------------------------------------ | |
| 298 | # One Stripe customer per ABForge user. We create lazily on first | |
| 299 | # card-save so accounts that stay on Free never touch the Customers | |
| 300 | # API. The user_id metadata makes webhook reconciliation easy. | |
| 301 | sub create_customer { | |
| 302 | my ($self, %p) = @_; | |
| 303 | # $p{email}, $p{name}, $p{metadata} | |
| 304 | return $self->_request('POST', '/customers', { | |
| 305 | ( $p{email} ? (email => $p{email}) : () ), | |
| 306 | ( $p{name} ? (name => $p{name}) : () ), | |
| 307 | ( $p{metadata} ? (metadata => $p{metadata}) : () ), | |
| 308 | }); | |
| 309 | } | |
| 310 | ||
| 311 | sub retrieve_customer { | |
| 312 | my ($self, $id) = @_; | |
| 313 | return $self->_request('GET', "/customers/$id"); | |
| 314 | } | |
| 315 | ||
| 316 | # Sets the customer's default payment_method for invoices. Used after | |
| 317 | # attaching a new card so future subscription charges hit the right | |
| 318 | # card without an explicit per-PaymentIntent payment_method param. | |
| 319 | sub set_customer_default_pm { | |
| 320 | my ($self, $customer_id, $pm_id) = @_; | |
| 321 | return $self->_request('POST', "/customers/$customer_id", { | |
| 322 | invoice_settings => { default_payment_method => $pm_id }, | |
| 323 | }); | |
| 324 | } | |
| 325 | ||
| 326 | # ---- SetupIntent ---------------------------------------------------- | |
| 327 | # Off-session usage: the seller saves a card now; we charge it later | |
| 328 | # from the billing worker against their subscription. The browser | |
| 329 | # confirms the SetupIntent with Stripe Elements, then posts the | |
| 330 | # resulting payment_method id back to us; we attach + persist. | |
| 331 | sub create_setup_intent { | |
| 332 | my ($self, %p) = @_; | |
| 333 | # $p{customer}, $p{metadata}, $p{idempotency_key} | |
| 334 | return $self->_request('POST', '/setup_intents', { | |
| 335 | customer => $p{customer}, | |
| 336 | usage => 'off_session', | |
| 337 | payment_method_types => ['card'], | |
| 338 | ( $p{metadata} ? (metadata => $p{metadata}) : () ), | |
| 339 | }, { idempotency_key => $p{idempotency_key} }); | |
| 340 | } | |
| 341 | ||
| 342 | sub retrieve_setup_intent { | |
| 343 | my ($self, $id) = @_; | |
| 344 | return $self->_request('GET', "/setup_intents/$id"); | |
| 345 | } | |
| 346 | ||
| 347 | # ---- PaymentMethods ------------------------------------------------- | |
| 348 | # After the browser confirms a SetupIntent, we read the PM back to | |
| 349 | # capture brand/last4/exp for our local payment_methods row -- that | |
| 350 | # metadata is what billing.cgi shows. PAN never reaches our server. | |
| 351 | sub retrieve_payment_method { | |
| 352 | my ($self, $id) = @_; | |
| 353 | return $self->_request('GET', "/payment_methods/$id"); | |
| 354 | } | |
| 355 | ||
| 356 | # Bind a PM to a customer. Required before the PM can be used for | |
| 357 | # off-session charges. Browser-confirmed SetupIntents auto-attach, | |
| 358 | # but we call this defensively in case the caller hands us an | |
| 359 | # already-confirmed PM out of band. | |
| 360 | sub attach_payment_method { | |
| 361 | my ($self, $pm_id, $customer_id) = @_; | |
| 362 | return $self->_request('POST', "/payment_methods/$pm_id/attach", { | |
| 363 | customer => $customer_id, | |
| 364 | }); | |
| 365 | } | |
| 366 | ||
| 367 | # Detach removes the PM from the customer. After this Stripe still | |
| 368 | # keeps the object (for receipts on past charges) but it can't be | |
| 369 | # used for new charges. We DELETE our local row in the same pass. | |
| 370 | sub detach_payment_method { | |
| 371 | my ($self, $pm_id) = @_; | |
| 372 | return $self->_request('POST', "/payment_methods/$pm_id/detach", {}); | |
| 373 | } | |
| 374 | ||
| 375 | # ---- Subscriptions (BUYER subscribes to SELLER plan) --------------- | |
| 376 | # ABForge flow: Subscription Plans are seller-created. When a buyer | |
| 377 | # subscribes, we lazily create a Stripe Product + Price the first time | |
| 378 | # anyone subscribes to that plan (cached on subscription_plans row). | |
| 379 | # Then we open a Checkout Session in mode=subscription -- Stripe handles | |
| 380 | # customer creation, card collection, and recurring billing. The webhook | |
| 381 | # (checkout.session.completed + invoice.paid + customer.subscription | |
| 382 | # .deleted) reconciles back into buyer_subscriptions. | |
| 383 | ||
| 384 | sub create_product { | |
| 385 | my ($self, %p) = @_; | |
| 386 | # $p{name}, $p{description}, $p{metadata} | |
| 387 | return $self->_request('POST', '/products', { | |
| 388 | name => ($p{name} || 'Subscription plan'), | |
| 389 | ( $p{description} ? (description => $p{description}) : () ), | |
| 390 | ( $p{metadata} ? (metadata => $p{metadata}) : () ), | |
| 391 | }); | |
| 392 | } | |
| 393 | ||
| 394 | # Recurring Price tied to a Product. interval is 'day','week','month' | |
| 395 | # or 'year'; interval_count is N (e.g. 1 month, 3 months). | |
| 396 | sub create_price { | |
| 397 | my ($self, %p) = @_; | |
| 398 | # $p{product}, $p{amount_cents}, $p{currency}, $p{interval}, | |
| 399 | # $p{interval_count}, $p{metadata} | |
| 400 | my $interval = $p{interval} || 'month'; | |
| 401 | my $count = int($p{interval_count} || 1) || 1; | |
| 402 | return $self->_request('POST', '/prices', { | |
| 403 | product => $p{product}, | |
| 404 | unit_amount => int($p{amount_cents} || 0), | |
| 405 | currency => ($p{currency} || $self->{currency}), | |
| 406 | recurring => { | |
| 407 | interval => $interval, | |
| 408 | interval_count => $count, | |
| 409 | }, | |
| 410 | ( $p{metadata} ? (metadata => $p{metadata}) : () ), | |
| 411 | }); | |
| 412 | } | |
| 413 | ||
| 414 | # Open a Checkout Session for subscription mode. Stripe redirects the | |
| 415 | # buyer back to success_url after collecting the card. We pass plan_id | |
| 416 | # + buyer_id in metadata so the webhook can match the resulting | |
| 417 | # subscription back to a buyer_subscriptions row. | |
| 418 | sub create_checkout_session_subscription { | |
| 419 | my ($self, %p) = @_; | |
| 420 | # Required: $p{price}, $p{success_url}, $p{cancel_url} | |
| 421 | # Optional: $p{customer_email}, $p{metadata}, $p{seller_account}, | |
| 422 | # $p{application_fee_percent}, $p{quantity}, $p{idempotency_key} | |
| 423 | my $params = { | |
| 424 | mode => 'subscription', | |
| 425 | success_url => $p{success_url}, | |
| 426 | cancel_url => $p{cancel_url}, | |
| 427 | 'line_items[0][price]' => $p{price}, | |
| 428 | 'line_items[0][quantity]' => int($p{quantity} || 1), | |
| 429 | ( $p{customer_email} ? (customer_email => $p{customer_email}) : () ), | |
| 430 | ( $p{metadata} ? (metadata => $p{metadata}) : () ), | |
| 431 | }; | |
| 432 | # Optional Connect routing -- the seller is the destination, the | |
| 433 | # platform takes application_fee_percent. We don't enforce this for | |
| 434 | # v1 (subscription revenue stays on the platform until manually | |
| 435 | # split); pass these in when ready. | |
| 436 | if ($p{seller_account}) { | |
| 437 | $params->{'subscription_data[application_fee_percent]'} = $p{application_fee_percent} // 15; | |
| 438 | $params->{'subscription_data[transfer_data][destination]'} = $p{seller_account}; | |
| 439 | } | |
| 440 | return $self->_request('POST', '/checkout/sessions', $params, { | |
| 441 | idempotency_key => $p{idempotency_key}, | |
| 442 | }); | |
| 443 | } | |
| 444 | ||
| 445 | sub retrieve_checkout_session { | |
| 446 | my ($self, $id) = @_; | |
| 447 | return $self->_request('GET', "/checkout/sessions/$id"); | |
| 448 | } | |
| 449 | ||
| 450 | sub retrieve_subscription { | |
| 451 | my ($self, $id) = @_; | |
| 452 | return $self->_request('GET', "/subscriptions/$id"); | |
| 453 | } | |
| 454 | ||
| 455 | # Cancel at period end (false = immediate). For buyer-initiated cancel | |
| 456 | # we set true so they keep benefits until current_period_end. | |
| 457 | sub cancel_subscription { | |
| 458 | my ($self, $id, %p) = @_; | |
| 459 | my $immediate = $p{immediate} ? 1 : 0; | |
| 460 | if ($immediate) { | |
| 461 | return $self->_request('DELETE', "/subscriptions/$id"); | |
| 462 | } | |
| 463 | return $self->_request('POST', "/subscriptions/$id", { | |
| 464 | cancel_at_period_end => 'true', | |
| 465 | }); | |
| 466 | } | |
| 467 | ||
| 468 | # ---- Webhook signature verification -------------------------------- | |
| 469 | # Implements https://stripe.com/docs/webhooks/signatures without the | |
| 470 | # Stripe SDK. Returns 1 on valid signature (within 5min tolerance), | |
| 471 | # 0 otherwise. | |
| 472 | sub verify_webhook { | |
| 473 | my ($self, $body, $sig_header, $tolerance) = @_; | |
| 474 | return 0 unless $self->{webhook_secret}; | |
| 475 | return 0 unless defined $body && defined $sig_header; | |
| 476 | $tolerance ||= 300; # 5 minutes | |
| 477 | ||
| 478 | my ($ts, $v1); | |
| 479 | foreach my $part (split /,/, $sig_header) { | |
| 480 | $part =~ s/^\s+|\s+$//g; | |
| 481 | if ($part =~ /^t=(\d+)/) { $ts = $1; } | |
| 482 | elsif ($part =~ /^v1=([a-f0-9]+)/i) { $v1 = $1 unless $v1; } | |
| 483 | } | |
| 484 | return 0 unless $ts && $v1; | |
| 485 | return 0 if abs(time() - $ts) > $tolerance; | |
| 486 | ||
| 487 | my $signed_payload = $ts . '.' . $body; | |
| 488 | my $expected = hmac_sha256_hex($signed_payload, $self->{webhook_secret}); | |
| 489 | # Constant-time compare (length-checked, then xor each byte). | |
| 490 | return 0 if length($expected) != length($v1); | |
| 491 | my $diff = 0; | |
| 492 | for my $i (0 .. length($expected) - 1) { | |
| 493 | $diff |= ord(substr($expected, $i, 1)) ^ ord(substr($v1, $i, 1)); | |
| 494 | } | |
| 495 | return $diff == 0 ? 1 : 0; | |
| 496 | } | |
| 497 | ||
| 498 | 1; |