File Coverage

blib/lib/WWW/Hetzner/Cloud/API/Servers.pm

Criterion	Covered	Total	%
statement	82	121	67.7
branch	33	86	38.3
condition	6	18	33.3
subroutine	19	28	67.8
pod	22	22	100.0
total	162	275	58.9

package WWW::Hetzner::Cloud::API::Servers;
# ABSTRACT: Hetzner Cloud Servers API

our $VERSION = '0.100';

use Moo;
use Carp qw(croak);
use WWW::Hetzner::Cloud::Server;
use namespace::clean;


has client => (
    is       => 'ro',
    required => 1,
    weak_ref => 1,
);

sub _wrap {
    my ($self, $data) = @_;
    return WWW::Hetzner::Cloud::Server->new(
        client => $self->client,
        %$data,
    );
}

sub _wrap_list {
    my ($self, $list) = @_;
    return [ map { $self->_wrap($_) } @$list ];
}


sub list {
    my ($self, %params) = @_;

    my $result = $self->client->get('/servers', params => \%params);
    return $self->_wrap_list($result->{servers} // []);
}


sub list_by_label {
    my ($self, $label_selector) = @_;
    return $self->list(label_selector => $label_selector);
}


sub get {
    my ($self, $id) = @_;
    croak "Server ID required" unless $id;

    my $result = $self->client->get("/servers/$id");
    return $self->_wrap($result->{server});
}


sub create {
    my ($self, %params) = @_;

    croak "name required" unless $params{name};
    croak "server_type required" unless $params{server_type};
    croak "image required" unless $params{image};

    my $body = {
        name        => $params{name},
        server_type => $params{server_type},
        image       => $params{image},
    };

    # Location/Datacenter (mutually exclusive)
    $body->{location}   = $params{location}   if $params{location};
    $body->{datacenter} = $params{datacenter} if $params{datacenter};

    # SSH Keys (array of names or IDs)
    $body->{ssh_keys} = $params{ssh_keys} if $params{ssh_keys};

    # Labels (hash)
    $body->{labels} = $params{labels} if $params{labels};

    # Cloud-init user data
    $body->{user_data} = $params{user_data} if $params{user_data};

    # Start server after create (default: true)
    $body->{start_after_create} = $params{start_after_create} // 1;

    # Placement group (ID or name)
    $body->{placement_group} = $params{placement_group} if $params{placement_group};

    # Networks (array of network IDs)
    $body->{networks} = $params{networks} if $params{networks};

    # Volumes (array of volume IDs)
    $body->{volumes} = $params{volumes} if $params{volumes};

    # Automount volumes
    $body->{automount} = $params{automount} if exists $params{automount};

    # Firewalls (array of firewall IDs)
    if ($params{firewalls}) {
        $body->{firewalls} = [
            map { { firewall => $_ } } @{$params{firewalls}}
        ];
    }

    # Public network configuration
    if ($params{public_net} || exists $params{enable_ipv4} || exists $params{enable_ipv6}) {
        $body->{public_net} = $params{public_net} // {};
        $body->{public_net}{enable_ipv4} = $params{enable_ipv4} if exists $params{enable_ipv4};
        $body->{public_net}{enable_ipv6} = $params{enable_ipv6} if exists $params{enable_ipv6};
        $body->{public_net}{ipv4} = $params{ipv4} if $params{ipv4};
        $body->{public_net}{ipv6} = $params{ipv6} if $params{ipv6};
    }

    my $result = $self->client->post('/servers', $body);
    return $self->_wrap($result->{server});
}


sub delete {
    my ($self, $id) = @_;
    croak "Server ID required" unless $id;

    return $self->client->delete("/servers/$id");
}


sub power_on {
    my ($self, $id) = @_;
    croak "Server ID required" unless $id;

    return $self->client->post("/servers/$id/actions/poweron", {});
}


sub power_off {
    my ($self, $id) = @_;
    croak "Server ID required" unless $id;

    return $self->client->post("/servers/$id/actions/poweroff", {});
}


sub reboot {
    my ($self, $id) = @_;
    croak "Server ID required" unless $id;

    return $self->client->post("/servers/$id/actions/reboot", {});
}


sub shutdown {
    my ($self, $id) = @_;
    croak "Server ID required" unless $id;

    return $self->client->post("/servers/$id/actions/shutdown", {});
}


sub rebuild {
    my ($self, $id, $image) = @_;
    croak "Server ID required" unless $id;
    croak "Image required" unless $image;

    return $self->client->post("/servers/$id/actions/rebuild", { image => $image });
}


sub change_type {
    my ($self, $id, $server_type, %opts) = @_;
    croak "Server ID required" unless $id;
    croak "Server type required" unless $server_type;

    return $self->client->post("/servers/$id/actions/change_type", {
        server_type     => $server_type,
        upgrade_disk    => $opts{upgrade_disk} // 1,
    });
}


sub reset {
    my ($self, $id) = @_;
    croak "Server ID required" unless $id;

    return $self->client->post("/servers/$id/actions/reset", {});
}


sub enable_rescue {
    my ($self, $id, %opts) = @_;
    croak "Server ID required" unless $id;

    my $body = { type => $opts{type} // 'linux64' };
    $body->{ssh_keys} = $opts{ssh_keys} if $opts{ssh_keys};

    return $self->client->post("/servers/$id/actions/enable_rescue", $body);
}


sub disable_rescue {
    my ($self, $id) = @_;
    croak "Server ID required" unless $id;

    return $self->client->post("/servers/$id/actions/disable_rescue", {});
}


sub request_console {
    my ($self, $id) = @_;
    croak "Server ID required" unless $id;

    return $self->client->post("/servers/$id/actions/request_console", {});
}


sub reset_password {
    my ($self, $id) = @_;
    croak "Server ID required" unless $id;

    return $self->client->post("/servers/$id/actions/reset_password", {});
}


sub attach_iso {
    my ($self, $id, $iso) = @_;
    croak "Server ID required" unless $id;
    croak "ISO required" unless $iso;

    return $self->client->post("/servers/$id/actions/attach_iso", { iso => $iso });
}


sub detach_iso {
    my ($self, $id) = @_;
    croak "Server ID required" unless $id;

    return $self->client->post("/servers/$id/actions/detach_iso", {});
}


sub enable_backup {
    my ($self, $id) = @_;
    croak "Server ID required" unless $id;

    return $self->client->post("/servers/$id/actions/enable_backup", {});
}


sub disable_backup {
    my ($self, $id) = @_;
    croak "Server ID required" unless $id;

    return $self->client->post("/servers/$id/actions/disable_backup", {});
}


sub update {
    my ($self, $id, %params) = @_;
    croak "Server ID required" unless $id;

    my $body = {};
    $body->{name}   = $params{name}   if exists $params{name};
    $body->{labels} = $params{labels} if exists $params{labels};

    my $result = $self->client->put("/servers/$id", $body);
    return $self->_wrap($result->{server});
}


sub wait_for_status {
    my ($self, $id, $status, $timeout) = @_;
    $timeout //= 120;

    my $start = time;
    while (time - $start < $timeout) {
        my $server = $self->get($id);
        return $server if $server->status eq $status;
        sleep 2;
    }

    croak "Timeout waiting for server $id to reach status '$status'";
}


1;

__END__