lib/Business/OnlinePayment/Bambora.pm

   1 package Business::OnlinePayment::Bambora;
   2 use strict;
   3 use warnings;
   4 use base qw/ Business::OnlinePayment::HTTPS /;
   5 use feature 'unicode_strings';
   6
   7 use Carp qw( croak );
   8 use Cpanel::JSON::XS;
   9 use Data::Dumper;
  10     $Data::Dumper::Sortkeys = 1;
  11     $Data::Dumper::Indent   = 1;
  12 use LWP::UserAgent;
  13 use MIME::Base64;
  14 use Time::HiRes;
  15 use Unicode::Truncate qw( truncate_egc );
  16 use URI::Escape;
  17
  18 use vars qw/ $VERSION $DEBUG /;
  19 $VERSION = '0.1';
  20 $DEBUG   = 1;
  21
  22 if ( $DEBUG ) {
  23     $Data::Dumper::Sortkeys = 1;
  24 }
  25
  26 =head1 INTERNAL METHODS
  27
  28 =head2 set_defaults
  29
  30 See L<Business::OnlinePayment/set_defaults>
  31
  32 =cut
  33
  34 sub set_defaults {
  35   my $self = shift;
  36
  37   $self->server('api.na.bambora.com');
  38   $self->port('443');
  39
  40   # Create accessors for
  41   $self->build_subs(qw/
  42     card_token
  43     expiry_month
  44     expiry_year
  45     invoice_number
  46     message_id
  47     payment_method
  48     phone_number
  49     province
  50     recurring_payment
  51     response_decoded
  52     txn_date
  53   /);
  54 }
  55
  56 =head2 submit
  57
  58 Dispatch to the appropriate handler based on the given action
  59
  60 =cut
  61
  62 my %action_dispatch_table = (
  63   'normal authorization'           => 'submit_normal_authorization',
  64   'authorization only'             => 'submit_authorization_only',
  65   'post authorization'             => 'submit_post_authorization',
  66   'reverse authorization'          => 'submit_reverse_authorization',
  67   'void'                           => 'submit_void',
  68   'credit'                         => 'submit_credit',
  69   'tokenize'                       => 'submit_tokenize',
  70   'recurring authorization'        => 'submit_recurring_authorization',
  71   'modify recurring authorization' => 'modify_recurring_authorization',
  72 );
  73
  74 sub submit {
  75   my $self = shift;
  76
  77   my $action = lc $self->{_content}->{action}
  78     or croak 'submit() called with no action set';
  79
  80   my $method = $action_dispatch_table{$action};
  81
  82   $self->submit_action_unsupported()
  83     unless $method
  84         && $self->can($method);
  85
  86   $self->$method(@_);
  87 }
  88
  89 =head2 submit_normal_authorization
  90
  91 Complete a payment transaction by with an API POST to B</payments>
  92
  93 See L<https://dev.na.bambora.com/docs/references/payment_APIs/v1-0-5>
  94
  95 =cut
  96
  97 sub submit_normal_authorization {
  98   my $self = shift;
  99   my $content = $self->{_content};
 100
 101   # Use epoch time as invoice_number, if none is specified
 102   $content->{invoice_number} ||= time();
 103
 104   # Clarifying Bambora API and Business::OnlinePayment naming conflict
 105   #
 106   # Bambora API:
 107   # - order_number: user supplied identifier for the order, displayed on reports
 108   # - transaction_id: bambora supplied identifier for the order.
 109   #     this number must be referenced for future actions like voids,
 110   #     auth captures, etc
 111   #
 112   # Business::OnlinePayment
 113   # - invoice_number: contains the bambora order number
 114   # - order_number: contains the bambora transaction id
 115
 116   my %post = (
 117     order_number => $self->truncate( $content->{invoice_number}, 30 ),
 118     amount       => $content->{amount},
 119     billing      => $self->jhref_billing_address,
 120   );
 121
 122   # Credit Card
 123   if ( $content->{card_number} ) {
 124     $post{payment_method} = 'card';
 125
 126     # Add card payment details to %post
 127     $post{card} = $self->jhref_card;
 128     return if $self->error_message;
 129
 130     # Designate recurring payment label
 131     $post{card}->{recurring_payment} = $content->{recurring_payment} ? 1 : 0;
 132
 133     # Direct API to issue a complete auth, instead of pre-auth
 134     $post{card}->{complete} = 1;
 135
 136     # $post{card} = {
 137     #   number            => $self->truncate( $content->{card_number}, 20 ),
 138     #   name              => $self->truncate( $content->{owner}, 64 ),
 139     #   expiry_month      => sprintf( '%02d', $content->{expiry_month} ),
 140     #   expiry_year       => sprintf( '%02d', $content->{expiry_year} ),
 141     #   cvd               => $content->{cvv2},
 142     #   recurring_payment => $content->{recurring_payment} ? 1 : 0,
 143     #   complete          => 1,
 144     # };
 145
 146   } else {
 147     croak 'unknown/unsupported payment method!';
 148   }
 149
 150   my $action = lc $content->{action};
 151
 152   if ( $action eq 'normal authorization' ) {
 153     # Perform complete authorization
 154     $self->path('/v1/payments');
 155
 156   } elsif ( $action eq 'authorization only' ) {
 157     # Perform pre-authorization
 158     $self->path('/v1/payments');
 159     $post{card}->{complete} = 0;
 160
 161   } elsif ( $action eq 'post authorization' ) {
 162     # Complete a pre-authorization
 163
 164     croak 'post authorization cannot be completed - '.
 165           'bambora transaction_id must be set as content order_number '.
 166           'before using submit()'
 167               unless $content->{order_number};
 168
 169     $self->path(
 170       sprintf '/v1/payments/%s/completions',
 171         $content->{order_number}
 172     );
 173
 174     if ( ref $post{card} ) {
 175       $post{card}->{complete} = 1
 176     }
 177   } else {
 178     die "unsupported action $action";
 179   }
 180
 181   # Parse %post into a JSON string, to be attached to the request POST body
 182   my $post_body = encode_json( \%post );
 183
 184   if ( $DEBUG ) {
 185     warn Dumper({
 186       path      => $self->path,
 187       post_body => $post_body,
 188       post_href => \%post,
 189     });
 190   }
 191
 192   my $response = $self->submit_api_request( $post_body );
 193
 194   # Any error messages will have been populated by submit_api_request
 195   return unless $self->is_success;
 196
 197   # Populate transaction result values
 198   $self->message_id( $response->{message_id} );
 199   $self->authorization( $response->{auth_code} );
 200   $self->order_number( $response->{id} );
 201   $self->txn_date( $response->{created} );
 202   $self->avs_code( $response->{card}{avs_result} );
 203   $self->is_success( 1 );
 204
 205   $response;
 206 }
 207
 208 =head2 submit_authorization_only
 209
 210 Capture a card authorization, but do not complete transaction
 211
 212 =cut
 213
 214 sub submit_authorization_only {
 215   my $self = shift;
 216
 217   $self->submit_normal_authorization;
 218
 219   my $response = $self->response_decoded;
 220
 221   if (
 222     $self->is_success
 223     && (
 224       ref $response
 225       && $response->{type} ne 'PA'
 226     )
 227   ) {
 228     # Bambora API uses nearly identical API calls for normal
 229     # card transactions and pre-authorization. Sanity check
 230     # that response reported a pre-authorization code
 231     die "Expected API Respose type=PA, but type=$response->{type}! ".
 232         "Pre-Authorization attempt may have charged card!";
 233   }
 234 }
 235
 236 =head2 submit_post_authorization
 237
 238 Complete a card pre-authorization
 239
 240 =cut
 241
 242 sub submit_post_authorization {
 243   shift->submit_normal_authorization;
 244 }
 245
 246 =head2 submit_reverse_authorization
 247
 248 Reverse a pre-authorization
 249
 250 =cut
 251
 252 sub submit_reverse_authorization {
 253   shift->submit_void;
 254 }
 255
 256 =head2 submit_void
 257
 258 Process a return against a transaction for the given amount
 259
 260 =cut
 261
 262 sub submit_void {
 263   my $self = shift;
 264   my $content = $self->{_content};
 265
 266   for my $f (qw/ order_number amount/) {
 267     unless ( $content->{$f} ) {
 268       $self->error_message("Cannot process void - missing required content $f");
 269       warn $self->error_message if $DEBUG;
 270
 271       return $self->is_success(0);
 272     }
 273   }
 274
 275   # The posted JSON string needs only contain the amount.
 276   # The bambora order_number being voided is passed in the URL
 277   my %post = (
 278     amount => $content->{amount},
 279   );
 280   my $post_body = encode_json( \%post );
 281
 282   if ( $DEBUG ) {
 283     warn Dumper({
 284       post => \%post,
 285       post_body => $post_body,
 286     });
 287   }
 288   $self->path( sprintf '/v1/payments/%s/returns', $content->{order_number} );
 289
 290   my $response = $self->submit_api_request( $post_body );
 291 }
 292
 293 =head2 submit_tokenize
 294
 295 Bambora tokenization is based on the Payment Profile feature of their API.
 296
 297 The token created by this method represnets the Bambora customer_code for the
 298 Payment Profile.  The token resembles a credit card number.  It is 16 digits
 299 long, beginning with 99.  No valid card number can begin with the digits 99.
 300
 301 This method creates the payment profile, then replaces the customer_code
 302 generated by Bambora with the card number resembling token.
 303
 304 =cut
 305
 306 sub submit_tokenize {
 307   my $self = shift;
 308   my $content = $self->{_content};
 309
 310   # Check if given card number is already a bambora customer_code
 311   # under this module's token rules
 312   croak "card_number is already tokenized"
 313     if $content->{card_number} =~ /^99\d{14}$/;
 314
 315   my %post = (
 316     customer_code => $self->generate_token,
 317     card          => $self->jhref_card,
 318     billing       => $self->jhref_billing_address,
 319     validate      => 0,
 320   );
 321
 322   # jhref_card may have generated an exception
 323   return if $self->error_message;
 324
 325   $self->path('/v1/profiles');
 326
 327   my $post_body = encode_json( \%post );
 328
 329   if ( $DEBUG ) {
 330     warn Dumper({
 331       path      => $self->path,
 332       post_body => $post_body,
 333       post_href => \%post,
 334     });
 335   }
 336
 337   my $response = $self->submit_api_request( $post_body );
 338   if ( $DEBUG ) {
 339     warn Dumper({
 340       response => $response,
 341       is_success => $self->is_success,
 342       error_message => $self->error_message,
 343     });
 344   }
 345   return unless $self->is_success;
 346
 347   my $customer_code = $response->{customer_code};
 348   if ( !$customer_code ) {
 349     # Should not happen...
 350     # API reported success codes, but
 351     # customer_code value is missing
 352     $self->error_message(
 353       "Fatal error: API reported success, but did not return customer_code"
 354     );
 355     return $self->is_success(0);
 356   }
 357
 358   if ( $customer_code ne $post{customer_code} ) {
 359     # Should not happen...
 360     # API reported success codes, but
 361     # customer_code attached to created profiles does not match
 362     # the token value we attempted to assign to the customer profile
 363     $self->error_message(
 364       "Fatal error: API failed to set payment profile customer_code value"
 365     );
 366     return $self->is_success(0);
 367   }
 368
 369   $self->card_token( $customer_code );
 370
 371   return $response;
 372 }
 373
 374
 375
 376 =head2 submit_api_request json_string [ POST | PUT ]
 377
 378 Make the appropriate API request with the given JSON string
 379
 380 =cut
 381
 382 sub submit_api_request {
 383   my $self = shift;
 384
 385   my $post_body = shift
 386     or die 'submit_api_request() requires a json_string parameter';
 387
 388   # Default to using https_post, unless PUT has been specified
 389   my $http_method = ( $_[0] && lc $_[0] eq 'put' ) ? 'https_put' : 'https_post';
 390
 391   my ($response_body, $response_code, %response_headers) = $self->$http_method(
 392     {
 393       headers => { $self->authorization_header },
 394       'Content-Type' => 'application/json',
 395     },
 396     $post_body,
 397   );
 398   $self->server_response( $response_body );
 399
 400   my $response;
 401   {
 402     local $@;
 403     eval{ $response = decode_json( $response_body ) };
 404
 405     if ( $DEBUG ) {
 406       warn Dumper({
 407         response_body    => $response_body,
 408         response         => $response,
 409         response_code    => $response_code,
 410         # response_headers => \%response_headers,
 411       });
 412     }
 413
 414     # API should always return a JSON response
 415     if ( $@ || !$response ) {
 416       $self->error_message( $response_body || 'connection error' );
 417       $self->is_success( 0 );
 418       return;
 419     }
 420   }
 421   $self->response_decoded( $response );
 422
 423   # Response returned an error
 424   if ( $response->{code} && $response->{code} != 1 ) {
 425     $self->is_success( 0 );
 426     $self->result_code( $response->{code} );
 427
 428     return $self->error_message(
 429       sprintf '%s %s',
 430         $response->{code},
 431         $response->{message}
 432     );
 433   }
 434
 435   # Success
 436   # Return the decoded json of the response back to handler
 437   $self->is_success( 1 );
 438   return $response;
 439 }
 440
 441 =head2 submit_action_unsupported
 442
 443 Croak with the error message Action $action unsupported
 444
 445 =cut
 446
 447 sub submit_action_unsupported {
 448   croak sprintf 'Action %s unsupported', shift->{_content}{action}
 449 }
 450
 451 =head2 authorization_header
 452
 453 Bambora REST requests authenticate via a HTTP header of the format:
 454 Authorization: Passcode Base64Encoded(merchant_id:passcode)
 455
 456 Returns a hash representing the authorization header derived from
 457 the merchant id (login) and API passcode (password)
 458
 459 =cut
 460
 461 sub authorization_header {
 462   my $self = shift;
 463   my $content = $self->{_content};
 464
 465   my %authorization_header = (
 466     Authorization => 'Passcode ' . MIME::Base64::encode_base64(
 467       join( ':', $content->{login}, $content->{password} )
 468     )
 469   );
 470
 471   if ( $DEBUG ) {
 472     warn Dumper({ authorization_header => \%authorization_header })."\n";
 473   }
 474
 475   %authorization_header;
 476 }
 477
 478 =head2 jhref_billing_address
 479
 480 Return a hashref for inclusion into a json object
 481 representing the RequestBillingAddress for the API
 482
 483 =cut
 484
 485 sub jhref_billing_address {
 486   my $self = shift;
 487
 488   $self->set_province;
 489   $self->set_country;
 490   $self->set_phone_number;
 491
 492   my $content = $self->{_content};
 493
 494   return +{
 495     name          => $self->truncate( $content->{name}, 64 ),
 496     address_line1 => $self->truncate( $content->{address}, 64 ),
 497     city          => $self->truncate( $content->{city}, 64 ),
 498     province      => $self->truncate( $content->{province}, 2 ),
 499     country       => $self->truncate( $content->{country}, 2 ),
 500     postal_code   => $self->truncate( $content->{zip}, 16 ),
 501     phone_number  => $self->truncate( $content->{phone_number}, 20 ),
 502     email_address => $self->truncate( $content->{email}, 64 ),
 503   };
 504 }
 505
 506 =head2 jhref_card
 507
 508 Return a hashref for inclusin into a json object
 509 representing Card for the API
 510
 511 If necessary values are missing from %content, will set
 512 error_message and is_success
 513
 514 =cut
 515
 516 sub jhref_card {
 517   my $self = shift;
 518   my $content = $self->{_content};
 519
 520   $self->set_expiration;
 521
 522   # Check required input
 523   for my $f (qw/
 524     card_number
 525     owner
 526     expiry_month
 527     expiry_year
 528     cvv2
 529   /) {
 530     next if $content->{$f};
 531
 532     $self->error_message(
 533       "Cannot parse card payment - missing required content $f"
 534     );
 535
 536     warn $self->error_message if $DEBUG;
 537     $self->is_success( 0 );
 538
 539     return {};
 540   }
 541
 542   return +{
 543     number       => $self->truncate( $content->{card_number}, 20 ),
 544     name         => $self->truncate( $content->{owner}, 64 ),
 545     expiry_month => sprintf( '%02d', $content->{expiry_month} ),
 546     expiry_year  => sprintf( '%02d', $content->{expiry_year} ),
 547     cvd          => $content->{cvv2},
 548   }
 549 }
 550
 551 =head2 generate_token
 552
 553 Generate a 16-digit numeric token, beginning with the digits 99,
 554 based on the current epoch time
 555
 556 Implementation note:
 557
 558 If this module is somehow used to tokenize multiple cardholders within
 559 the same microsecond, these cardholders will be assigned the same
 560 customer_code.  In the unlikely event this does happen, the Bambora system
 561 will decline to process cards for either of the profiles with a duplicate
 562 customer_code.
 563
 564 =cut
 565
 566 sub generate_token {
 567   my $self = shift;
 568   my $time = Time::HiRes::time();
 569
 570   $time =~ s/\D//g;
 571   $time = substr($time, 0, 14 ); # Eventually time() will contain 15 digits
 572
 573   "99$time";
 574 }
 575
 576 =head2 set_country
 577
 578 Country is expected to be set as an ISO-3166-1 2-letter country code
 579
 580 Sets string to upper case.
 581
 582 Dies unless country is a two-letter string.
 583
 584 Could be extended to convert country names to their respective
 585 country codes, or validate country codes
 586
 587 See: L<https://en.wikipedia.org/wiki/ISO_3166-1>
 588
 589 =cut
 590
 591 sub set_country {
 592   my $self = shift;
 593   my $content = $self->{_content};
 594   my $country = uc $content->{country};
 595
 596   if ( $country !~ /^[A-Z]{2}$/ ) {
 597     croak sprintf 'country is not a 2 character string (%s)',
 598       $country || 'undef';
 599   };
 600
 601   $content->{country} = $country;
 602 }
 603
 604 =head2 set_expiration_month_year
 605
 606 Split B::OP expiration field, which may be in the format
 607 MM/YY or MMYY, into separate expiry_month and expiry_year fields
 608
 609 Will die if values are not numeric
 610
 611 =cut
 612
 613 sub set_expiration {
 614   my $self = shift;
 615   my $content = $self->{_content};
 616   my $expiration = $content->{expiration};
 617
 618   unless ( $expiration ) {
 619     $content->{expiry_month} = undef;
 620     $content->{expiry_year}  = undef;
 621     return;
 622   }
 623
 624   my ( $mm, $yy ) = (
 625     $expiration =~ /\//
 626     ? split( /\//, $expiration )
 627     : unpack( 'A2 A2', $expiration )
 628   );
 629
 630   croak 'card expiration must be in format MM/YY'
 631     if $mm =~ /\D/ || $yy =~ /\D/;
 632
 633   return (
 634     $content->{expiry_month} = sprintf( '%02d', $mm ),
 635     $content->{expiry_year}  = sprintf ('%02d', $yy ),
 636   );
 637 }
 638
 639 =head2 set_payment_method
 640
 641 Set payment_method value to one of the following strings
 642
 643   card
 644   token
 645   payment_profile
 646   cash
 647   cheque
 648   interac
 649   apple_pay
 650   android_pay
 651
 652 =cut
 653
 654 sub set_payment_method {
 655   # todo - determine correct payment method
 656   warn "set_payment_method() STUB FUNCTION ALWAYS RETURNS card!\n";
 657   shift->{_content}->{payment_method} = 'card';
 658 }
 659
 660 =head2 set_phone_number
 661
 662 Set value for field phone_number, from value in field phone
 663
 664 Bambora API expects only digits in a phone number. Strips all non-digit
 665 characters
 666
 667 =cut
 668
 669 sub set_phone_number {
 670   my $self = shift;
 671   my $content = $self->{_content};
 672
 673   my $phone = $content->{phone}
 674     or return $content->{phone_number} = undef;
 675
 676   $phone =~ s/\D//g;
 677   $content->{phone_number} = $phone;
 678 }
 679
 680 =head2 set_province
 681
 682 Set value for field province, from value in field state
 683
 684 Outside the US/Canada, API expect province set to the string "--",
 685 otherwise expects a 2 character string.  Value for province is
 686 formatted to upper case, and truncated to 2 characters.
 687
 688 =cut
 689
 690 sub set_province {
 691   my $self = shift;
 692   my $content = $self->{_content};
 693   my $country = uc $content->{country};
 694
 695   return $content->{province} = '--'
 696     unless $country
 697        && ( $country eq 'US' || $country eq 'CA' );
 698
 699   $content->{province} = uc $content->{state};
 700 }
 701
 702 =head2 truncate string, bytes
 703
 704 When given a string, truncate to given string length in a unicode safe way
 705
 706 =cut
 707
 708 sub truncate {
 709   my ( $self, $string, $bytes ) = @_;
 710
 711   # truncate_egc dies when asked to truncate undef
 712   return $string unless $string;
 713
 714   truncate_egc( "$string", $bytes, '' );
 715 }
 716
 717 =head2 https_put { headers => \%headers }, post_body
 718
 719 Implement a limited interface of https_get from Net::HTTPS::Any
 720 for PUT instead of POST -- only implementing current use case of
 721 submitting a JSON request body
 722
 723 Todo: Properly implement https_put in Net::HTTPS::Any
 724
 725 =cut
 726
 727 sub https_put {
 728   my ( $self, $args, $post_body ) = @_;
 729
 730   my $ua = LWP::UserAgent->new;
 731
 732   my %headers = %{ $args->{headers} } if ref $args->{headers};
 733   for my $k ( keys %headers ) {
 734     $ua->default_header( $k => $headers{$k} );
 735   }
 736
 737   my $url = $self->server().$self->path();
 738   my $res = $ua->put( $url, Content => $post_body );
 739
 740   $self->build_subs(qw/ response_page response_code response_headers/);
 741
 742   my @response_headers =
 743     map { $_ => $res->header( $_ ) }
 744     $res->header_field_names;
 745
 746   $self->response_headers( {@response_headers} );
 747   $self->response_code( $res->code );
 748   $self->response_page( $res->decoded_content );
 749
 750   ( $self->response_page, $self->response_code, @response_headers );
 751 }
 752
 753 1;