File Coverage

blib/lib/Business/Stripe/Webhook.pm

Criterion	Covered	Total	%
statement	108	129	83.7
branch	43	54	79.6
condition	4	9	44.4
subroutine	14	15	93.3
pod	7	7	100.0
total	176	214	82.2

package Business::Stripe::Webhook;

use JSON::PP;
use Digest::SHA qw(hmac_sha256_hex);
use Time::Piece;
use HTTP::Tiny;

use strict;
use warnings;

our $VERSION = '1.14';
$VERSION = eval $VERSION;

sub new {
    my $class = shift;
    my %vars = @_;

    if (exists $vars{'error'} && ref $vars{'error'} eq 'CODE') {
        $vars{'error_callback'} = $vars{'error'};
    }
    $vars{'error'}      = '';

    $vars{'reply'}      =  {
        'status'        => 'noaction',
        'sent_to'       => [ ],
        'sent_to_all'   => 'false',
    };

    if (exists $vars{'payload'}) {
        $vars{'webhook'} = eval { decode_json($vars{'payload'});};
        $vars{'error'}   = 'Missing payload data' unless $vars{'webhook'};
    } else {
        # Obtaining  payload from STDIN only
        # exists for backward  compatability
        # This option is deprecated and will
        # be  removed  in  a  future version
        if (exists $ENV{'GATEWAY_INTERFACE'}) {
            read(STDIN, $vars{'payload'}, $ENV{'CONTENT_LENGTH'});
            $vars{'webhook'} = decode_json($vars{'payload'}) if $vars{'payload'};
            $vars{'error'}   = 'No payload data' unless $vars{'webhook'};
        } else {
            $vars{'error'}   = 'Looks like this is not a web request!';
        }
    }

    return bless \%vars, $class;
}

# Returns true if last operation was success
sub success {
    my $self = shift;
    return !$self->{'error'};
}

# Returns error if last operation failed
sub error {
    my $self = shift;
    return $self->{'error'};
}

# Deal with webhook calls
sub process {
    my $self = shift;

    $self->{'error'} = '';

    if (!defined $self->{'payload'}) {
        $self->_error("No payload to process");
        return undef;
    }

    if ($self->{'signing_secret'}) {
        if (!$ENV{'HTTP_STRIPE_SIGNATURE'}) {
            $self->_error('Stripe-Signature HTTP heading missing - the request is not from Stripe');
            return undef;
        }
        my $sig = $self->check_signature;
        return undef unless defined $sig;
        if (!$sig) {
            $self->_error('Invalid Stripe Signature');
            return undef;
        }
    }

    my $hook_type = $self->{'webhook'}->{'type'};

    if (!$hook_type) {
        $self->_error("Invalid webhook payload");
        return undef;
    }

    $hook_type =~ s/\./-/g;
    if (exists $self->{$hook_type}) {
        push @{$self->{'reply'}->{'sent_to'}}, $hook_type;
        &{$self->{$hook_type}}($self->{'webhook'});
    }

    if (exists $self->{'all-webhooks'}) {
        $self->{'reply'}->{'sent_to_all'} = 'true';
        push @{$self->{'reply'}->{'sent_to'}}, 'all-webhooks';
        &{$self->{'all-webhooks'}}($self->{'webhook'});
    }

    $self->{'reply'}->{'type'} = $self->{'webhook'}->{'type'};

    return $self->{'reply'};
}

# Check for correct Stripe Signature
sub check_signature {
    my $self = shift;

    $self->{'error'} = '';

    if (!$self->{'signing_secret'}) {
        $self->_warning('No signing secret has been supplied');
        return undef;
    }
    if (!$ENV{'HTTP_STRIPE_SIGNATURE'}) {
        $self->_warning('Stripe-Signature HTTP heading missing');
        return undef;
    }

    my %sig_head = ($ENV{'HTTP_STRIPE_SIGNATURE'} . ',') =~ /(\S+?)=(\S+?),/g;

    if (!defined $sig_head{'t'}) {
        $self->_error("No t Parameter");
        return undef;
    }

    my $signed_payload = $sig_head{'t'} . '.' . $self->{'payload'};

    if (!defined $sig_head{'v1'}) {
        $self->_error("No v1 Parameter");
        return undef;
    }

    if (defined $self->{'tolerance'} && abs(time - $sig_head{'t'}) > $self->{'tolerance'}) {
        $self->_error("Timestamp outside tolerance");
        return undef;
    }

    if (hmac_sha256_hex($signed_payload, $self->{'signing_secret'}) eq $sig_head{'v1'}) {
        return 1;
    }
    return 0;
}

# Send reply to Stripe
sub reply {
    my $self = shift;
    my %keys = @_;

    $self->{'reply'}->{'timestamp'} = localtime->datetime;
    if ($self->{'error'}) {
        $self->{'reply'}->{'error'}  = $self->{'error'};
        $self->{'reply'}->{'status'} = 'failed';
    }

    foreach my $key(keys %keys) {
        $self->{'reply'}->{$key} = $keys{$key};
    }

    print "Content-type: application/json\n\n";
    print encode_json $self->{'reply'};
    return;
}

# Retrieve subscription object from Stripe
sub get_subscription {
    my ($self, $subscription, $secret) = @_;

    $self->{'error'} = '';

    if (!$subscription) {
        $self->{'error'} = 'Subscription missing';
        $self->_error('Subscription missing');
        return undef;
    }

    $self->{'api_secret'} = $secret if defined $secret;

    if (!$self->{'api_secret'}) {
        $self->{'error'} = 'No Secret Key supplied to fetch subscription';
        return undef;
    }

    my $headers = {
        'headers'   => {
            'Authorization'     => 'Bearer ' . $self->{'api_secret'},
            'Stripe-Version'    => '2022-11-15',
        },
        'agent'     => "Perl-Business::Stripe::Webhook-v$VERSION",
    };

    my $http = HTTP::Tiny->new;
    return $http->get("https://api.stripe.com/v1/subscriptions/$subscription", $headers);
}

sub _error {
    my ($self, $message) = @_;

    $self->{'error'} = $message;
    if (defined $self->{'error_callback'}) {
        &{$self->{'error_callback'}}($message);
    } else {
        STDERR->print("Stripe Webhook Error: $message\n");
    }
}

sub _warning {
    my ($self, $message) = @_;

    return if $self->{'warning'} and $self->{'warning'} =~ /^nowarn/i;
    $self->{'error'} = $message;
    if (defined $self->{'warning'}) {
        &{$self->{'warning'}}($message);
    } else {
        STDERR->print("Stripe Webhook Warning: $message\n");
    }
}


__END__