File Coverage

blib/lib/WWW/BetterServers/API.pm

Criterion	Covered	Total	%
statement	30	72	41.6
branch	0	14	0.0
condition	0	31	0.0
subroutine	10	14	71.4
pod	3	3	100.0
total	43	134	32.0

package WWW::BetterServers::API;

use 5.010001;
use strict;
use warnings;
use POSIX 'strftime';
use Digest::SHA 'hmac_sha256_hex';
use Mojo::JSON;
use Mojo::URL;
use Mojo::UserAgent;
use Mojo::Util 'encode';
use Mojo::Base -base;

our $VERSION = '0.09';

has [qw(api_id api_secret auth_type api_host
        api_port api_scheme agent)];

sub new {
    my $class = shift;
    my $self  = {};
    bless $self, $class;

    my %args = @_;
    for my $key (qw(api_id api_secret auth_type api_host api_port api_scheme agent)) {
        $self->{$key} = $args{$key} if exists $args{$key};
    }

    $self->{api_host} ||= 'api.betterservers.com';
    $self->{agent}    ||= "WWW-BetterServers-API/$VERSION";

    $self->{_ua} = Mojo::UserAgent->new;
    $self->{_ua}->transactor->name($self->{agent});

    return $self;
}

sub ua {
    $_[0]->{_ua};
}

sub request {
    my $self = shift;
    my %args = @_;

    $args{host}      //= $self->{api_host};
    $args{api_id}    //= $self->{api_id};
    $args{secret}    //= $self->{api_secret};
    $args{auth_type} //= $self->{auth_type};
    $args{scheme}    //= $self->{api_scheme} // 'https';
    $args{port}      //= $self->{api_port};
    $args{date}      //= strftime("%a, %d %b %Y %T GMT", gmtime);
    $args{body}      //= ($args{payload} ? Mojo::JSON->new->encode($args{payload}) : '');

    $args{url} = Mojo::URL->new($args{uri});
    $args{url}->scheme($args{scheme});
    $args{url}->host($args{host});
    $args{url}->port($args{port}) if $args{port};

    my $req_str = join("\x0d\x0a",
                       encode('UTF-8', $args{method}),
                       encode('UTF-8', $args{host}),
                       encode('UTF-8', $args{date}),
                       encode('UTF-8', $args{url}->path),
                       $args{body});

    if ($ENV{BSAPI_AUTH_DEBUG}) {
        print STDERR "url:         " . $args{url}->path . "\n";
        print STDERR "signed url:  " . hmac_sha256_hex($args{url}->path, $args{secret}) . "\n";
        print STDERR "body:        " . $args{body} . "\n";
        print STDERR "signed body: " . hmac_sha256_hex($args{body}, $args{secret}) . "\n";
        print STDERR "url + body:  " . hmac_sha256_hex($args{url}->path . $args{body}, $args{secret}) . "\n";
        print STDERR "string:      " . $req_str . "\n";
        print STDERR "signature:   " . hmac_sha256_hex($req_str, $args{secret}) . "\n";
    }

    my $signature = sub { hmac_sha256_hex( $req_str,
                                           $args{secret} ) }->();

    my $headers = { Date => $args{date},
                    "Content-Type" => "application/json",
                    Authorization => "$args{auth_type} $args{api_id}:$signature" };

    my $sub = lc($args{method});

    ref($args{pre_hook}) eq 'CODE' && $args{pre_hook}->($self, \%args, $headers);

    my $tx = $self->ua->$sub($args{url}->to_string,
                             $headers,
                             $args{body},
                             (ref($args{callback}) eq 'CODE' ? $args{callback} : ()));

    return (ref($args{callback}) eq 'CODE' ? undef : $tx->res);
}

1;
__END__