File Coverage

blib/lib/Finance/CaVirtex/API.pm

Criterion	Covered	Total	%
statement	165	205	80.4
branch	10	30	33.3
condition	5	12	41.6
subroutine	53	65	81.5
pod	5	34	14.7
total	238	346	68.7

package Finance::CaVirtex::API;

use 5.014002;
use strict;
use warnings;

our $VERSION = '0.03';

use base qw(Finance::CaVirtex::API::DefaultPackage);

use constant DEBUG => 0;

# you can use a lower version, but then you are responsible for SSL cert verification code...
use LWP::UserAgent 6;
use URI;
use CGI;
use JSON;
use MIME::Base64;
use Time::HiRes qw(gettimeofday);
use Digest::SHA qw(hmac_sha256_hex);
use Data::Dumper;

use Finance::CaVirtex::API::Request::OrderBook;
use Finance::CaVirtex::API::Request::TradeBook;
use Finance::CaVirtex::API::Request::Ticker;
use Finance::CaVirtex::API::Request::Balance;
use Finance::CaVirtex::API::Request::Transactions;
use Finance::CaVirtex::API::Request::TradeHistory;
use Finance::CaVirtex::API::Request::OrderHistory;
use Finance::CaVirtex::API::Request::Order;
use Finance::CaVirtex::API::Request::OrderCancel;
use Finance::CaVirtex::API::Request::Withdraw;

use constant COMPANY              => 'CaVirtex';
use constant ERROR_NO_REQUEST     => 'No request object to send';
use constant ERROR_NOT_READY      => 'Not enough information to send a %s request';
use constant ERROR_IS_IT_READY    => "The request is%s READY to send\n";
use constant ERROR_CAVIRTEX       => COMPANY . " error: '%s'\n";
use constant ERROR_UNKNOWN_STATUS => COMPANY . " returned an unknown status\n";

use constant ATTRIBUTES => qw(token secret);

use constant CLASS_ACTION_MAP => {
   orderbook     => 'Finance::CaVirtex::API::Request::OrderBook',
   tradebook     => 'Finance::CaVirtex::API::Request::TradeBook',
   ticker        => 'Finance::CaVirtex::API::Request::Ticker',
   balance       => 'Finance::CaVirtex::API::Request::Balance',
   transactions  => 'Finance::CaVirtex::API::Request::Transactions',
   trade_history => 'Finance::CaVirtex::API::Request::TradeHistory',
   order_history => 'Finance::CaVirtex::API::Request::OrderHistory',
   order         => 'Finance::CaVirtex::API::Request::Order',
   order_cancel  => 'Finance::CaVirtex::API::Request::OrderCancel',
   withdraw      => 'Finance::CaVirtex::API::Request::Withdraw',
};

sub is_ready_to_send {
    my $self = shift;
    my $ready = 0;
    # here we are checking whether or not to default to '0' (not ready to send) based on this objects settings.
    # the settings in here are the token and the secret provided to you by CaVirtex.
    # if we dont have to add a nonce, then just check if its ready...
    if (not $self->private or defined $self->token && defined $self->secret) {
       $ready = $self->request->is_ready_to_send;
    }
    warn sprintf ERROR_IS_IT_READY, ($ready ? '' : ' NOT') if DEBUG;

    return $ready;
}

sub send {
    my $self = shift;

    # clear any previous response values... because if you wan it, you shoulda put a variable on it.
    $self->response(undef);
    $self->error(undef);
    $self->new_nonce;

    unless ($self->request) {
        $self->error({
            type    => __PACKAGE__,
            message => ERROR_NO_REQUEST,
        });
    }
    else {
        # validate that the minimum required request attributes are set here.
        if (not $self->is_ready_to_send) {
             $self->error({
                 type    => __PACKAGE__,
                 message => sprintf(ERROR_NOT_READY, ref $self->request),
             });
        }
        else {
            # make sure we have an request to send...
            my $request = $self->http_request(HTTP::Request->new);
            $request->method($self->request->request_type);
            $request->uri($self->request->url);
            my %query_form = %{$self->request_content};
#
# This block will be removed once we have basic testing completed.
# ...because printing these variables on a live system is not a good idea...
#
#if ($self->private) {
#    print Data::Dumper->Dump([\%query_form],['Query Form']);
#    printf "sorted request values: %s\n", join(', ', $self->sorted_request_values);
#    printf "Nonce: %s\n", $self->nonce;
#    printf "Token: %s\n", $self->token;
#    printf "Path: %s\n", $self->path;
#}
#
            if ($self->private) {
                $query_form{nonce    } = $self->nonce;
                $query_form{token    } = $self->token;
                $query_form{signature} = $self->signature;
            }

            my $uri = URI->new;
            $uri->query_form(%query_form);
            if ($self->request->request_type eq 'POST') {
                $request->content($uri->query);
                $request->content_type($self->request->content_type);
            }
            elsif ($self->request->request_type eq 'GET' and $uri->query) {
                $request->uri($request->uri . '?' . $uri->query);
            }

            $request->header(Accept => 'application/json');

            # create a new user_agent each time...
            $self->user_agent(LWP::UserAgent->new);
            $self->user_agent->agent('Mozilla/8.0');
            $self->user_agent->ssl_opts(verify_hostname => 1);

            warn Data::Dumper->Dump([$self->user_agent, $request],[qw(UserAgent Request)]) if DEBUG;

            $self->http_response($self->user_agent->request($request));
            $self->process_response;
        }
    }
    return $self->is_success;
}

