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__
|