File Coverage

blib/lib/Business/Stripe/Webhook.pm
Criterion Covered Total %
statement 80 120 66.6
branch 29 48 60.4
condition 1 3 33.3
subroutine 13 15 86.6
pod 7 7 100.0
total 130 193 67.3


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