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   = 1;
  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_viod',
  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 Compliete 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   if ( $action eq 'normal authorization' ) {
 140     $self->path('/v1/payments');
 141   } elsif ( $action eq 'authorization only' ) {
 142     $self->path('/v1/payments');
 143     if ( ref $post{card} ) {
 144       $post{card}->{complete} = 0;
 145     }
 146   } elsif ( $action eq 'post authorization' ) {
 147
 148     croak 'post authorization cannot be completed - '.
 149           'bambora transaction_id must be set as order_number '.
 150           'before using submit()'
 151               unless $content->{order_number};
 152
 153     $self->path(
 154       sprintf 'v1/payments/%s/completions',
 155         $content->{order_number}
 156     );
 157
 158     if ( ref $post{card} ) {
 159       $post{card}->{complete} = 1
 160     }
 161   } else {
 162     die "unsupported action $action";
 163   }
 164
 165   # Parse %post into a JSON string, to be attached to the request POST body
 166   my $post_body = encode_json( \%post );
 167
 168   if ( $DEBUG ) {
 169     warn Dumper({
 170       post_body => $post_body,
 171       post_href => \%post,
 172     });
 173   }
 174
 175
 176   $self->path('/v1/payments');
 177
 178   my $response = $self->submit_api_request( $post_body );
 179
 180   # Error messages already populated upon failure
 181   return unless $self->is_success;
 182
 183   # Populate transaction result values
 184   $self->message_id( $response->{message_id} );
 185   $self->authorization( $response->{auth_code} );
 186   $self->order_number( $response->{id} );
 187   $self->txn_date( $response->{created} );
 188   $self->avs_code( $response->{card}{avs_result} );
 189   $self->is_success( 1 );
 190
 191   $response;
 192 }
 193
 194 =head2 submit_authorization_only
 195
 196 Capture a card authorization, but do not complete transaction
 197
 198 =cut
 199
 200 sub submit_authorization_only {
 201   my $self = shift;
 202
 203   $self->submit_normal_authorization;
 204
 205   my $response = $self->response_decoded;
 206
 207   if (
 208     $self->is_success
 209     && (
 210       ref $response
 211       && $response->{type} != 'PA'
 212     )
 213   ) {
 214     # Bambora API uses nearly identical API calls for normal
 215     # card transactions and pre-authorization. Sanity check
 216     # that response reported a pre-authorization code
 217     die "Expected API Respose type=PA, but type=$response->{type}! ".
 218         "Pre-Authorization attempt may have charged card!";
 219   }
 220 }
 221
 222 =head2 submit_post_authorization
 223
 224 Complete a card pre-authorization
 225
 226 =cut
 227
 228 sub submit_post_authorization {
 229   shift->submit_normal_authorization;
 230 }
 231
 232 =head2 submit_reverse_authorization
 233
 234 Reverse a pre-authorization
 235
 236 =cut
 237
 238 sub submit_reverse_authorization {
 239   shift->submit_void;
 240 }
 241
 242 =head2 submit_void
 243
 244 Void a transaction
 245
 246 =cut
 247
 248 sub submit_void {
 249   my $self = shift;
 250   my $content = $self->{_content};
 251
 252   for my $f (qw/ order_number invoice_number amount/) {
 253     unless ( $content->{$f} ) {
 254       $self->error_message("Cannot process void - missing required content $f");
 255       warn $self->error_message if $DEBUG;
 256
 257       return $self->is_success(0);
 258     }
 259   }
 260
 261   my %post = (
 262     order_number => $self->truncate( $content->{invoice_number}, 30 ),
 263     amount => $content->{amount},
 264   );
 265   my $post_body = encode_json( \%post );
 266
 267   if ( $DEBUG ) {
 268     warn Dumper({
 269       post => \%post,
 270       post_body => $post_body,
 271     });
 272   }
 273   $self->path( sprintf '/v1/payments/%s/void', $content->{order_number} );
 274
 275   my $response = $self->submit_api_request( $post_body );
 276
 277 }
 278
 279 =head2 submit_api_request json_string
 280
 281 Make the appropriate API request with the given JSON string
 282
 283 =cut
 284
 285 sub submit_api_request {
 286   my $self = shift;
 287   my $post_body = shift
 288     or die 'submit_api_request() requires a json_string parameter';
 289
 290   my ( $response_body, $response_code, %response_headers ) = $self->https_post(
 291     {
 292       headers => { $self->authorization_header },
 293       'Content-Type' => 'application/json',
 294     },
 295     $post_body,
 296   );
 297   $self->server_response( $response_body );
 298
 299   my $response;
 300   {
 301     local $@;
 302     eval{ $response = decode_json( $response_body ) };
 303
 304     if ( $DEBUG ) {
 305       warn Dumper({
 306         response_body    => $response_body,
 307         response         => $response,
 308         response_code    => $response_code,
 309         # response_headers => \%response_headers,
 310       });
 311     }
 312
 313     # API should always return a JSON response, likely network problem
 314     if ( $@ || !$response ) {
 315       $self->error_message( $response_body || 'connection error' );
 316       $self->is_success( 0 );
 317       return;
 318     }
 319   }
 320   $self->response_decoded( $response );
 321
 322   # Response returned an error
 323   if ( $response->{code} && $response->{code} != 1 ) {
 324     $self->is_success( 0 );
 325     $self->result_code( $response->{code} );
 326
 327     return $self->error_message(
 328       sprintf '%s %s',
 329         $response->{code},
 330         $response->{message}
 331     );
 332   }
 333
 334   # Success
 335   # Return the decoded json of the response back to handler
 336   $self->is_success( 1 );
 337   return $response;
 338
 339 }
 340
 341 =head2 submit_action_unsupported
 342
 343 Croak with the error message Action $action unsupported
 344
 345 =cut
 346
 347 sub submit_action_unsupported {
 348   croak sprintf 'Action %s unsupported', shift->action
 349 }
 350
 351 =head2 authorization_header
 352
 353 Bambora POST requests authenticate via a HTTP header of the format:
 354 Authorization: Passcode Base64Encoded(merchant_id:passcode)
 355
 356 Returns a hash representing the authorization header derived from
 357 the merchant id (login) and API passcode (password)
 358
 359 =cut
 360
 361 sub authorization_header {
 362   my $self = shift;
 363   my $content = $self->{_content};
 364
 365   my %authorization_header = (
 366     Authorization => 'Passcode ' . MIME::Base64::encode_base64(
 367       join( ':', $content->{login}, $content->{password} )
 368     )
 369   );
 370
 371   if ( $DEBUG ) {
 372     warn Dumper({ authorization_header => \%authorization_header })."\n";
 373   }
 374
 375   %authorization_header;
 376 }
 377
 378 =head2 jhref_billing_address
 379
 380 Return a hashref for inclusion into a json object
 381 representing the RequestBillingAddress for the API
 382
 383 =cut
 384
 385 sub jhref_billing_address {
 386   my $self = shift;
 387
 388   $self->set_province;
 389   $self->set_country;
 390   $self->set_phone_number;
 391
 392   my $content = $self->{_content};
 393
 394   return {
 395     name          => $self->truncate( $content->{name}, 64 ),
 396     address_line1 => $self->truncate( $content->{address}, 64 ),
 397     city          => $self->truncate( $content->{city}, 64 ),
 398     province      => $self->truncate( $content->{province}, 2 ),
 399     country       => $self->truncate( $content->{country}, 2 ),
 400     postal_code   => $self->truncate( $content->{zip}, 16 ),
 401     phone_number  => $self->truncate( $content->{phone_number}, 20 ),
 402     email_address => $self->truncate( $content->{email}, 64 ),
 403   };
 404 }
 405
 406 =head2 set_country
 407
 408 Country is expected to be set as an ISO-3166-1 2-letter country code
 409
 410 Sets string to upper case.
 411
 412 Dies unless country is a two-letter string.
 413
 414 In the future, could be extended to convert country names to their respective
 415 country codes
 416
 417 See: L<https://en.wikipedia.org/wiki/ISO_3166-1>
 418
 419 =cut
 420
 421 sub set_country {
 422   my $self = shift;
 423   my $content = $self->{_content};
 424   my $country = uc $content->{country};
 425
 426   if ( $country !~ /^[A-Z]{2}$/ ) {
 427     croak sprintf 'country is not a 2 character string (%s)',
 428       $country || 'undef';
 429   };
 430
 431   $content->{country} = $country;
 432 }
 433
 434 =head2 set_expiration_month_year
 435
 436 Split standard expiration field, which may be in the format
 437 MM/YY or MMYY, into separate expiry_month and expiry_year fields
 438
 439 Will die if values are not numeric
 440
 441 =cut
 442
 443 sub set_expiration {
 444   my $self = shift;
 445   my $content = $self->{_content};
 446   my $expiration = $content->{expiration};
 447
 448   my ( $mm, $yy ) = (
 449     $expiration =~ /\//
 450     ? split( /\//, $expiration )
 451     : unpack( 'A2 A2', $expiration )
 452   );
 453
 454   croak 'card expiration must be in format MM/YY'
 455     if $mm =~ /\D/ || $yy =~ /\D/;
 456
 457   return (
 458     $content->{expiry_month} = sprintf( '%02d', $mm ),
 459     $content->{expiry_year}  = sprintf ('%02d', $yy ),
 460   );
 461 }
 462
 463 =head2 set_payment_method
 464
 465 Set payment_method value to one of the following strings
 466
 467   card
 468   token
 469   payment_profile
 470   cash
 471   cheque
 472   interac
 473   apple_pay
 474   android_pay
 475
 476 =cut
 477
 478 sub set_payment_method {
 479   # todo - determine correct payment method
 480   warn "set_payment_method() STUB FUNCTION ALWAYS RETURNS card!\n";
 481   shift->{_content}->{payment_method} = 'card';
 482 }
 483
 484 =head2 set_phone_number
 485
 486 =cut
 487
 488 sub set_phone_number {
 489   my $self = shift;
 490   my $content = $self->{_content};
 491
 492   my $phone = $content->{phone}
 493     or return $content->{phone_number} = undef;
 494
 495   $phone =~ s/\D//g;
 496   $content->{phone_number} = $phone;
 497 }
 498
 499 =head2 set_province
 500
 501 Outside the US/Canada, API expect province set to the string "--",
 502 otherwise to be a 2 character string
 503
 504 =cut
 505
 506 sub set_province {
 507   my $self = shift;
 508   my $content = $self->{_content};
 509   my $country = uc $content->{country};
 510
 511   return $content->{province} = '--'
 512     unless $country
 513        && ( $country eq 'US' || $country eq 'CA' );
 514
 515   $content->{province} = uc $content->{state};
 516 }
 517
 518 =head2 truncate string, bytes
 519
 520 When given a string, truncate to given string length in a unicode safe way
 521
 522 =cut
 523
 524 sub truncate {
 525   my ( $self, $string, $bytes ) = @_;
 526
 527   # truncate_egc dies when asked to truncate undef
 528   return $string unless $string;
 529
 530   truncate_egc( "$string", $bytes, '' );
 531 }
 532
 533
 534 1;