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   $self->serialize($batch); # that's all folks
 103 }
 104
 105 sub parse_response {
 106   my $self = shift;
 107   my $input = shift;
 108   my $batch = $self->deserialize($input);
 109 }
 110
 111 package Business::BatchPayment::CardFortress::Batch;
 112
 113 use Moose;
 114 extends 'Business::BatchPayment::Batch';
 115
 116 has 'gateway' => (
 117   is => 'rw',
 118   isa => 'Str',
 119 );
 120 has 'gateway_opts' => (
 121   is => 'rw',
 122   isa => 'HashRef',
 123 );
 124
 125 package Business::BatchPayment::CardFortress::Transport;
 126
 127 use Moose;
 128 use Moose::Util::TypeConstraints;
 129 extends 'Business::BatchPayment::Transport::HTTPS';
 130 with 'Business::BatchPayment::TestMode';
 131
 132 use File::Slurp;
 133 use MIME::Base64;
 134 use Crypt::OpenSSL::RSA;
 135
 136 has '+host' => (
 137   default => sub {
 138     my $self = shift;
 139     $self->test_mode ? 'gw.cardfortress.com'
 140                      : 'test.cardfortress.com'
 141   },
 142   lazy => 1,
 143 );
 144
 145 has ['login', 'password', 'private_key'] => (isa => 'Str', is => 'rw');
 146
 147 has 'serializer' => ( handles => [qw(serialize deserialize)] );
 148
 149 sub upload {
 150   my ($self, $content) = @_;
 151   warn "Sending batch...\n" if $self->debug;
 152   my ($page, $response, %reply_headers) =
 153     $self->https_post('/batch/submit', {
 154         login    => $self->login,
 155         password => $self->password,
 156         content  => $content,
 157     });
 158   $page = $self->deserialize($page);
 159   die $page->{error} if $page->{error};
 160   my $batchid = $page->{batchid};
 161
 162   my $private_key = read_file($self->private_key)
 163     or die "No private key available";
 164   my $rsa = Crypt::OpenSSL::RSA->new_private_key($private_key);
 165
 166   my %answers;
 167   foreach my $item (@{ $page->{items} }) {
 168     if ( $item->{error} ) {
 169       # We have no reliable way to report an error in a specific transaction
 170       # at this stage.  The server will send the error in the reply batch.
 171       # For now do nothing.
 172     } elsif ( $item->{challenge} ) {
 173       my $challenge = $item->{challenge};
 174       $answers{ $item->{tid} } = $rsa->decrypt( decode_base64($challenge) );
 175     } else {
 176       # newly created card--doesn't have a challenge, so do nothing
 177     }
 178   }
 179   # post the response
 180   warn "Answering cryptographic challenge...\n" if $self->debug;
 181   my $answer_content =
 182     $self->serialize({ batchid => $batchid, answers => \%answers });
 183   ($page, $response, %reply_headers) =
 184     $self->https_post('/batch/run', {
 185         login    => $self->login,
 186         password => $self->password,
 187         content  => $answer_content,
 188     });
 189   $page = $self->deserialize($page);
 190   die $page->{error} if $page->{error};
 191   return;
 192 }
 193
 194 =head1 AUTHOR
 195
 196 Mark Wells, C<< <mark at freeside.biz> >>
 197
 198 =head1 SUPPORT
 199
 200 You can find documentation for this module with the perldoc command.
 201
 202     perldoc Business::BatchPayment::CardFortress
 203
 204 Commercial support is available from Freeside Internet Services, Inc.
 205
 206 L<http://www.freeside.biz>
 207
 208 =head1 ACKNOWLEDGEMENTS
 209
 210 =head1 LICENSE AND COPYRIGHT
 211
 212 Copyright 2012 Mark Wells.
 213
 214 This program is free software; you can redistribute it and/or modify it
 215 under the terms of either: the GNU General Public License as published
 216 by the Free Software Foundation; or the Artistic License.
 217
 218 See http://dev.perl.org/licenses/ for more information.
 219
 220
 221 =cut
 222
 223 1; # End of Business::BatchPayment::Paymentech