path: root/CardFortress.pm

package Business::BatchPayment::CardFortress;

use 5.006;
use strict;
use warnings;
our $VERSION = '0.01';

=head1 NAME

Business::BatchPayment::CardFortress

=head1 DESCRIPTION

Batch payment processing via the CardFortress secure payment proxy service.

=head1 USAGE

See Business::BatchPayment for general usage information.

=head2 PROCESSOR ATTRIBUTES

=over 4

=item login, password

Your login credentials for CardFortress.

=item gateway

The L<Business::BatchPayment> module to use for upstream processing.  You 
don't need to have this module installed, but the proxy server does.

=item gateway_*

Processor options to pass along to the gateway module.  The 'gateway_' prefix
will be stripped.

=back

=cut

use Business::BatchPayment;
use Moose;
with 'Business::BatchPayment::Processor';
with 'Business::BatchPayment::TestMode';
with 'Business::BatchPayment::Debug';

use Data::Serializer;

has [ qw(login password private_key gateway) ] => (
  is  => 'ro',
  isa => 'Str',
  required => 1,
);

has 'gateway_opts' => (
  is => 'ro',
  isa => 'HashRef',
  default => sub { {login => ''} },
);

has 'serializer' => (
  is => 'ro',
  lazy => 1,
  handles => [qw(serialize deserialize)],
  default => sub {
# doesn't have to be Storable, but it must support blessed objects
    Data::Serializer->new(serializer => 'Storable', encoding => 'b64') 
  },
);

# pull any arg named "gateway_foo" into gateway_opts
around 'BUILDARGS' => sub {
  my ($orig, $class, %args) = @_;
  foreach (keys %args) {
    if (/^gateway_(.*)/) {
      $args{'gateway_opts'}->{$1} = delete $args{$_};
    }
  }
  $class->$orig(%args);
};

sub default_transport {
  my $self = shift;
  Business::BatchPayment->create('CardFortress::Transport',
    login       => $self->login,
    password    => $self->password,
    debug       => $self->debug,
    test_mode   => $self->test_mode,
    private_key => $self->private_key,
    serializer  => $self->serializer,
  );
}

sub format_request {
  my $self = shift;
  my $batch = shift;
  bless $batch, 'Business::BatchPayment::CardFortress::Batch';
  # things that get encoded in the batch:
  $batch->gateway($self->gateway);
  $batch->gateway_opts($self->gateway_opts);
  $batch;
}

sub parse_response {
  my $self = shift;
  my $input = shift;
}

package Business::BatchPayment::CardFortress::Batch;

use Moose;
extends 'Business::BatchPayment::Batch';

has 'gateway' => (
  is => 'rw',
  isa => 'Str',
);
has 'gateway_opts' => (
  is => 'rw',
  isa => 'HashRef',
);

package Business::BatchPayment::CardFortress::Transport;

use Moose;
use Moose::Util::TypeConstraints;
extends 'Business::BatchPayment::Transport::HTTPS';
with 'Business::BatchPayment::TestMode';

use File::Slurp;
use Data::Dumper;
use Try::Tiny;
use MIME::Base64;
use Crypt::OpenSSL::RSA;

local $Data::Dumper::Useqq = 1; # because encryption keys will be unprintable

has '+host' => (
  default => sub { 
    my $self = shift;
    $self->test_mode ? 'test.cardfortress.com'
                     : 'gw.cardfortress.com'
  },
  lazy => 1,
);

has ['login', 'password', 'private_key'] => (isa => 'Str', is => 'rw');

has 'serializer' => ( handles => [qw(serialize deserialize)] );

sub https_post {
  # simplify this a little
  my ($self, $path, $args) = @_;
  warn "Sending to $path\n" if $self->debug;
  $args ||= {};
  warn Dumper($args)."\n\n" if $self->debug >= 2;
  $args = {
    content   => $self->serialize($args),
    login     => $self->login,
    password  => $self->password
  };
  my ($page, $response, %reply_headers) = Net::HTTPS::Any::https_post(
    host => $self->host,
    port => $self->port,
    path => $path,
    args => $args,
    debug => 0,
  );
  die "Bad response from server: $response\n" if $response !~ /^200/;
  warn "$response\n" if $self->debug;
  my ($result, $error);
  try {
    $result = $self->deserialize($page);
  } catch {
    # Storable error messages are useless.
    $error = "Bad data from server:\n$page\n";
  };
  warn Dumper($result)."\n\n" if $self->debug >= 2;
  $error ||= $result->{error} if ref $result eq 'HASH';
  die "$error\n" if $error;

  $result;
};

sub upload {
  my ($self, $content) = @_;
  warn "Sending batch...\n" if $self->debug;
  my $result = $self->https_post('/batch/submit', $content);
  die $result->{error} if $result->{error};

  my $batch_id = $result->{batch_id};
  my $private_key = read_file($self->private_key)
    or die "No private key available";
  my $rsa = Crypt::OpenSSL::RSA->new_private_key($private_key);

  my %answers;
  foreach my $item (@{ $result->{items} }) {
    if ( $item->{error} ) {
      # We have no reliable way to report an error in a specific transaction 
      # at this stage.  The server will send the error in the reply batch.
      # For now do nothing.
    } elsif ( $item->{challenge} ) {
      my $challenge = $item->{challenge};
      $answers{ $item->{tid} } = $rsa->decrypt($challenge);
    }
  }
  # post the response
  warn "Answering cryptographic challenge...\n" if $self->debug;
  $self->https_post('/batch/run', { batch_id => $batch_id, answers => \%answers});
}

sub download {
  my $self = shift;
  warn "Fetching batch index...\n" if $self->debug;
  my $result = $self->https_post('/batch/status');

  my @batches_in_transit;
  foreach (@{ $result->{batches} }) {
    if ( $_->{status} eq 'received' ) {
      push @batches_in_transit, $_->{batch_id};
    }
  }
  return if scalar(@batches_in_transit) == 0;
  $result = $self->https_post('/batch/receive',
                              { batch_id => \@batches_in_transit });
  # this shouldn't contain errors, since the server just told us 
  # that the batches exist...
  foreach (@$result) {
    if ( $_->{error} ) {
      die "Error receiving batch: ".$_->{error}."\n";
    }
  }
  $self->https_post('/batch/close', \@batches_in_transit);
  @$result;
}

=head1 AUTHOR

Mark Wells, C<< <mark at freeside.biz> >>

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Business::BatchPayment::CardFortress

For information about the CardFortress system, contact Freeside Internet
Services, Inc.

L<http://www.freeside.biz>

=head1 ACKNOWLEDGEMENTS

=head1 LICENSE AND COPYRIGHT

Copyright 2013 Mark Wells.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.


=cut

1; # End of Business::BatchPayment::Paymentech