sub process_response {
    my $self = shift;

    warn sprintf "Content: %s\n", $self->http_response->content if DEBUG;

    my $content;
    eval {
        warn Data::Dumper->Dump([$self->http_response],['Response']) if DEBUG;
        $content = $self->json->decode($self->http_response->content);
        1;
    } or do {
        $content = {};
        warn "error: $@\n";
    };
    if (exists $content->{status}) {
        if (lc $content->{status} eq 'ok') {
            $self->apirate($content->{apirate}) if exists $content->{apirate};
            if ($self->request->data_key) {
                # crutch: there is a call to tradebook that returns the json data keyed on either
                # 'orders' or 'trades'. As a result we have to allow this to be a hash or potential
                # keys to search.
                # once this is standardized on Cavirtex, we will remove these conditions...
                #
                # TODO: watch for such a change and then reduce the code below and change Request/TrasdeBook.pm
                if (ref $self->request->data_key) {
                    foreach my $key (@{$self->request->data_key}) {
                        if (exists $content->{$key}) {
                            $self->response($content->{$key});
                            last;
                        }
                    }
                }
                # end crutch, but also, remove the 'else' below...
                else {
                    $self->response($content->{$self->request->data_key});
                }
            }
            else {
                $self->response($content);
            }
        }
        elsif ($content->{status} eq 'error') {
            warn sprintf ERROR_CAVIRTEX, Dumper $content->{message} if DEBUG;
            $self->error($content->{message});
        }
        else {
            # we got a response but the result was not 'success' and did not contain an 'error' key...
            # note: your code should never get here, so I am forcing a warning and Dump of the content...
            warn ERROR_UNKNOWN_STATUS;
            warn Data::Dumper->Dump([$content],[sprintf 'Invalid %s Response Content', COMPANY]);
            $self->error('unknown status');
        }
    }
    else {
        # we did not get valid content from their server. Assume an unknown HTTP error occurred...
        $self->error({
            type    => __PACKAGE__,
            message => 'no status',
        });
    }
    return $self->is_success;
}


# the code below is only here to explain the code above
sub sorted_request_values { @{$_[0]->request_content}{sort {lc($a) cmp lc($b)} keys $_[0]->request_content} }
#sub sorted_request_values {
    #my $self = shift;
    #my %content = %{$self->request_content};
    #return @content{sort {lc($a) cmp lc($b)} keys %content};
#}

# signature : is a HMAC-SHA256 Hex encoded hash containing the string data input:
# nonce, API token, relative API, request path and alphabetically sorted post parameters.
# The message must be generated using the Secret Key that was created with your API token.
#sub signature { hmac_sha256_hex(map($_[0]->$_, qw(nonce token path sorted_request_values secret))) }
sub signature {
    my $self = shift;
    return hmac_sha256_hex($self->nonce, $self->token, $self->path, $self->sorted_request_values, $self->secret);
}

sub new_nonce       { shift->nonce(sprintf '%d%06d' => gettimeofday) }
sub path            { URI->new(shift->http_request->uri)->path       }
sub request_content { shift->request->request_content                }
sub json            { shift->{json} ||= JSON->new                    }
sub private         { shift->request->is_private                     }
sub is_success      { defined shift->response                        }
sub public          { not shift->private                             }
sub attributes      { ATTRIBUTES                                     }

# this method makes the action call routines simpler...
sub class_action {
    my $self = shift;
    my $class = CLASS_ACTION_MAP->{((caller(1))[3] =~ /::(\w+)$/)[0]};
    $self->request($class->new(@_));
    return $self->send ? $self->response : undef;
}

sub orderbook     { class_action(@_) }
sub tradebook     { class_action(@_) }
sub ticker        { class_action(@_) }
sub balance       { class_action(@_) }
sub transactions  { class_action(@_) }
sub trade_history { class_action(@_) }
sub order_history { class_action(@_) }
sub order         { class_action(@_) }
sub order_cancel  { class_action(@_) }
sub withdraw      { class_action(@_) }

sub token         { my $self = shift; $self->get_set(@_) }
sub secret        { my $self = shift; $self->get_set(@_) }
sub nonce         { my $self = shift; $self->get_set(@_) }
sub error         { my $self = shift; $self->get_set(@_) }
sub http_response { my $self = shift; $self->get_set(@_) }
sub request       { my $self = shift; $self->get_set(@_) }
sub response      { my $self = shift; $self->get_set(@_) }
sub http_request  { my $self = shift; $self->get_set(@_) }
sub user_agent    { my $self = shift; $self->get_set(@_) }
sub apirate       { my $self = shift; $self->get_set(@_) }

1;

__END__