Something went wrong. Try again.
Perl game server for TLE Community
Something went wrong. Try again.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159package Lacuna::Web::TestSetup;
# Dev-only HTTP faces for Lacuna::TestSetup, mounted at /test by bin/lacuna.psgi# only when $ENV{LACUNA_TEST_SETUP_API} is set (see docker-compose.yml -- never# in docker-compose.deployed.yml). Lets the lightweight t/TestClient.pm run test# setup/teardown without `use Lacuna` compiling the whole app per test file.
use Moose;use utf8;no warnings qw(uninitialized);extends qw(Lacuna::Web);use JSON qw(encode_json decode_json);
sub _guard { confess [403, 'Test setup endpoints are disabled (LACUNA_TEST_SETUP_API unset).'] unless $ENV{LACUNA_TEST_SETUP_API};}
# Read args from a JSON request body, falling back to form/query params.sub _args { my ($self, $request) = @_; my $content = $request->content; if (defined $content && length $content) { my $decoded = eval { decode_json($content) }; confess [400, "Invalid JSON body: $@"] if $@; confess [400, 'JSON body must be an object'] unless ref $decoded eq 'HASH'; return $decoded; } my %params; for my $key ($request->parameters->keys) { $params{$key} = $request->parameters->get($key); } return \%params;}
sub _json { my ($self, $data) = @_; return [ encode_json($data), { content_type => 'application/json' } ];}
sub www_default { my ($self, $request) = @_; $self->_guard; return $self->_json({ ok => 1, endpoints => [ qw( generate_empire use_existing_empire build_infrastructure build_big_colony build_building finish_building finish_ships set_body_resources prime_captcha clear_empires ) ], });}
sub www_generate_empire { my ($self, $request) = @_; $self->_guard; my $args = $self->_args($request); return $self->_json(Lacuna::TestSetup::generate_empire( name => $args->{name}, password => $args->{password}, ));}
sub www_use_existing_empire { my ($self, $request) = @_; $self->_guard; my $args = $self->_args($request); return $self->_json(Lacuna::TestSetup::use_existing_empire( name => $args->{name}, password => $args->{password}, ));}
sub www_build_infrastructure { my ($self, $request) = @_; $self->_guard; my $args = $self->_args($request); return $self->_json(Lacuna::TestSetup::build_infrastructure( empire_id => $args->{empire_id}, big_producer => $args->{big_producer}, ));}
sub www_build_big_colony { my ($self, $request) = @_; $self->_guard; my $args = $self->_args($request); return $self->_json(Lacuna::TestSetup::build_big_colony( empire_id => $args->{empire_id}, planet_id => $args->{planet_id}, ));}
sub www_build_building { my ($self, $request) = @_; $self->_guard; my $args = $self->_args($request); return $self->_json(Lacuna::TestSetup::build_building( empire_id => $args->{empire_id}, planet_id => $args->{planet_id}, class => $args->{class}, level => $args->{level}, x => $args->{x}, y => $args->{y}, ));}
sub www_finish_building { my ($self, $request) = @_; $self->_guard; my $args = $self->_args($request); return $self->_json(Lacuna::TestSetup::finish_building( building_id => $args->{building_id}, planet_id => $args->{planet_id}, ));}
sub www_finish_ships { my ($self, $request) = @_; $self->_guard; my $args = $self->_args($request); return $self->_json(Lacuna::TestSetup::finish_ships( shipyard_id => $args->{shipyard_id}, ));}
sub www_set_body_resources { my ($self, $request) = @_; $self->_guard; my $args = $self->_args($request); return $self->_json(Lacuna::TestSetup::set_body_resources(%$args));}
# Mirrors the inline `Lacuna->cache->set('captcha'/'create_empire_captcha', ...)`# calls tests make before create/spy flows.sub www_prime_captcha { my ($self, $request) = @_; $self->_guard; my $args = $self->_args($request); my $ttl = 60 * 15; if ($args->{session_id}) { Lacuna->cache->set('captcha', $args->{session_id}, { guid => 1111, solution => 1111 }, $ttl); } for my $ip ('127.0.0.1', '172.18.0.7', ($args->{ip} ? ($args->{ip}) : ())) { Lacuna->cache->set('create_empire_captcha', $ip, { guid => 1111, solution => 1111 }, $ttl); } return $self->_json({ ok => 1 });}
sub www_clear_empires { my ($self, $request) = @_; $self->_guard; my $args = $self->_args($request); return $self->_json(Lacuna::TestSetup::clear_empires(name => $args->{name}));}
no Moose;__PACKAGE__->meta->make_immutable(inline_constructor => 0);