File Coverage

blib/lib/Finance/Crypto/Exchange/Kraken.pm
Criterion Covered Total %
statement 45 62 72.5
branch 2 10 20.0
condition n/a
subroutine 13 16 81.2
pod 2 3 66.6
total 62 91 68.1


line stmt bran cond sub pod time code
1 3     3   975968 use utf8;
  3         966  
  3         22  
2              
3             package Finance::Crypto::Exchange::Kraken;
4             our $VERSION = '0.004';
5 3     3   2170 use Moose;
  3         1633023  
  3         27  
6 3     3   26453 use namespace::autoclean;
  3         27653  
  3         11  
7 3     3   2860 use LWP::UserAgent;
  3         138312  
  3         162  
8 3     3   1481 use MooseX::Types::URI qw(Uri);
  3         191170  
  3         16  
9 3     3   5703 use JSON qw(decode_json);
  3         17128  
  3         21  
10 3     3   409 use Try::Tiny;
  3         4  
  3         189  
11 3     3   833 use MIME::Base64 3.11 qw(decode_base64url);
  3         1274  
  3         170  
12 3     3   17 use Time::HiRes qw(gettimeofday);
  3         8  
  3         25  
13 3     3   1376 use Array::Utils 0.4 qw(array_minus);
  3         900  
  3         1948  
14              
15             # ABSTRACT: A Perl implementation of the Kraken REST API
16              
17             has ua => (
18             is => 'ro',
19             isa => 'LWP::UserAgent',
20             lazy => 1,
21             builder => '_build_ua',
22             );
23              
24             sub _build_ua {
25 1     1   2 my $self = shift;
26 1         15 my $ua = LWP::UserAgent->new(
27             agent => sprintf("%s/%s", __PACKAGE__, $VERSION),
28             timeout => 10,
29             protocols_allowed => ['https'],
30             max_redirect => 0,
31             ssl_opts => { verify_hostname => 1 },
32             );
33 1         4171 return $ua;
34             }
35              
36             has _uri => (
37             is => 'ro',
38             isa => Uri,
39             coerce => 1,
40             default => 'https://api.kraken.com',
41             init_arg => 'base_uri',
42             );
43              
44             has key => (
45             is => 'ro',
46             isa => 'Str',
47             predicate => 'has_key',
48             );
49              
50             has secret => (
51             is => 'ro',
52             isa => 'Str',
53             predicate => 'has_secret',
54             );
55              
56             has _nonce => (
57             is => 'ro',
58             isa => 'Str',
59             predicate => 'has_nonce',
60             init_arg => 'nonce'
61             );
62              
63             sub nonce {
64 0     0 1 0 my $self = shift;
65 0 0       0 return $self->_nonce if $self->has_nonce;
66 0         0 return gettimeofday() * 100000;
67             }
68              
69             sub call {
70 43     43 1 149 my ($self, $req) = @_;
71              
72 43         152 foreach (qw(Content-Type Content-Length)) {
73 86         1383 $req->headers->remove_header($_);
74             }
75              
76 43         867 $req->headers->header(Accept => 'application/json');
77              
78 43         4632 my $response = $self->ua->request($req);
79              
80 43 50       26409 if ($response->is_success) {
81 43         516 my $data;
82             try {
83 43     43   5122 $data = decode_json($response->decoded_content);
84             }
85             catch {
86 0     0   0 die "Unable to decode JSON from Kraken!", $/;
87 43         478 };
88              
89 43 50       7728 if (@{$data->{error}}) {
  43         196  
90 0 0       0 if (@{$data->{error}} > 1) {
  0         0  
91             die "Multiple errors occurred: " .
92 0         0 join($/, @{$data->{error}})
  0         0  
93             , $/;
94             }
95             else {
96 0         0 die $data->{error}[0], $/;
97             }
98             }
99 43         498 return $data->{result};
100             }
101 0           die "Error calling Kraken: " . $response->status_line, $/;
102              
103             }
104              
105             around 'BUILDARGS' => sub {
106             my ($orig, $class, %args) = @_;
107             if (my $secret = delete $args{secret}) {
108             $args{secret} = decode_base64url($secret);
109             }
110             return $class->$orig(%args);
111             };
112              
113             sub supported_methods {
114 0     0 0   my $self = shift;
115              
116 0           my @forbidden = qw(
117             call
118             meta
119             new
120             nonce
121             supported_methods
122             );
123 0           push(@forbidden, $self->meta->get_attribute_list);
124              
125 0 0         my @list = grep { $_ =~ /^[a-z]/ && $_ !~ /^has_/ }
  0            
126             $self->meta->get_method_list;
127 0           return sort { $a cmp $b } array_minus(@list, @forbidden);
  0            
128             }
129              
130              
131             with qw(
132             Finance::Crypto::Exchange::Kraken::REST::Public
133             Finance::Crypto::Exchange::Kraken::REST::Private
134             );
135              
136             __PACKAGE__->meta->make_immutable;
137              
138             __END__
139              
140             =pod
141              
142             =encoding UTF-8
143              
144             =head1 NAME
145              
146             Finance::Crypto::Exchange::Kraken - A Perl implementation of the Kraken REST API
147              
148             =head1 VERSION
149              
150             version 0.004
151              
152             =head1 SYNOPSIS
153              
154             package Foo;
155             use Finance::Crypto::Exchange::Kraken;
156              
157             my $kraken = Finance::Crypto::Exchange::Kraken->new(
158             key => 'your very secret key',
159             secret => 'your very secret secret',
160             );
161              
162             # For all methods, please visit the documentation
163             $kraken->get_server_time;
164              
165             =head1 DESCRIPTION
166              
167             Talk to the Kraken REST API within Perl
168              
169             =head1 METHODS
170              
171             =head2 call
172              
173             my $req = HTTP::Request->new(GET, ...);
174             $self->call($req);
175              
176             A very simple API call function.
177             Decodes the JSON for you on success, otherwise dies a horrible death with the
178             error Kraken gives back to you.
179              
180             You should not be needing this method, this function is public because all the
181             roles use it.
182              
183             =head2 nonce
184              
185             Create a nonce
186              
187             =head1 SEE ALSO
188              
189             =over
190              
191             =item L<Finance::Crypto::Exchange::Kraken::REST::Public>
192              
193             =item L<Finance::Crypto::Exchange::Kraken::REST::Private>
194              
195             =item L<Finance::Crypto::Exchange::Kraken::REST::Private::User::Data>
196              
197             =item L<Finance::Crypto::Exchange::Kraken::REST::Private::User::Trading>
198              
199             =item L<Finance::Crypto::Exchange::Kraken::REST::Private::User::Funding>
200              
201             =item L<Finance::Crypto::Exchange::Kraken::REST::Private::Websockets>
202              
203             =back
204              
205             There is another module that does more or less the same:
206             L<Finance::Bank::Kraken> but it requires a more hands on approach.
207              
208             =head1 AUTHOR
209              
210             Wesley Schwengle <waterkip@cpan.org>
211              
212             =head1 COPYRIGHT AND LICENSE
213              
214             This software is Copyright (c) 2020 by Wesley Schwengle.
215              
216             This is free software, licensed under:
217              
218             The (three-clause) BSD License
219              
220             =cut