File Coverage

blib/lib/Net/Amazon/DirectConnect.pm

Criterion	Covered	Total	%
statement	27	88	30.6
branch	0	38	0.0
condition	0	2	0.0
subroutine	9	18	50.0
pod	6	6	100.0
total	42	152	27.6

package Net::Amazon::DirectConnect;

use 5.10.0;
use strict;
use warnings FATAL => 'all';

use Carp;
use JSON;
use YAML::Tiny;
use HTTP::Request;
use LWP::UserAgent;
use Net::Amazon::Signature::V4;

my $yaml = YAML::Tiny->read_string(do { local $/;  });
close(DATA);

=head1 NAME

Net::Amazon::DirectConnect - Perl interface to the Amazon DirectConnect API

=head1 VERSION

Version 0.12
DirectConnect API version 2012-10-25

=cut

our $VERSION = '0.12';

=head1 SYNOPSIS

    use Net::Amazon::DirectConnect;

    my $dc = Net::Amazon::DirectConnect->new(
        region => 'ap-southeast-2',
        access_key_id => 'access key',
        secret_key_id => 'secret key'
    );
    ...

=head1 SUBROUTINES/METHODS

=head2 new

    use Net::Amazon::DirectConnect;

    my $dc = Net::Amazon::DirectConnect->new(
        region => 'ap-southeast-2',
        access_key_id => 'access key',
        secret_key_id => 'secret key'
    );
    ...

=cut

sub new {
    my $self = bless {}, shift;
    return unless @_ % 2 == 0;

    my %args = @_;

    my %defaults = (
        region => 'us-west-1',
        access_key_id => $ENV{AWS_ACCESS_KEY_ID},
        secret_key_id => $ENV{AWS_SECRET_ACCESS_KEY},

        _ua => LWP::UserAgent->new(agent => __PACKAGE__ . '/' . $VERSION),
        _yaml => $yaml,
    );

    foreach (keys %defaults) {
        $self->{$_} = exists $args{$_} ? $args{$_} : $defaults{$_};
    }

    $self->{sig} = Net::Amazon::Signature::V4->new($self->{access_key_id}, $self->{secret_key_id}, $self->{region}, 'directconnect');

    return $self;
}

=head2 action

Perform action against the Amazon Direct Connect API. Actions are validated against an embedded copy of
DirectConnect-2012-10-25.yml for correctness before the call is made.

    # List connections
    my $connections = $dc->action('DescribeConnections');

    foreach my $dxcon (@{$connections->{connections}}) {
        say "$dxcon->{connectionId} -> $dxcon->{connectionName}";

        # List Virtual Interfaces
        my $virtual_interfaces = $dc->action('DescribeVirtualInterfaces', connectionId => $dxcon->{connectionId});
        foreach my $vif (@{$virtual_interfaces->{virtualInterfaces}}) {
            say "  $vif->{connectionId}";
        }
    }

=cut

sub action {
    my $self = shift;
    my $method = shift;
    return unless @_ % 2 == 0;
    my %args = @_;

    $self->_validate($method, \%args);

    my $response = $self->_request($method,
        content => encode_json \%args
    );

    return decode_json $response->content if $response->is_success;
}

=head2 ua

Get or set UserAgent object

    say ref($dc->ua);
    my $ua = my $lwp = LWP::UserAgent->new( ssl_opts => { verify_hostname => 0 } );
    $ua->proxy('https', 'http://127.0.0.1:8080');
    $dc->ua($ua);

=cut

sub ua {
    ( ref $_[1] ) ? shift->{_ua} = $_[1] : shift->{_ua};
}

=head2 spec

Get or set YAML::Tiny object

    say ref($dc->spec);
    $dc->spec(YAML::Tiny->read('new-spec.yml'));

=cut

sub spec {
    ( ref $_[1] ) ? shift->{_yaml} = $_[1] : shift->{_yaml}->[0];
}

=head2 region

Get or set AWS region

    $dc->region('ap-southeast-2');
    say $dc->region;

=cut

sub region {
    my $self = shift;

    if (exists $_[0]) {
        $self->{region} = shift;
        $self->{sig} = Net::Amazon::Signature::V4->new($self->{access_key_id}, $self->{secret_key_id}, $self->{region}, 'directconnect');
    }

    return $self->{region};
}

=head2 credentials

Set AWS credentials

    $dc->credentials(
        access_key_id => 'MY_ACCESS_KEY',
        secret_key_id => 'MY_SECRET_KEY'
    );

=cut

sub credentials {
    my $self = shift;

    return unless @_ % 2 == 0;
    my %args = @_;

    foreach (qw(access_key_id secret_key_id)) {
        $self->{$_} = $args{$_};
    }

    return 1;
}

=head1 Internal subroutines

=head2 _request

Build and sign HTTP::Request object, return if successful or croak if error

=cut

sub _request {
    my $self = shift;
    my $operation = shift;
    return unless @_ % 2 == 0;
    my %args = @_;

    croak __PACKAGE__ . '->_request: Missing operation' unless $operation;
    croak __PACKAGE__ . '->_request: Invalid or empty region' unless $self->{region};

    my $host = sprintf 'directconnect.%s.amazonaws.com/', $self->{region};
    my $headers = [
        Version => $self->spec->{api_version},
        Host => $host,
        Date => POSIX::strftime( '%Y%m%dT%H%M%SZ', gmtime ),
        'Content-Type' => 'application/x-amz-json-1.1',
        'X-Amz-Target' => $self->spec->{target_prefix} . $operation,
        exists $args{headers} ? @{$args{headers}} : ()
    ];

    my $req = HTTP::Request->new(POST => "https://$host", $headers);
    $req->content($args{content}) if exists $args{content};

    $req = $self->{sig}->sign($req);

    my $response = $self->ua->request($req);
    croak __PACKAGE__ . sprintf('->_request: %s %s', decode_json($response->content)->{__type}, decode_json($response->content)->{message} || '') unless $response->is_success;

    return $response;
}

=head2 _validate

Validate the method and required arguments against the current version of the Direct Connect API (2012-10-25)

=cut

sub _validate {
    my $self = shift;
    my $method = shift;
    my $args = shift;

    my ($spec) = grep { $_->{name} eq $method } @{$self->spec->{operations}};
    return unless ref $spec;

    local *check_yaml = sub {
        my $s = shift;
        my $o = shift;

        foreach (keys %$s) {
            if (grep /^required$/, @{$s->{$_}}) {
                croak __PACKAGE__ . ": $method called without required field ($_)" unless exists $o->{$_};
            }

            if (ref $s->{$_}->[0] eq 'HASH') {
                return unless check_yaml($s->{$_}->[0]->{structure}, $o->{$_});
            }
        }

        return 1;
    };

    return check_yaml($spec->{inputs}, $args);
}

=head1 AUTHOR

Cameron Daniel, C<<  >>

=head1 SUPPORT

You can find documentation for this module with the perldoc command or at https://github.com/megaport/p5-net-amazon-directconnect/

    perldoc Net::Amazon::DirectConnect

=cut

1;

__DATA__