Add B::OP undocumented _info discovery hash

[Business-OnlinePayment-Bambora.git] / 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;
    $Data::Dumper::Indent   = 1;
use LWP::UserAgent;
use MIME::Base64;
use Time::HiRes;
use Unicode::Truncate qw( truncate_egc );
use URI::Escape;

use vars qw/ $VERSION $DEBUG /;
$VERSION = '0.1';
$DEBUG   = 0;

=head1 INTERNAL METHODS

=head2 _info

=cut

sub _info {{
  info_compat       => '0.01',
  module_version    => $VERSION,
  supported_types   => [qw/ CC /],
  supported_actions => {
    CC => [
      'Normal Authorization',
      'Authorization Only',
      'Post Authorization',
      'Void',
      'Credit',
      'Reverse Authorization',
      'Tokenize',
    ],
  },
}}

=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/
    card_token
    expiry_month
    expiry_year
    failure_status
    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_void',
  '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};

  unless ( $method && $self->can($method) ) {
    warn $self->error_message( "Action is unsupported ($action)" );
    return $self->is_success(0);
  }

  $self->$method(@_);
}

=head2 submit_normal_authorization

Complete 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},
  );

  if (
    $content->{card_token}
    || ( $content->{card_number} && $content->{card_number} =~ /^99\d{14}$/ )
  ) {
    # Process payment against a stored Payment Profile, whose
    # customer_code is used as the card_token

    my $card_token = $content->{card_token} || $content->{card_number};

    unless ( $card_token =~ /^99\d{14}$/ ) {
      $self->error_message(
        "Invalid card_token($card_token): Expected 16-digit "
        . " beginning with 99"
      );
      return $self->is_success(0);
    }

    $post{payment_method} = 'payment_profile';

    $post{payment_profile} = {
      customer_code => $card_token,
      card_id => 1,
    };

  } elsif ( $content->{card_number} ) {

    $post{payment_method} = 'card';

    # Add card payment details to %post
    $post{card} = $self->jhref_card;
    return if $self->error_message;

    # Add billing address to card
    $post{billing} = $self->jhref_billing_address;

    # Designate recurring payment label
    $post{card}->{recurring_payment} = $content->{recurring_payment} ? 1 : 0;

    # Direct API to issue a complete auth, instead of pre-auth
    $post{card}->{complete} = 1;

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

  my $action = lc $content->{action};

  if ( $action eq 'normal authorization' ) {
    # Perform complete authorization
    $self->path('/v1/payments');

  } elsif ( $action eq 'authorization only' ) {
    # Perform pre-authorization
    $self->path('/v1/payments');

    # Set the 'complete' flag to false, directing API to perform pre-auth
    if ( ref $post{payment_profile} ) {
      $post{payment_profile}->{complete} = 0;
    } elsif ( ref $post{card} ) {
      $post{card}->{complete} = 0;
    }

  } elsif ( $action eq 'post authorization' ) {
    # Complete a pre-authorization

    croak 'post authorization cannot be completed - '.
          'bambora transaction_id must be set as content 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({
      path      => $self->path,
      post_body => $post_body,
      post_href => \%post,
    });
  }

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

  # Any error messages will have been populated by submit_api_request
  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} ne '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

Process a return against a transaction for the given amount

=cut

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

  for my $f (qw/ order_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);
    }
  }

  # The posted JSON string needs only contain the amount.
  # The bambora order_number being voided is passed in the URL
  my %post = (
    amount => $content->{amount},
  );
  my $post_body = encode_json( \%post );

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

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

  $self->is_success(1);

  $response;
}

=head2 submit_tokenize

Bambora tokenization is based on the Payment Profile feature of their API.

The token created by this method represents the Bambora customer_code for the
Payment Profile.  The token resembles a credit card number.  It is 16 digits
long, beginning with 99.  No valid card number can begin with the digits 99.

This method creates the payment profile and reports the customer_code
as the card_token

