CardFortress.pm

   1 package Business::BatchPayment::CardFortress;
   2
   3 use 5.006;
   4 use strict;
   5 use warnings;
   6 our $VERSION = '0.01';
   7
   8 =head1 NAME
   9
  10 Business::BatchPayment::CardFortress
  11
  12 =head1 DESCRIPTION
  13
  14 Batch payment processing via the CardFortress secure payment proxy service.
  15
  16 =head1 USAGE
  17
  18 See Business::BatchPayment for general usage information.
  19
  20 =head2 PROCESSOR ATTRIBUTES
  21
  22 =over 4
  23
  24 =item login, password
  25
  26 Your login credentials for CardFortress.
  27
  28 =item gateway
  29
  30 The L<Business::BatchPayment> module to use for upstream processing.  You
  31 don't need to have this module installed, but the proxy server does.
  32
  33 =item gateway_*
  34
  35 Processor options to pass along to the gateway module.  The 'gateway_' prefix
  36 will be stripped.
  37
  38 =back
  39
  40 =cut
  41
  42 use Business::BatchPayment;
  43 use Moose;
  44 with 'Business::BatchPayment::Processor';
  45 with 'Business::BatchPayment::TestMode';
  46 with 'Business::BatchPayment::Debug';
  47
  48 use Data::Serializer;
  49
  50 has [ qw(login password private_key gateway) ] => (
  51   is  => 'ro',
  52   isa => 'Str',
  53   required => 1,
  54 );
  55
  56 has 'gateway_opts' => (
  57   is => 'ro',
  58   isa => 'HashRef',
  59   default => sub { {login => ''} },
  60 );
  61
  62 has 'serializer' => (
  63   is => 'ro',
  64   lazy => 1,
  65   handles => [qw(serialize deserialize)],
  66   default => sub {
  67 # doesn't have to be Storable, but it must support blessed objects
  68     Data::Serializer->new(serializer => 'Storable', encoding => 'b64')
  69   },
  70 );
  71
  72 # pull any arg named "gateway_foo" into gateway_opts
  73 around 'BUILDARGS' => sub {
  74   my ($orig, $class, %args) = @_;
  75   foreach (keys %args) {
  76     if (/^gateway_(.*)/) {
  77       $args{'gateway_opts'}->{$1} = delete $args{$_};
  78     }
  79   }
  80   $class->$orig(%args);
  81 };
  82
  83 sub default_transport {
  84   my $self = shift;
  85   Business::BatchPayment->create('CardFortress::Transport',
  86     login       => $self->login,
  87     password    => $self->password,
  88     debug       => $self->debug,
  89     test_mode   => $self->test_mode,
  90     private_key => $self->private_key,
  91     serializer  => $self->serializer,
  92   );
  93 }
  94
  95 sub format_request {
  96   my $self = shift;
  97   my $batch = shift;
  98   bless $batch, 'Business::BatchPayment::CardFortress::Batch';
  99   # things that get encoded in the batch:
 100   $batch->gateway($self->gateway);
 101   $batch->gateway_opts($self->gateway_opts);
 102   $batch;
 103 }
 104
 105 sub parse_response {
 106   my $self = shift;
 107   my $input = shift;
 108 }
 109
 110 package Business::BatchPayment::CardFortress::Batch;
 111
 112 use Moose;
 113 extends 'Business::BatchPayment::Batch';
 114
 115 has 'gateway' => (
 116   is => 'rw',
 117   isa => 'Str',
 118 );
 119 has 'gateway_opts' => (
 120   is => 'rw',
 121   isa => 'HashRef',
 122 );
 123
 124 package Business::BatchPayment::CardFortress::Transport;
 125
 126 use Moose;
 127 use Moose::Util::TypeConstraints;
 128 extends 'Business::BatchPayment::Transport::HTTPS';
 129 with 'Business::BatchPayment::TestMode';
 130
 131 use File::Slurp;
 132 use Data::Dumper;
 133 use Try::Tiny;
 134 use MIME::Base64;
 135 use Crypt::OpenSSL::RSA;
 136
 137 local $Data::Dumper::Useqq = 1; # because encryption keys will be unprintable
 138
 139 has '+host' => (
 140   default => sub {
 141     my $self = shift;
 142     $self->test_mode ? 'test.cardfortress.com'
 143                      : 'gw.cardfortress.com'
 144   },
 145   lazy => 1,
 146 );
 147
 148 has ['login', 'password', 'private_key'] => (isa => 'Str', is => 'rw');
 149
 150 has 'serializer' => ( handles => [qw(serialize deserialize)] );
 151
 152 sub https_post {
 153   # simplify this a little
 154   my ($self, $path, $args) = @_;
 155   warn "Sending to $path\n" if $self->debug;
 156   $args ||= {};
 157   warn Dumper($args)."\n\n" if $self->debug >= 2;
 158   $args = {
 159     content   => $self->serialize($args),
 160     login     => $self->login,
 161     password  => $self->password
 162   };
 163   my ($page, $response, %reply_headers) = Net::HTTPS::Any::https_post(
 164     host => $self->host,
 165     port => $self->port,
 166     path => $path,
 167     args => $args,
 168     debug => 0,
 169   );
 170   die "Bad response from server: $response\n" if $response !~ /^200/;
 171   warn "$response\n" if $self->debug;
 172   my ($result, $error);
 173   try {
 174     $result = $self->deserialize($page);
 175   } catch {
 176     # Storable error messages are useless.
 177     $error = "Bad data from server:\n$page\n";
 178   };
 179   warn Dumper($result)."\n\n" if $self->debug >= 2;
 180   $error ||= $result->{error} if ref $result eq 'HASH';
 181   die "$error\n" if $error;
 182
 183   $result;
 184 };
 185
 186 sub upload {
 187   my ($self, $content) = @_;
 188   warn "Sending batch...\n" if $self->debug;
 189   my $result = $self->https_post('/batch/submit', $content);
 190   die $result->{error} if $result->{error};
 191
 192   my $batch_id = $result->{batch_id};
 193   my $private_key = read_file($self->private_key)
 194     or die "No private key available";
 195   my $rsa = Crypt::OpenSSL::RSA->new_private_key($private_key);
 196
 197   my %answers;
 198   foreach my $item (@{ $result->{items} }) {
 199     if ( $item->{error} ) {
 200       # We have no reliable way to report an error in a specific transaction
 201       # at this stage.  The server will send the error in the reply batch.
 202       # For now do nothing.
 203     } elsif ( $item->{challenge} ) {
 204       my $challenge = $item->{challenge};
 205       $answers{ $item->{tid} } = $rsa->decrypt($challenge);
 206     }
 207   }
 208   # post the response
 209   warn "Answering cryptographic challenge...\n" if $self->debug;
 210   $self->https_post('/batch/run', { batch_id => $batch_id, answers => \%answers});
 211 }
 212
 213 sub download {
 214   my $self = shift;
 215   warn "Fetching batch index...\n" if $self->debug;
 216   my $result = $self->https_post('/batch/status');
 217
 218   my @batches_in_transit;
 219   foreach (@{ $result->{batches} }) {
 220     if ( $_->{status} eq 'received' ) {
 221       push @batches_in_transit, $_->{batch_id};
 222     }
 223   }
 224   return if scalar(@batches_in_transit) == 0;
 225   $result = $self->https_post('/batch/receive',
 226                               { batch_id => \@batches_in_transit });
 227   # this shouldn't contain errors, since the server just told us
 228   # that the batches exist...
 229   foreach (@$result) {
 230     if ( $_->{error} ) {
 231       die "Error receiving batch: ".$_->{error}."\n";
 232     }
 233   }
 234   $self->https_post('/batch/close', \@batches_in_transit);
 235   @$result;
 236 }
 237
 238 =head1 AUTHOR
 239
 240 Mark Wells, C<< <mark at freeside.biz> >>
 241
 242 =head1 SUPPORT
 243
 244 You can find documentation for this module with the perldoc command.
 245
 246     perldoc Business::BatchPayment::CardFortress
 247
 248 For information about the CardFortress system, contact Freeside Internet
 249 Services, Inc.
 250
 251 L<http://www.freeside.biz>
 252
 253 =head1 ACKNOWLEDGEMENTS
 254
 255 =head1 LICENSE AND COPYRIGHT
 256
 257 Copyright 2013 Mark Wells.
 258
 259 This program is free software; you can redistribute it and/or modify it
 260 under the terms of either: the GNU General Public License as published
 261 by the Free Software Foundation; or the Artistic License.
 262
 263 See http://dev.perl.org/licenses/ for more information.
 264
 265
 266 =cut
 267
 268 1; # End of Business::BatchPayment::Paymentech