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; $Data::Dumper::Sortkeys = 1;
  10 use MIME::Base64;
  11 use Unicode::Truncate qw( truncate_egc );
  12 use URI::Escape;
  13
  14 use vars qw/ $VERSION $DEBUG /;
  15 $VERSION = '0.01';
  16 $DEBUG   = 0;
  17
  18 if ( $DEBUG ) {
  19     $Data::Dumper::Sortkeys = 1;
  20 }
  21
  22 =head1 INTERNAL METHODS
  23
  24 =head2 set_defaults
  25
  26 See L<Business::OnlinePayment/set_defaults>
  27
  28 =cut
  29
  30 sub set_defaults {
  31   my $self = shift;
  32
  33   $self->server('api.na.bambora.com');
  34   $self->port('443');
  35
  36   # Create accessors for
  37   $self->build_subs(qw/
  38     expiry_month
  39     expiry_year
  40     invoice_number
  41     message_id
  42     payment_method
  43     phone_number
  44     province
  45     recurring_payment
  46     response_decoded
  47     txn_date
  48   /);
  49 }
  50
  51 =head2 submit
  52
  53 Dispatch to the appropriate handler based on the given action
  54
  55 =cut
  56
  57 my %action_dispatch_table = (
  58   'normal authorization'           => 'submit_normal_authorization',
  59   'authorization only'             => 'submit_authorization_only',
  60   'post authorization'             => 'submit_post_authorization',
  61   'reverse authorization'          => 'submit_reverse_authorization',
  62   'void'                           => 'submit_void',
  63   'credit'                         => 'submit_credit',
  64   'tokenize'                       => 'submit_tokenize',
  65   'recurring authorization'        => 'submit_recurring_authorization',
  66   'modify recurring authorization' => 'modify_recurring_authorization',
  67 );
  68
  69 sub submit {
  70   my $self = shift;
  71
  72   my $action = lc $self->{_content}->{action}
  73     or croak 'submit() called with no action set';
  74
  75   my $method = $action_dispatch_table{$action};
  76
  77   $self->submit_action_unsupported()
  78     unless $method
  79         && $self->can($method);
  80
  81   $self->$method(@_);
  82 }
  83
  84 =head2 submit_normal_authorization
  85
  86 Complete a payment transaction by with an API POST to B</payments>
  87
  88 See L<https://dev.na.bambora.com/docs/references/payment_APIs/v1-0-5>
  89
  90 =cut
  91
  92 sub submit_normal_authorization {
  93   my $self = shift;
  94   my $content = $self->{_content};
  95
  96   # Use epoch time as invoice_number, if none is specified
  97   $content->{invoice_number} ||= time();
  98
  99   # Clarifying Bambora API and Business::OnlinePayment naming conflict
 100   #
 101   # Bambora API:
 102   # - order_number: user supplied identifier for the order, displayed on reports
 103   # - transaction_id: bambora supplied identifier for the order.
 104   #     this number must be referenced for future actions like voids,
 105   #     auth captures, etc
 106   #
 107   # Business::OnlinePayment
 108   # - invoice_number: contains the bambora order number
 109   # - order_number: contains the bambora transaction id
 110
 111   my %post = (
 112     order_number => $self->truncate( $content->{invoice_number}, 30 ),
 113     amount       => $content->{amount},
 114     billing      => $self->jhref_billing_address,
 115   );
 116
 117   # Credit Card
 118   if ( $content->{card_number} ) {
 119     $post{payment_method} = 'card';
 120
 121     # Parse the expiration date into expiry_month and expiry_year
 122     $self->set_expiration;
 123
 124     $post{card} = {
 125       number            => $self->truncate( $content->{card_number}, 20 ),
 126       name              => $self->truncate( $content->{owner}, 64 ),
 127       expiry_month      => sprintf( '%02d', $content->{expiry_month} ),
 128       expiry_year       => sprintf( '%02d', $content->{expiry_year} ),
 129       cvd               => $content->{cvv2},
 130       recurring_payment => $content->{recurring_payment} ? 1 : 0,
 131       complete          => 1,
 132     };
 133
 134   } else {
 135     die 'unknown/unsupported payment method!';
 136   }
 137
 138   my $action = lc $content->{action};
 139
 140   if ( $action eq 'normal authorization' ) {
 141     $self->path('/v1/payments');
 142   } elsif ( $action eq 'authorization only' ) {
 143     $self->path('/v1/payments');
 144     if ( ref $post{card} ) {
 145       $post{card}->{complete} = 0;
 146     }
 147   } elsif ( $action eq 'post authorization' ) {
 148
 149     croak 'post authorization cannot be completed - '.
 150           'bambora transaction_id must be set as order_number '.
 151           'before using submit()'
 152               unless $content->{order_number};
 153
 154     $self->path(
 155       sprintf '/v1/payments/%s/completions',
 156         $content->{order_number}
 157     );
 158
 159     if ( ref $post{card} ) {
 160       $post{card}->{complete} = 1
 161     }
 162   } else {
 163     die "unsupported action $action";
 164   }
 165
 166   # Parse %post into a JSON string, to be attached to the request POST body
 167   my $post_body = encode_json( \%post );
 168
 169   if ( $DEBUG ) {
 170     warn Dumper({
 171       post_body => $post_body,
 172       post_href => \%post,
 173     });
 174   }
 175
 176   my $response = $self->submit_api_request( $post_body );
 177
 178   # Error messages already populated upon failure
 179   return unless $self->is_success;
 180
 181   # Populate transaction result values
 182   $self->message_id( $response->{message_id} );
 183   $self->authorization( $response->{auth_code} );
 184   $self->order_number( $response->{id} );
 185   $self->txn_date( $response->{created} );
 186   $self->avs_code( $response->{card}{avs_result} );
 187   $self->is_success( 1 );
 188
 189   $response;
 190 }
 191
 192 =head2 submit_authorization_only
 193
 194 Capture a card authorization, but do not complete transaction
 195
 196 =cut
 197
 198 sub submit_authorization_only {
 199   my $self = shift;
 200
 201   $self->submit_normal_authorization;
 202
 203   my $response = $self->response_decoded;
 204
 205   if (
 206     $self->is_success
 207     && (
 208       ref $response
 209       && $response->{type} ne 'PA'
 210     )
 211   ) {
 212     # Bambora API uses nearly identical API calls for normal
 213     # card transactions and pre-authorization. Sanity check
 214     # that response reported a pre-authorization code
 215     die "Expected API Respose type=PA, but type=$response->{type}! ".
 216         "Pre-Authorization attempt may have charged card!";
 217   }
 218 }
 219
 220 =head2 submit_post_authorization
 221
 222 Complete a card pre-authorization
 223
 224 =cut
 225
 226 sub submit_post_authorization {
 227   shift->submit_normal_authorization;
 228 }
 229
 230 =head2 submit_reverse_authorization
 231
 232 Reverse a pre-authorization
 233
 234 =cut
 235
 236 sub submit_reverse_authorization {
 237   shift->submit_void;
 238 }
 239
 240 =head2 submit_void
 241
 242 Process a return against a transaction for the given amount
 243
 244 =cut
 245
 246 sub submit_void {
 247   my $self = shift;
 248   my $content = $self->{_content};
 249
 250   for my $f (qw/ order_number amount/) {
 251     unless ( $content->{$f} ) {
 252       $self->error_message("Cannot process void - missing required content $f");
 253       warn $self->error_message if $DEBUG;
 254
 255       return $self->is_success(0);
 256     }
 257   }
 258
 259   my %post = (
 260 #    order_number => $self->truncate( $content->{invoice_number}, 30 ),
 261     amount => $content->{amount},
 262   );
 263   my $post_body = encode_json( \%post );
 264
 265   if ( $DEBUG ) {
 266     warn Dumper({
 267       post => \%post,
 268       post_body => $post_body,
 269     });
 270   }
 271   $self->path( sprintf '/v1/payments/%s/returns', $content->{order_number} );
 272
 273   my $response = $self->submit_api_request( $post_body );
 274
 275 }
 276
 277 =head2 submit_api_request json_string
 278
 279 Make the appropriate API request with the given JSON string
 280
 281 =cut
 282
 283 sub submit_api_request {
 284   my $self = shift;
 285   my $post_body = shift
 286     or die 'submit_api_request() requires a json_string parameter';
 287
 288   my ( $response_body, $response_code, %response_headers ) = $self->https_post(
 289     {
 290       headers => { $self->authorization_header },
 291       'Content-Type' => 'application/json',
 292     },
 293     $post_body,
 294   );
 295   $self->server_response( $response_body );
 296
 297   my $response;
 298   {
 299     local $@;
 300     eval{ $response = decode_json( $response_body ) };
 301
 302     if ( $DEBUG ) {
 303       warn Dumper({
 304         response_body    => $response_body,
 305         response         => $response,
 306         response_code    => $response_code,
 307         # response_headers => \%response_headers,
 308       });
 309     }
 310
 311     # API should always return a JSON response, likely network problem
 312     if ( $@ || !$response ) {
 313       $self->error_message( $response_body || 'connection error' );
 314       $self->is_success( 0 );
 315       return;
 316     }
 317   }
 318   $self->response_decoded( $response );
 319
 320   # Response returned an error
 321   if ( $response->{code} && $response->{code} != 1 ) {
 322     $self->is_success( 0 );
 323     $self->result_code( $response->{code} );
 324
 325     return $self->error_message(
 326       sprintf '%s %s',
 327         $response->{code},
 328         $response->{message}
 329     );
 330   }
 331
 332   # Success
 333   # Return the decoded json of the response back to handler
 334   $self->is_success( 1 );
 335   return $response;
 336
 337 }
 338
 339 =head2 submit_action_unsupported
 340
 341 Croak with the error message Action $action unsupported
 342
 343 =cut
 344
 345 sub submit_action_unsupported {
 346   croak sprintf 'Action %s unsupported', shift->{_content}{action}
 347 }
 348
 349 =head2 authorization_header
 350
 351 Bambora REST requests authenticate via a HTTP header of the format:
 352 Authorization: Passcode Base64Encoded(merchant_id:passcode)
 353
 354 Returns a hash representing the authorization header derived from
 355 the merchant id (login) and API passcode (password)
 356
 357 =cut
 358
 359 sub authorization_header {
 360   my $self = shift;
 361   my $content = $self->{_content};
 362
 363   my %authorization_header = (
 364     Authorization => 'Passcode ' . MIME::Base64::encode_base64(
 365       join( ':', $content->{login}, $content->{password} )
 366     )
 367   );
 368
 369   if ( $DEBUG ) {
 370     warn Dumper({ authorization_header => \%authorization_header })."\n";
 371   }
 372
 373   %authorization_header;
 374 }
 375
 376 =head2 jhref_billing_address
 377
 378 Return a hashref for inclusion into a json object
 379 representing the RequestBillingAddress for the API
 380
 381 =cut
 382
 383 sub jhref_billing_address {
 384   my $self = shift;
 385
 386   $self->set_province;
 387   $self->set_country;
 388   $self->set_phone_number;
 389
 390   my $content = $self->{_content};
 391
 392   return {
 393     name          => $self->truncate( $content->{name}, 64 ),
 394     address_line1 => $self->truncate( $content->{address}, 64 ),
 395     city          => $self->truncate( $content->{city}, 64 ),
 396     province      => $self->truncate( $content->{province}, 2 ),
 397     country       => $self->truncate( $content->{country}, 2 ),
 398     postal_code   => $self->truncate( $content->{zip}, 16 ),
 399     phone_number  => $self->truncate( $content->{phone_number}, 20 ),
 400     email_address => $self->truncate( $content->{email}, 64 ),
 401   };
 402 }
 403
 404 =head2 set_country
 405
 406 Country is expected to be set as an ISO-3166-1 2-letter country code
 407
 408 Sets string to upper case.
 409
 410 Dies unless country is a two-letter string.
 411
 412 Could be extended to convert country names to their respective
 413 country codes
 414
 415 See: L<https://en.wikipedia.org/wiki/ISO_3166-1>
 416
 417 =cut
 418
 419 sub set_country {
 420   my $self = shift;
 421   my $content = $self->{_content};
 422   my $country = uc $content->{country};
 423
 424   if ( $country !~ /^[A-Z]{2}$/ ) {
 425     croak sprintf 'country is not a 2 character string (%s)',
 426       $country || 'undef';
 427   };
 428
 429   $content->{country} = $country;
 430 }
 431
 432 =head2 set_expiration_month_year
 433
 434 Split B::OP expiration field, which may be in the format
 435 MM/YY or MMYY, into separate expiry_month and expiry_year fields
 436
 437 Will die if values are not numeric
 438
 439 =cut
 440
 441 sub set_expiration {
 442   my $self = shift;
 443   my $content = $self->{_content};
 444   my $expiration = $content->{expiration};
 445
 446   unless ( $expiration ) {
 447     $content->{expiry_month} = undef;
 448     $content->{expiry_year}  = undef;
 449     return;
 450   }
 451
 452   my ( $mm, $yy ) = (
 453     $expiration =~ /\//
 454     ? split( /\//, $expiration )
 455     : unpack( 'A2 A2', $expiration )
 456   );
 457
 458   croak 'card expiration must be in format MM/YY'
 459     if $mm =~ /\D/ || $yy =~ /\D/;
 460
 461   return (
 462     $content->{expiry_month} = sprintf( '%02d', $mm ),
 463     $content->{expiry_year}  = sprintf ('%02d', $yy ),
 464   );
 465 }
 466
 467 =head2 set_payment_method
 468
 469 Set payment_method value to one of the following strings
 470
 471   card
 472   token
 473   payment_profile
 474   cash
 475   cheque
 476   interac
 477   apple_pay
 478   android_pay
 479
 480 =cut
 481
 482 sub set_payment_method {
 483   # todo - determine correct payment method
 484   warn "set_payment_method() STUB FUNCTION ALWAYS RETURNS card!\n";
 485   shift->{_content}->{payment_method} = 'card';
 486 }
 487
 488 =head2 set_phone_number
 489
 490 Set value for field phone_number, from value in field phone
 491
 492 Bambora API expects only digits in a phone number. Strips all non-digit
 493 characters
 494
 495 =cut
 496
 497 sub set_phone_number {
 498   my $self = shift;
 499   my $content = $self->{_content};
 500
 501   my $phone = $content->{phone}
 502     or return $content->{phone_number} = undef;
 503
 504   $phone =~ s/\D//g;
 505   $content->{phone_number} = $phone;
 506 }
 507
 508 =head2 set_province
 509
 510 Set value for field province, from value in field state
 511
 512 Outside the US/Canada, API expect province set to the string "--",
 513 otherwise expects a 2 character string.  Value for province is
 514 formatted to upper case, and truncated to 2 characters.
 515
 516 =cut
 517
 518 sub set_province {
 519   my $self = shift;
 520   my $content = $self->{_content};
 521   my $country = uc $content->{country};
 522
 523   return $content->{province} = '--'
 524     unless $country
 525        && ( $country eq 'US' || $country eq 'CA' );
 526
 527   $content->{province} = uc $content->{state};
 528 }
 529
 530 =head2 truncate string, bytes
 531
 532 When given a string, truncate to given string length in a unicode safe way
 533
 534 =cut
 535
 536 sub truncate {
 537   my ( $self, $string, $bytes ) = @_;
 538
 539   # truncate_egc dies when asked to truncate undef
 540   return $string unless $string;
 541
 542   truncate_egc( "$string", $bytes, '' );
 543 }
 544
 545
 546 1;