view release on metacpan or  search on metacpan

lib/Finance/Crypto/Exchange/Kraken.pm  view on Meta::CPAN

sub _build_ua {
    my $self = shift;
    my $ua   = LWP::UserAgent->new(
        agent             => sprintf("%s/%s", __PACKAGE__, $VERSION),
        timeout           => 10,
        protocols_allowed => ['https'],
        max_redirect      => 0,
        ssl_opts          => { verify_hostname => 1 },
    );
    return $ua;
}

has _uri => (
    is       => 'ro',
    isa      => Uri,
    coerce   => 1,
    default  => 'https://api.kraken.com',
    init_arg => 'base_uri',
);

has key => (
    is       => 'ro',
    isa      => 'Str',
    predicate => 'has_key',
);

has secret => (
    is       => 'ro',
    isa      => 'Str',
    predicate => 'has_secret',
);

has _nonce => (
    is       => 'ro',
    isa      => 'Str',
    predicate => 'has_nonce',
    init_arg => 'nonce'
);

sub nonce {
    my $self = shift;
    return $self->_nonce if $self->has_nonce;
    return gettimeofday() * 100000;
}

sub call {
    my ($self, $req) = @_;

    foreach (qw(Content-Type Content-Length)) {
        $req->headers->remove_header($_);
    }

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

    my $response = $self->ua->request($req);

    if ($response->is_success) {
        my $data;
        try {
            $data = decode_json($response->decoded_content);
        }
        catch {
            die "Unable to decode JSON from Kraken!", $/;
        };

        if (@{$data->{error}}) {
            if (@{$data->{error}} > 1) {
                die "Multiple errors occurred: " .
                join($/, @{$data->{error}})
                , $/;
            }
            else {
                die $data->{error}[0], $/;
            }
        }
        return $data->{result};
    }
    die "Error calling Kraken: " . $response->status_line, $/;

}

around 'BUILDARGS' => sub {
    my ($orig, $class, %args) = @_;
    if (my $secret = delete $args{secret}) {
        $args{secret} = decode_base64url($secret);
    }
    return $class->$orig(%args);
};

sub supported_methods {
    my $self = shift;

    my @forbidden = qw(
        call
        meta
        new
        nonce
        supported_methods
    );
    push(@forbidden, $self->meta->get_attribute_list);

    my @list = grep { $_ =~ /^[a-z]/ && $_ !~ /^has_/ }
        $self->meta->get_method_list;
    return sort { $a cmp $b } array_minus(@list, @forbidden);
}


with qw(
    Finance::Crypto::Exchange::Kraken::REST::Public
    Finance::Crypto::Exchange::Kraken::REST::Private
);

__PACKAGE__->meta->make_immutable;

__END__

=pod

=encoding UTF-8