=cut

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

  # Check if given card number is already a bambora customer_code
  # under this module's token rules
  croak "card_number is already tokenized"
    if $content->{card_number} =~ /^99\d{14}$/;

  my %post = (
    customer_code => $self->generate_token,
    card          => $self->jhref_card,
    billing       => $self->jhref_billing_address,
    validate      => 0,
  );

  # jhref_card may have generated an exception
  return if $self->error_message;

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

  my $post_body = encode_json( \%post );

  if ( $DEBUG ) {
    warn Dumper({
      path      => $self->path,
      post_body => $post_body,
      post_href => \%post,
    });
  }

  my $response = $self->submit_api_request( $post_body );
  if ( $DEBUG ) {
    warn Dumper({
      response => $response,
      is_success => $self->is_success,
      error_message => $self->error_message,
    });
  }
  return unless $self->is_success;

  my $customer_code = $response->{customer_code};
  if ( !$customer_code ) {
    # Should not happen...
    # API reported success codes, but
    # customer_code value is missing
    $self->error_message(
      "Fatal error: API reported success, but did not return customer_code"
    );
    return $self->is_success(0);
  }

  if ( $customer_code ne $post{customer_code} ) {
    # Should not happen...
    # API reported success codes, but
    # customer_code attached to created profiles does not match
    # the token value we attempted to assign to the customer profile
    $self->error_message(
      "Fatal error: API failed to set payment profile customer_code value"
    );
    return $self->is_success(0);
  }

  $self->card_token( $customer_code );

  return $response;
}



=head2 submit_api_request json_string [ POST | PUT ]

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

  # Default to using https_post, unless PUT has been specified
  my $http_method = ( $_[0] && lc $_[0] eq 'put' ) ? 'https_put' : 'https_post';

  my ($response_body, $response_code, %response_headers) = $self->$http_method(
    {
      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
    if ( $@ || !$response ) {
      $self->error_message( $response_body || 'connection error' );
      $self->is_success( 0 );
      return;
    }
  }
  $self->response_decoded( $response );

  if ( $response->{code} && $response->{code} != 1 ) {
    # Response returned an error

    $self->is_success( 0 );
    $self->result_code( $response->{code} );

    if ( $response->{message} =~ /decline/i ) {
      $self->failure_status('declined');
    }

    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 authorization_header

Bambora REST 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->parse_province;
  $self->set_country;
  $self->parse_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 jhref_card

Return a hashref for inclusin into a json object
representing Card for the API

If necessary values are missing from %content, will set
error_message and is_success

=cut

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

  $self->set_expiration;

  $content->{owner} ||= $content->{name};

  # Check required input
  for my $f (qw/
    card_number
    owner
    expiry_month
    expiry_year
  /) {
    next if $content->{$f};

    $self->error_message(
      "Cannot parse card payment - missing required content $f"
    );

    if ( $DEBUG ) {
      warn Dumper({
        error_message => $self->error_message,
        content => $content,
      });
    }

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

  return +{
    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} ),

    $content->{cvv2} ? ( cvd => $content->{cvv2} ) : (),
  }
}

=head2 generate_token

Generate a 16-digit numeric token, beginning with the digits 99,
based on the current epoch time

Implementation note:

If this module is somehow used to tokenize multiple cardholders within
the same microsecond, these cardholders will be assigned the same
customer_code.  In the unlikely event this does happen, the Bambora system
will decline to process cards for either of the profiles with a duplicate
customer_code.

=cut

sub generate_token {
  my $self = shift;
  my $time = Time::HiRes::time();

  $time =~ s/\D//g;
  $time = substr($time, 0, 14 ); # Eventually time() will contain 15 digits

  "99$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.

Could be extended to convert country names to their respective
country codes, or validate 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 B::OP 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};

  unless ( $expiration ) {
    $content->{expiry_month} = undef;
    $content->{expiry_year}  = undef;
    return;
  }

  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 parse_phone_number

Set value for field phone_number, from value in field phone

Bambora API expects only digits in a phone number. Strips all non-digit
characters

=cut

sub parse_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 parse_province

Set value for field province, from value in field state

Outside the US/Canada, API expect province set to the string "--",
otherwise expects a 2 character string.  Value for province is
formatted to upper case, and truncated to 2 characters.

=cut

sub parse_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, '' );
}

=head2 https_put { headers => \%headers }, post_body

Implement a limited interface of https_get from Net::HTTPS::Any
for PUT instead of POST -- only implementing current use case of
submitting a JSON request body

Todo: Properly implement https_put in Net::HTTPS::Any

=cut

sub https_put {
  my ( $self, $args, $post_body ) = @_;

  my $ua = LWP::UserAgent->new;

  my %headers = %{ $args->{headers} } if ref $args->{headers};
  for my $k ( keys %headers ) {
    $ua->default_header( $k => $headers{$k} );
  }

  my $url = $self->server().$self->path();
  my $res = $ua->put( $url, Content => $post_body );

  $self->build_subs(qw/ response_page response_code response_headers/);

  my @response_headers =
    map { $_ => $res->header( $_ ) }
    $res->header_field_names;

  $self->response_headers( {@response_headers} );
  $self->response_code( $res->code );
  $self->response_page( $res->decoded_content );

  ( $self->response_page, $self->response_code, @response_headers );
}

1;