File Coverage

blib/lib/Business/Stripe/Webhook.pm
Criterion Covered Total %
statement 67 112 59.8
branch 19 42 45.2
condition 0 3 0.0
subroutine 12 15 80.0
pod 7 7 100.0
total 105 179 58.6


line stmt bran cond sub pod time code
1             package Business::Stripe::Webhook;
2            
3 2     2   143168 use JSON::PP;
  2         34422  
  2         173  
4 2     2   1109 use Digest::SHA qw(hmac_sha256_hex);
  2         6318  
  2         163  
5 2     2   1083 use Time::Piece;
  2         23919  
  2         11  
6 2     2   1797 use HTTP::Tiny;
  2         100300  
  2         86  
7            
8 2     2   16 use strict;
  2         5  
  2         45  
9 2     2   11 use warnings;
  2         4  
  2         2269  
10            
11             our $VERSION = '1.0';
12             $VERSION = eval $VERSION;
13            
14             sub new {
15 3     3 1 923 my $class = shift;
16 3         13 my %vars = @_;
17            
18 3         10 $vars{'error'} = '';
19            
20 3         16 $vars{'reply'} = {
21             'status' => 'noaction',
22             'sent_to' => [ ],
23             'sent_to_all' => 'false',
24             };
25            
26 3 100       13 if (exists $ENV{'GATEWAY_INTERFACE'}) {
27 2         60 read(STDIN, $vars{'payload'}, $ENV{'CONTENT_LENGTH'});
28 2 100       19 $vars{'webhook'} = decode_json($vars{'payload'}) if $vars{'payload'};
29 2 100       44888 $vars{'error'} = 'No payload data' unless $vars{'webhook'};
30             } else {
31 1         2 $vars{'error'} = 'Looks like this is not a web request!';
32             }
33            
34 3         16 return bless \%vars, $class;
35             }
36            
37             # Returns true if last operation was success
38             sub success {
39 3     3 1 17 my $self = shift;
40 3         23 return !$self->{'error'};
41             }
42            
43             # Returns error if last operation failed
44             sub error {
45 3     3 1 12 my $self = shift;
46 3         16 return $self->{'error'};
47             }
48            
49             # Deal with webhook calls
50             sub process {
51 2     2 1 6 my $self = shift;
52            
53 2         6 $self->{'error'} = '';
54            
55 2 50       19 if (!defined $self->{'payload'}) {
56 0         0 $self->_error("No payload to process");
57 0         0 return undef;
58             }
59            
60 2 50       9 if (!$ENV{'HTTP_STRIPE_SIGNATURE'}) {
61 0         0 $self->_warning('Stripe-Signature HTTP heading missing - the request is not from Stripe');
62 0         0 return undef;
63             }
64            
65 2 100       8 if ($self->{'signing_secret'}) {
66 1         4 my $sig = $self->check_signature;
67 1 50       3 return undef unless defined $sig;
68 1 50       4 if (!$sig) {
69 1         7 $self->_error('Invalid Stripe Signature');
70 1         62 return undef;
71             }
72             }
73            
74 1         3 my $hook_type = $self->{'webhook'}->{'type'};
75 1         6 $hook_type =~ s/\./-/g;
76 1 50       7 if (exists $self->{$hook_type}) {
77 1         3 $self->{'reply'}->{'status'} = 'success';
78 1         3 push @{$self->{'reply'}->{'sent_to'}}, $hook_type;
  1         4  
79 1         2 &{$self->{$hook_type}}($self->{'webhook'});
  1         5  
80             }
81            
82 1 50       620 if (exists $self->{'all-webhooks'}) {
83 0         0 $self->{'reply'}->{'sent_to_all'} = 'true';
84 0         0 &{$self->{'all-webhooks'}}($self->{'webhook'});
  0         0  
85             }
86            
87 1         5 $self->{'reply'}->{'type'} = $self->{'webhook'}->{'type'};
88            
89 1         4 return $self->{'reply'};
90             }
91            
92             # Check for correct Stripe Signature
93             sub check_signature {
94 1     1 1 2 my $self = shift;
95            
96 1         4 $self->{'error'} = '';
97            
98 1 50       6 if (!$self->{'signing_secret'}) {
99 0         0 $self->_warning('No signing secret has been supplied');
100 0         0 return undef;
101             }
102 1 50       4 if (!$ENV{'HTTP_STRIPE_SIGNATURE'}) {
103 0         0 $self->_warning('Stripe-Signature HTTP heading missing');
104 0         0 return undef;
105             }
106            
107 1         15 my %sig_head = ($ENV{'HTTP_STRIPE_SIGNATURE'} . ',') =~ /(\S+?)=(\S+?),/g;
108 1         5 my $signed_payload = $sig_head{'t'} . '.' . $self->{'payload'};
109            
110 1 50       5 if (!defined $sig_head{'v1'}) {
111 0         0 die "No v1";
112             }
113            
114 1 50       20 if (hmac_sha256_hex($signed_payload, $self->{'signing_secret'}) eq $sig_head{'v1'}) {
115 0         0 return 1;
116             }
117 1         4 return 0;
118             }
119            
120             # Send reply to Stripe
121             sub reply {
122 0     0 1 0 my $self = shift;
123 0         0 my %keys = @_;
124            
125 0         0 $self->{'reply'}->{'timestamp'} = localtime->datetime;
126 0 0       0 if ($self->{'error'}) {
127 0         0 $self->{'reply'}->{'error'} = $self->{'error'};
128 0         0 $self->{'reply'}->{'status'} = 'failed';
129             }
130            
131 0         0 foreach my $key(keys %keys) {
132 0         0 $self->{'reply'}->{$key} = $keys{$key};
133             }
134            
135 0         0 print "Content-type: application/json\n\n";
136 0         0 print encode_json $self->{'reply'};
137 0         0 return;
138             }
139            
140             # Retrieve subscription object from Stripe
141             sub get_subscription {
142 0     0 1 0 my ($self, $subscription, $secret) = @_;
143            
144 0 0       0 if (!$subscription) {
145 0         0 $self->{'error'} = 'Subscription missing';
146 0         0 $self->_error('Subscription missing');
147 0         0 return undef;
148             }
149            
150 0 0       0 $self->{'api_secret'} = $secret if defined $secret;
151            
152 0 0       0 if (!$self->{'api_secret'}) {
153 0         0 $self->{'error'} = 'No Secret Key supplied to fetch subscription';
154 0         0 return undef;
155             }
156            
157             my $headers = {
158             'headers' => {
159 0         0 'Authorization' => 'Bearer ' . $self->{'api_secret'},
160             'Stripe-Version' => '2022-11-15',
161             },
162             'agent' => "Perl-Business::Stripe::Webhook-v$VERSION",
163             };
164            
165 0         0 my $http = HTTP::Tiny->new;
166 0         0 return $http->get("https://api.stripe.com/v1/subscriptions/$subscription", $headers);
167             }
168            
169             sub _error {
170 1     1   3 my ($self, $message) = @_;
171            
172 1         3 $self->{'error'} = $message;
173 1 50       2 if (defined &{$self->{'error'}}) {
  1         9  
174 0         0 &{$self->{'error'}}($message);
  0         0  
175             } else {
176 1         18 STDERR->print("Stripe Webhook Error: $message\n");
177             }
178             }
179            
180             sub _warning {
181 0     0     my ($self, $message) = @_;
182            
183 0 0 0       return if $self->{'warning'} and $self->{'warning'} =~ /^nowarn/i;
184 0           $self->{'error'} = $message;
185 0 0         if (defined $self->{'warning'}) {
186 0           &{$self->{'warning'}}($message);
  0            
187             } else {
188 0           STDERR->print("Stripe Webhook Warning: $message\n");
189             }
190             }
191            
192            
193             __END__