From: Mitch Jackson Date: Thu, 11 Apr 2019 21:43:39 +0000 (-0400) Subject: Payments API calls working, with some tests X-Git-Url: http://git.freeside.biz/gitweb/?p=Business-OnlinePayment-Bambora.git;a=commitdiff_plain;h=40669843fb6bf03fd80cb0311cdfa90aec55bb1a Payments API calls working, with some tests --- diff --git a/.gitignore b/.gitignore old mode 100644 new mode 100755 diff --git a/CHANGELOG.md b/CHANGELOG.md old mode 100644 new mode 100755 diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md old mode 100644 new mode 100755 diff --git a/Makefile.PL b/Makefile.PL old mode 100644 new mode 100755 diff --git a/README.md b/README.md old mode 100644 new mode 100755 diff --git a/lib/Business/OnlinePayment/Bambora.pm b/lib/Business/OnlinePayment/Bambora.pm old mode 100644 new mode 100755 index 9846803..9d07c5a --- a/lib/Business/OnlinePayment/Bambora.pm +++ b/lib/Business/OnlinePayment/Bambora.pm @@ -1,3 +1,394 @@ -package Business::OnlinePayment::Bambora 0.01; +package Business::OnlinePayment::Bambora; +use strict; +use warnings; +use base qw/ Business::OnlinePayment::HTTPS /; +use feature 'unicode_strings'; + +use Carp qw( croak ); +use Cpanel::JSON::XS; +use Data::Dumper; $Data::Dumper::Sortkeys = 1; +use MIME::Base64; +use Unicode::Truncate qw( truncate_egc ); +use URI::Escape; + +use vars qw/ $VERSION $DEBUG /; +$VERSION = '0.01'; +$DEBUG = 0; + +if ( $DEBUG ) { + $Data::Dumper::Sortkeys = 1; +} + +=head1 INTERNAL METHODS + +=head2 set_defaults + +See L + +=cut + +sub set_defaults { + my $self = shift; + + $self->server('api.na.bambora.com'); + $self->port('443'); + + # Create accessors for + $self->build_subs(qw/ + expiry_month + expiry_year + invoice_number + message_id + payment_method + phone_number + province + recurring_payment + response_decoded + txn_date + /); +} + +=head2 submit + +Dispatch to the appropriate hanlder based on the given action + +=cut + +my %action_dispatch_table = ( + 'normal authorization' => 'submit_normal_authorization', + 'authorization only' => 'submit_authorization_only', + 'post authorization' => 'submit_post_authorization', + 'reverse authorization' => 'rsubmit_everse_authorization', + 'void' => 'submit_viod', + 'credit' => 'submit_credit', + 'tokenize' => 'submit_tokenize', + 'recurring authorization' => 'submit_recurring_authorization', + 'modify recurring authorization' => 'modify_recurring_authorization', +); + +sub submit { + my $self = shift; + + my $action = lc $self->{_content}->{action} + or croak 'submit() called with no action set'; + + my $method = $action_dispatch_table{$action}; + + $self->submit_action_unsupported() + unless $method + && $self->can($method); + + $self->$method(@_); +} + +=head2 submit_normal_authorization + +Compliete a payment transaction by with an API POST to B + +See L + +=cut + +sub submit_normal_authorization { + my $self = shift; + + # Series of methods to populate or format field values + $self->make_invoice_number; + $self->set_payment_method; + $self->set_expiration; + + my $content = $self->{_content}; + + # Build a JSON string + my $post_body = encode_json({ + order_number => $self->truncate( $content->{invoice_number}, 30 ), + amount => $content->{amount}, + payment_method => $content->{payment_method}, + + billing => $self->jhref_billing_address, + + card => { + number => $self->truncate( $content->{card_number}, 20 ), + name => $self->truncate( $content->{owner}, 64 ), + expiry_month => sprintf( '%02d', $content->{expiry_month} ), + expiry_year => sprintf( '%02d', $content->{expiry_year} ), + cvd => $content->{cvv2}, + recurring_payment => $content->{recurring_payment} ? 1 : 0, + } + }); + + if ( $DEBUG ) { + warn Dumper({ post_body => $post_body })."\n"; + } + + $self->path('/v1/payments'); + + my ( $response_body, $response_code, %response_headers ) = $self->https_post( + { + headers => { $self->authorization_header }, + 'Content-Type' => 'application/json', + }, + $post_body, + ); + $self->server_response( $response_body ); + + my $response; + { + local $@; + eval{ $response = decode_json( $response_body ) }; + + if ( $DEBUG ) { + warn Dumper({ + response_body => $response_body, + response => $response, + response_code => $response_code, + # response_headers => \%response_headers, + }); + } + + # API should always return a JSON response, + die $response_body || 'connection error' + if $@ || !$response; + } + $self->response_decoded( $response ); + + if ( $response->{code} && $response->{code} != 1 ) { + + $self->is_success( 0 ); + $self->result_code( $response->{code} ); + return $self->error_message( + sprintf '%s %s', + $response->{code}, + $response->{message} + ); + } + + # success + # Populate transaction result values + $self->message_id( $response->{message_id} ); + $self->authorization( $response->{auth_code} ); + $self->order_number( $response->{id} ); + $self->txn_date( $response->{created} ); + $self->avs_code( $response->{card}{avs_result} ); + $self->is_success( 1 ); +} + +=head2 submit_api_request json_string + +Make the appropriate API request with the given JSON string + +=cut + +sub submit_api_request { + my $self = shift; + my $json_string = shift + or die 'submit_api_request() requires a json_string parameter'; + + +} + +=head2 submit_action_unsupported + +Croak with the error message Action $action unsupported + +=cut + +sub submit_action_unsupported { + croak sprintf 'Action %s unsupported', shift->action +} + +=head2 authorization_header + +Bambora POST requests authenticate via a HTTP header of the format: +Authorization: Passcode Base64Encoded(merchant_id:passcode) + +Returns a hash representing the authorization header derived from +the merchant id (login) and API passcode (password) + +=cut + +sub authorization_header { + my $self = shift; + my $content = $self->{_content}; + + my %authorization_header = ( + Authorization => 'Passcode ' . MIME::Base64::encode_base64( + join( ':', $content->{login}, $content->{password} ) + ) + ); + + if ( $DEBUG ) { + warn Dumper({ authorization_header => \%authorization_header })."\n"; + } + + %authorization_header; +} + +=head2 jhref_billing_address + +Return a hashref for inclusion into a json object +representing the RequestBillingAddress for the API + +=cut + +sub jhref_billing_address { + my $self = shift; + + $self->set_province; + $self->set_country; + $self->set_phone_number; + + my $content = $self->{_content}; + + return { + name => $self->truncate( $content->{name}, 64 ), + address_line1 => $self->truncate( $content->{address}, 64 ), + city => $self->truncate( $content->{city}, 64 ), + province => $self->truncate( $content->{province}, 2 ), + country => $self->truncate( $content->{country}, 2 ), + postal_code => $self->truncate( $content->{zip}, 16 ), + phone_number => $self->truncate( $content->{phone_number}, 20 ), + email_address => $self->truncate( $content->{email}, 64 ), + }; +} + +=head2 make_invoice_number + +If an invoice number has not been specified, generate one using +the current epoch timestamp + +=cut + +sub make_invoice_number { + shift->{_content}{invoice_number} ||= time(); +} + +=head2 set_country + +Country is expected to be set as an ISO-3166-1 2-letter country code + +Sets string to upper case. + +Dies unless country is a two-letter string. + +In the future, could be extended to convert country names to their respective +country codes + +See: L + +=cut + +sub set_country { + my $self = shift; + my $content = $self->{_content}; + my $country = uc $content->{country}; + + if ( $country !~ /^[A-Z]{2}$/ ) { + croak sprintf 'country is not a 2 character string (%s)', + $country || 'undef'; + }; + + $content->{country} = $country; +} + +=head2 set_expiration_month_year + +Split standard expiration field, which may be in the format +MM/YY or MMYY, into separate expiry_month and expiry_year fields + +Will die if values are not numeric + +=cut + +sub set_expiration { + my $self = shift; + my $content = $self->{_content}; + my $expiration = $content->{expiration}; + + my ( $mm, $yy ) = ( + $expiration =~ /\// + ? split( /\//, $expiration ) + : unpack( 'A2 A2', $expiration ) + ); + + croak 'card expiration must be in format MM/YY' + if $mm =~ /\D/ || $yy =~ /\D/; + + return ( + $content->{expiry_month} = sprintf( '%02d', $mm ), + $content->{expiry_year} = sprintf ('%02d', $yy ), + ); +} + +=head2 set_payment_method + +Set payment_method value to one of the following strings + + card + token + payment_profile + cash + cheque + interac + apple_pay + android_pay + +=cut + +sub set_payment_method { + # todo - determine correct payment method + warn "set_payment_method() STUB FUNCTION ALWAYS RETURNS card!\n"; + shift->{_content}->{payment_method} = 'card'; +} + +=head2 set_phone_number + +=cut + +sub set_phone_number { + my $self = shift; + my $content = $self->{_content}; + + my $phone = $content->{phone} + or return $content->{phone_number} = undef; + + $phone =~ s/\D//g; + $content->{phone_number} = $phone; +} + +=head2 set_province + +Outside the US/Canada, API expect province set to the string "--", +otherwise to be a 2 character string + +=cut + +sub set_province { + my $self = shift; + my $content = $self->{_content}; + my $country = uc $content->{country}; + + return $content->{province} = '--' + unless $country + && ( $country eq 'US' || $country eq 'CA' ); + + $content->{province} = uc $content->{state}; +} + +=head2 truncate string, bytes + +When given a string, truncate to given string length in a unicode safe way + +=cut + +sub truncate { + my ( $self, $string, $bytes ) = @_; + + # truncate_egc dies when asked to truncate undef + return $string unless $string; + + truncate_egc( "$string", $bytes, '' ); +} + 1; diff --git a/t/01-use.t b/t/01-use.t new file mode 100755 index 0000000..19fffb1 --- /dev/null +++ b/t/01-use.t @@ -0,0 +1,8 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More tests => 1; + +BEGIN{ use_ok( 'Business::OnlinePayment::Bambora' ) } + +done_testing(); diff --git a/t/021-payments-card-normal_authorization.t b/t/021-payments-card-normal_authorization.t new file mode 100755 index 0000000..f4eb89b --- /dev/null +++ b/t/021-payments-card-normal_authorization.t @@ -0,0 +1,107 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +use lib 't'; +require 'TestFixtures.pm'; +use Business::OnlinePayment; + +my $merchant_id = $ENV{BAMBORA_MERCHANT_ID}; +my $api_key = $ENV{BAMBORA_API_KEY}; + +SKIP: { + skip 'Missing env vars BAMBORA_MERCHANT_ID and BAMBORA_API_KEY', 78 + unless $merchant_id && $api_key; + + my %content = ( + login => $merchant_id, + password => $api_key, + action => 'Normal Authorization', + amount => '9.99', + + owner => 'Freeside Internet Services', + name => 'Mitch Jackson', + address => '1407 Graymalkin Lane', + city => 'Vancouver', + state => 'BC', + zip => '111 111', + country => 'CA', + + card_number => '4242424242424242', + cvv2 => '111', + expiration => '1122', + phone => '251-300-1300', + email => 'mitch@freeside.biz', + ); + + # Test approved card numbers, + # ref: https://dev.na.bambora.com/docs/references/payment_APIs/test_cards/ + my %approved_cards = ( + visa => { card => '4030000010001234', cvv2 => '123' }, + mastercard => { card => '5100000010001004', cvv2 => '123' }, + mastercard2 => { card => '2223000048400011', cvv2 => '123' }, + amex => { card => '371100001000131', cvv2 => '1234' }, + visa => { card => '4030000010001234', cvv2 => '123' }, + discover => { card => '6011500080009080', cvv2 => '123' }, + ); + + for my $name ( keys %approved_cards ) { + $content{card_number} = $approved_cards{$name}->{card}; + $content{cvv2} = $approved_cards{$name}->{cvv2}; + + my $tr; + ok( $tr = Business::OnlinePayment->new('Bambora'), 'Instantiatiate $tr' ); + ok( $tr->content( %content ), 'Set transaction content onto $tr' ); + { + local $@; + eval { $tr->submit }; + ok( !$@, "$name Process transaction (expect approve)" ); + } + + for my $attr (qw/ + is_success + message_id + authorization + order_number + txn_date + avs_code + /) { + ok( + defined $tr->$attr(), + sprintf '%s $tr->%s() = %s', + $name, + $attr, + $tr->$attr() + ); + } + } + + # Test declined card numbers, + # ref: https://dev.na.bambora.com/docs/references/payment_APIs/test_cards/ + my %decline_cards = ( + visa => { card => '4003050500040005', cvv2 => '123' }, + mastercard => { card => '5100000020002000', cvv2 => '123' }, + amex => { card => '342400001000180', cvv2 => '1234' }, + discover => { card => '6011000900901111', cvv2 => '123' }, + ); + for my $name ( keys %decline_cards ) { + $content{card_number} = $decline_cards{$name}->{card}; + $content{cvv2} = $decline_cards{$name}->{cvv2}; + + my $tr; + ok( $tr = Business::OnlinePayment->new('Bambora'), 'Instantiate $tr' ); + ok( $tr->content( %content ), 'Set transaction content onto $tr' ); + { + local $@; + eval { $tr->submit }; + ok( !$@, "$name: Process transaction (expect decline)" ); + } + + ok( $tr->is_success == 0, '$tr->is_success == 0' ); + ok( $tr->result_code != 1, '$tr->result_code != 1' ); + ok( $tr->error_message, '$tr->error_message: '.$tr->error_message ); + } +} + +done_testing; \ No newline at end of file diff --git a/t/022-payments-card-authorization_only.t b/t/022-payments-card-authorization_only.t new file mode 100755 index 0000000..c95bdb8 --- /dev/null +++ b/t/022-payments-card-authorization_only.t @@ -0,0 +1,107 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +use lib 't'; +require 'TestFixtures.pm'; +use Business::OnlinePayment; + +my $merchant_id = $ENV{BAMBORA_MERCHANT_ID}; +my $api_key = $ENV{BAMBORA_API_KEY}; + +SKIP: { + skip 'Missing env vars BAMBORA_MERCHANT_ID and BAMBORA_API_KEY', 78 + unless $merchant_id && $api_key; + + my %content = ( + login => $merchant_id, + password => $api_key, + action => 'Normal Authorization', + amount => '9.99', + + owner => 'Freeside Internet Services', + name => 'Mitch Jackson', + address => '1407 Graymalkin Lane', + city => 'Vancouver', + state => 'BC', + zip => '111 111', + country => 'CA', + + card_number => '4242424242424242', + cvv2 => '111', + expiration => '1122', + phone => '251-300-1300', + email => 'mitch@freeside.biz', + ); + + # Test approved card numbers, + # ref: https://dev.na.bambora.com/docs/references/payment_APIs/test_cards/ + my %approved_cards = ( + visa => { card => '4030000010001234', cvv2 => '123' }, + mastercard => { card => '5100000010001004', cvv2 => '123' }, + mastercard2 => { card => '2223000048400011', cvv2 => '123' }, + amex => { card => '371100001000131', cvv2 => '1234' }, + visa => { card => '4030000010001234', cvv2 => '123' }, + discover => { card => '6011500080009080', cvv2 => '123' }, + ); + + for my $name ( keys %approved_cards ) { + $content{card_number} = $approved_cards{$name}->{card}; + $content{cvv2} = $approved_cards{$name}->{cvv2}; + + my $tr; + ok( $tr = Business::OnlinePayment->new('Bambora'), 'Instantiatiate $tr' ); + ok( $tr->content( %content ), 'Set transaction content onto $tr' ); + { + local $@; + eval { $tr->submit }; + ok( !$@, "$name Process transaction (expect approve)" ); + } + + for my $attr (qw/ + message_id + authorization + order_number + txn_date + avs_code + is_success + /) { + ok( + defined $tr->$attr(), + sprintf '%s $tr->%s() = %s', + $name, + $attr, + $tr->$attr() + ); + } + } + + # Test declined card numbers, + # ref: https://dev.na.bambora.com/docs/references/payment_APIs/test_cards/ + my %decline_cards = ( + visa => { card => '4003050500040005', cvv2 => '123' }, + mastercard => { card => '5100000020002000', cvv2 => '123' }, + amex => { card => '342400001000180', cvv2 => '1234' }, + discover => { card => '6011000900901111', cvv2 => '123' }, + ); + for my $name ( keys %decline_cards ) { + $content{card_number} = $decline_cards{$name}->{card}; + $content{cvv2} = $decline_cards{$name}->{cvv2}; + + my $tr; + ok( $tr = Business::OnlinePayment->new('Bambora'), 'Instantiate $tr' ); + ok( $tr->content( %content ), 'Set transaction content onto $tr' ); + { + local $@; + eval { $tr->submit }; + ok( !$@, "$name: Process transaction (expect decline)" ); + } + + ok( $tr->is_success == 0, '$tr->is_success == 0' ); + ok( $tr->result_code != 1, '$tr->result_code != 1' ); + ok( $tr->error_message, '$tr->error_message: '.$tr->error_message ); + } +} + +done_testing; \ No newline at end of file diff --git a/t/TestFixtures.pm b/t/TestFixtures.pm new file mode 100755 index 0000000..acf2138 --- /dev/null +++ b/t/TestFixtures.pm @@ -0,0 +1,14 @@ +#!/usr/bin/env perl +package TestFixtures; +use strict; +use warnings; + +use Exporter; +use vars qw/ @ISA @EXPORT /; +@ISA = 'Exporter'; +@EXPORT = qw/ + +/; + + +1; \ No newline at end of file