path: root/lib/Business/OnlinePayment/Bambora.pm

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   = 1;

if ( $DEBUG ) {
    $Data::Dumper::Sortkeys = 1;
}

=head1 INTERNAL METHODS

=head2 set_defaults

See L<Business::OnlinePayment/set_defaults>

=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 handler 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'          => 'submit_reverse_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</payments>

See L<https://dev.na.bambora.com/docs/references/payment_APIs/v1-0-5>

=cut

sub submit_normal_authorization {
  my $self = shift;
  my $content = $self->{_content};

  # Use epoch time as invoice_number, if none is specified
  $content->{invoice_number} ||= time();

  # Clarifying Bambora API and Business::OnlinePayment naming conflict
  #
  # Bambora API:
  # - order_number: user supplied identifier for the order, displayed on reports
  # - transaction_id: bambora supplied identifier for the order.
  #     this number must be referenced for future actions like voids,
  #     auth captures, etc
  #
  # Business::OnlinePayment
  # - invoice_number: contains the bambora order number
  # - order_number: contains the bambora transaction id

  my %post = (
    order_number => $self->truncate( $content->{invoice_number}, 30 ),
    amount       => $content->{amount},
    billing      => $self->jhref_billing_address,
  );

  # Credit Card
  if ( $content->{card_number} ) {
    $post{payment_method} = 'card';

    # Parse the expiration date into expiry_month and expiry_year
    $self->set_expiration;

    $post{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,
      complete          => 1,
    };

  } else {
    die 'unknown/unsupported payment method!';
  }

  my $action = lc $content->{action};
  if ( $action eq 'normal authorization' ) {
    $self->path('/v1/payments');
  } elsif ( $action eq 'authorization only' ) {
    $self->path('/v1/payments');
    if ( ref $post{card} ) {
      $post{card}->{complete} = 0;
    }
  } elsif ( $action eq 'post authorization' ) {

    croak 'post authorization cannot be completed - '.
          'bambora transaction_id must be set as order_number '.
          'before using submit()'
              unless $content->{order_number};

    $self->path(
      sprintf 'v1/payments/%s/completions',
        $content->{order_number}
    );

    if ( ref $post{card} ) {
      $post{card}->{complete} = 1
    }
  } else {
    die "unsupported action $action";
  }

  # Parse %post into a JSON string, to be attached to the request POST body
  my $post_body = encode_json( \%post );
    
  if ( $DEBUG ) {
    warn Dumper({
      post_body => $post_body,
      post_href => \%post,
    });
  }

  
  $self->path('/v1/payments');

  my $response = $self->submit_api_request( $post_body );

  # Error messages already populated upon failure
  return unless $self->is_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 );

  $response;
}

=head2 submit_authorization_only

Capture a card authorization, but do not complete transaction

=cut

sub submit_authorization_only {
  my $self = shift;

  $self->submit_normal_authorization;

  my $response = $self->response_decoded;

  if (
    $self->is_success
    && (
      ref $response
      && $response->{type} != 'PA'
    )
  ) {
    # Bambora API uses nearly identical API calls for normal
    # card transactions and pre-authorization. Sanity check
    # that response reported a pre-authorization code
    die "Expected API Respose type=PA, but type=$response->{type}! ".
        "Pre-Authorization attempt may have charged card!";
  }
}

=head2 submit_post_authorization

Complete a card pre-authorization

=cut

sub submit_post_authorization {
  shift->submit_normal_authorization;
}

=head2 submit_reverse_authorization

Reverse a pre-authorization

=cut

sub submit_reverse_authorization {
  shift->submit_void;
}

=head2 submit_void

Void a transaction

=cut

sub submit_void {
  my $self = shift;
  my $content = $self->{_content};

  for my $f (qw/ order_number invoice_number amount/) {
    unless ( $content->{$f} ) {
      $self->error_message("Cannot process void - missing required content $f");
      warn $self->error_message if $DEBUG;

      return $self->is_success(0);
    }
  }

  my %post = (
    order_number => $self->truncate( $content->{invoice_number}, 30 ),
    amount => $content->{amount},
  );
  my $post_body = encode_json( \%post );

  if ( $DEBUG ) {
    warn Dumper({
      post => \%post,
      post_body => $post_body,
    });
  }
  $self->path( sprintf '/v1/payments/%s/void', $content->{order_number} );

  my $response = $self->submit_api_request( $post_body );

}

=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 $post_body = shift
    or die 'submit_api_request() requires a json_string parameter';

  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, likely network problem
    if ( $@ || !$response ) {
      $self->error_message( $response_body || 'connection error' );
      $self->is_success( 0 );
      return;
    }
  }
  $self->response_decoded( $response );

  # Response returned an error
  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
  # Return the decoded json of the response back to handler
  $self->is_success( 1 );
  return $response;

}

=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 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<https://en.wikipedia.org/wiki/ISO_3166-1>

=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;