Diff -- /var/www/vhosts/3dshawn.com/affiliate.3dshawn.com/MODS/AffSoft/Stripe.pm
Diff

/var/www/vhosts/3dshawn.com/affiliate.3dshawn.com/MODS/AffSoft/Stripe.pm

added on local at 2026-07-01 13:47:31

Added
+522
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 58453a61b424
Restore this content →
Unified diff
Naive LCS-based line diff. Additions in emerald, deletions in rose. Both sides decompressed live from BLOB_STORE.
1package MODS::AffSoft::Stripe;
2#======================================================================
3# WebSTLs - 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 WebSTLs (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
18use strict;
19use warnings;
20use HTTP::Tiny;
21use JSON::PP;
22use Digest::SHA qw(hmac_sha256_hex);
23
24use MODS::AffSoft::Config;
25
26my $API_BASE = 'https://api.stripe.com/v1';
27
28sub new {
29 my ($class) = @_;
30 my $cfg = MODS::AffSoft::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 => 'WebSTLs/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.
51sub is_configured {
52 my $self = shift;
53 return ($self->{secret} && $self->{secret} =~ /^sk_/) ? 1 : 0;
54}
55
56sub publishable_key { return $_[0]->{publishable}; }
57sub 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}.
62sub _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
84sub _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
91sub _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 WebSTLs' 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.
134sub 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
149sub 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
160sub 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# WebSTLs' cut.
169sub 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
193sub 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.
208sub 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
250sub 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::AffSoft::TestCards;
268 return MODS::AffSoft::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 WebSTLs 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.
301sub 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
311sub retrieve_customer {
312 my ($self, $id) = @_;
313 return $self->_request('GET', "/customers/$id");
314}
315
316# Create a one-off invoice item that lands on the customer's next invoice.
317# Used for marketplace monetization (monthly source-commission + featured-
318# placement rollup). The invoice item is unbilled until Stripe generates
319# the next periodic invoice for the customer.
320sub create_invoice_item {
321 my ($self, %p) = @_;
322 # $p{customer} REQUIRED (cus_xxx)
323 # $p{amount_cents} REQUIRED
324 # $p{currency} default 'usd'
325 # $p{description} optional
326 # $p{metadata} optional hashref
327 # $p{subscription} optional (attaches the item to a specific subscription's next invoice)
328 return { error => { message => 'create_invoice_item: customer required' } } unless $p{customer};
329 return { error => { message => 'create_invoice_item: amount_cents required' } } unless defined $p{amount_cents};
330 return $self->_request('POST', '/invoiceitems', {
331 customer => $p{customer},
332 amount => int($p{amount_cents}),
333 currency => $p{currency} || 'usd',
334 ( $p{description} ? (description => $p{description}) : () ),
335 ( $p{metadata} ? (metadata => $p{metadata}) : () ),
336 ( $p{subscription} ? (subscription => $p{subscription}) : () ),
337 });
338}
339
340# Sets the customer's default payment_method for invoices. Used after
341# attaching a new card so future subscription charges hit the right
342# card without an explicit per-PaymentIntent payment_method param.
343sub set_customer_default_pm {
344 my ($self, $customer_id, $pm_id) = @_;
345 return $self->_request('POST', "/customers/$customer_id", {
346 invoice_settings => { default_payment_method => $pm_id },
347 });
348}
349
350# ---- SetupIntent ----------------------------------------------------
351# Off-session usage: the seller saves a card now; we charge it later
352# from the billing worker against their subscription. The browser
353# confirms the SetupIntent with Stripe Elements, then posts the
354# resulting payment_method id back to us; we attach + persist.
355sub create_setup_intent {
356 my ($self, %p) = @_;
357 # $p{customer}, $p{metadata}, $p{idempotency_key}
358 return $self->_request('POST', '/setup_intents', {
359 customer => $p{customer},
360 usage => 'off_session',
361 payment_method_types => ['card'],
362 ( $p{metadata} ? (metadata => $p{metadata}) : () ),
363 }, { idempotency_key => $p{idempotency_key} });
364}
365
366sub retrieve_setup_intent {
367 my ($self, $id) = @_;
368 return $self->_request('GET', "/setup_intents/$id");
369}
370
371# ---- PaymentMethods -------------------------------------------------
372# After the browser confirms a SetupIntent, we read the PM back to
373# capture brand/last4/exp for our local payment_methods row -- that
374# metadata is what billing.cgi shows. PAN never reaches our server.
375sub retrieve_payment_method {
376 my ($self, $id) = @_;
377 return $self->_request('GET', "/payment_methods/$id");
378}
379
380# Bind a PM to a customer. Required before the PM can be used for
381# off-session charges. Browser-confirmed SetupIntents auto-attach,
382# but we call this defensively in case the caller hands us an
383# already-confirmed PM out of band.
384sub attach_payment_method {
385 my ($self, $pm_id, $customer_id) = @_;
386 return $self->_request('POST', "/payment_methods/$pm_id/attach", {
387 customer => $customer_id,
388 });
389}
390
391# Detach removes the PM from the customer. After this Stripe still
392# keeps the object (for receipts on past charges) but it can't be
393# used for new charges. We DELETE our local row in the same pass.
394sub detach_payment_method {
395 my ($self, $pm_id) = @_;
396 return $self->_request('POST', "/payment_methods/$pm_id/detach", {});
397}
398
399# ---- Subscriptions (BUYER subscribes to SELLER plan) ---------------
400# WebSTLs flow: Subscription Plans are seller-created. When a buyer
401# subscribes, we lazily create a Stripe Product + Price the first time
402# anyone subscribes to that plan (cached on subscription_plans row).
403# Then we open a Checkout Session in mode=subscription -- Stripe handles
404# customer creation, card collection, and recurring billing. The webhook
405# (checkout.session.completed + invoice.paid + customer.subscription
406# .deleted) reconciles back into buyer_subscriptions.
407
408sub create_product {
409 my ($self, %p) = @_;
410 # $p{name}, $p{description}, $p{metadata}
411 return $self->_request('POST', '/products', {
412 name => ($p{name} || 'Subscription plan'),
413 ( $p{description} ? (description => $p{description}) : () ),
414 ( $p{metadata} ? (metadata => $p{metadata}) : () ),
415 });
416}
417
418# Recurring Price tied to a Product. interval is 'day','week','month'
419# or 'year'; interval_count is N (e.g. 1 month, 3 months).
420sub create_price {
421 my ($self, %p) = @_;
422 # $p{product}, $p{amount_cents}, $p{currency}, $p{interval},
423 # $p{interval_count}, $p{metadata}
424 my $interval = $p{interval} || 'month';
425 my $count = int($p{interval_count} || 1) || 1;
426 return $self->_request('POST', '/prices', {
427 product => $p{product},
428 unit_amount => int($p{amount_cents} || 0),
429 currency => ($p{currency} || $self->{currency}),
430 recurring => {
431 interval => $interval,
432 interval_count => $count,
433 },
434 ( $p{metadata} ? (metadata => $p{metadata}) : () ),
435 });
436}
437
438# Open a Checkout Session for subscription mode. Stripe redirects the
439# buyer back to success_url after collecting the card. We pass plan_id
440# + buyer_id in metadata so the webhook can match the resulting
441# subscription back to a buyer_subscriptions row.
442sub create_checkout_session_subscription {
443 my ($self, %p) = @_;
444 # Required: $p{price}, $p{success_url}, $p{cancel_url}
445 # Optional: $p{customer_email}, $p{metadata}, $p{seller_account},
446 # $p{application_fee_percent}, $p{quantity}, $p{idempotency_key}
447 my $params = {
448 mode => 'subscription',
449 success_url => $p{success_url},
450 cancel_url => $p{cancel_url},
451 'line_items[0][price]' => $p{price},
452 'line_items[0][quantity]' => int($p{quantity} || 1),
453 ( $p{customer_email} ? (customer_email => $p{customer_email}) : () ),
454 ( $p{metadata} ? (metadata => $p{metadata}) : () ),
455 };
456 # Optional Connect routing -- the seller is the destination, the
457 # platform takes application_fee_percent. We don't enforce this for
458 # v1 (subscription revenue stays on the platform until manually
459 # split); pass these in when ready.
460 if ($p{seller_account}) {
461 $params->{'subscription_data[application_fee_percent]'} = $p{application_fee_percent} // 15;
462 $params->{'subscription_data[transfer_data][destination]'} = $p{seller_account};
463 }
464 return $self->_request('POST', '/checkout/sessions', $params, {
465 idempotency_key => $p{idempotency_key},
466 });
467}
468
469sub retrieve_checkout_session {
470 my ($self, $id) = @_;
471 return $self->_request('GET', "/checkout/sessions/$id");
472}
473
474sub retrieve_subscription {
475 my ($self, $id) = @_;
476 return $self->_request('GET', "/subscriptions/$id");
477}
478
479# Cancel at period end (false = immediate). For buyer-initiated cancel
480# we set true so they keep benefits until current_period_end.
481sub cancel_subscription {
482 my ($self, $id, %p) = @_;
483 my $immediate = $p{immediate} ? 1 : 0;
484 if ($immediate) {
485 return $self->_request('DELETE', "/subscriptions/$id");
486 }
487 return $self->_request('POST', "/subscriptions/$id", {
488 cancel_at_period_end => 'true',
489 });
490}
491
492# ---- Webhook signature verification --------------------------------
493# Implements https://stripe.com/docs/webhooks/signatures without the
494# Stripe SDK. Returns 1 on valid signature (within 5min tolerance),
495# 0 otherwise.
496sub verify_webhook {
497 my ($self, $body, $sig_header, $tolerance) = @_;
498 return 0 unless $self->{webhook_secret};
499 return 0 unless defined $body && defined $sig_header;
500 $tolerance ||= 300; # 5 minutes
501
502 my ($ts, $v1);
503 foreach my $part (split /,/, $sig_header) {
504 $part =~ s/^\s+|\s+$//g;
505 if ($part =~ /^t=(\d+)/) { $ts = $1; }
506 elsif ($part =~ /^v1=([a-f0-9]+)/i) { $v1 = $1 unless $v1; }
507 }
508 return 0 unless $ts && $v1;
509 return 0 if abs(time() - $ts) > $tolerance;
510
511 my $signed_payload = $ts . '.' . $body;
512 my $expected = hmac_sha256_hex($signed_payload, $self->{webhook_secret});
513 # Constant-time compare (length-checked, then xor each byte).
514 return 0 if length($expected) != length($v1);
515 my $diff = 0;
516 for my $i (0 .. length($expected) - 1) {
517 $diff |= ord(substr($expected, $i, 1)) ^ ord(substr($v1, $i, 1));
518 }
519 return $diff == 0 ? 1 : 0;
520}
521
5221;
Keyboard: j next diff k previous diff g top G bottom r restore c compile-check ? help