package TestClient;

# Lightweight counterpart to t/TestHelper.pm for "naked" tests -- those that only
# need a test empire plus JSON-RPC HTTP calls. It talks to the dev-only /test
# endpoints (lib/Lacuna/Web/TestSetup.pm) for all setup/teardown, so it can load
# with just LWP + JSON and skip the multi-second `use Lacuna` compile that
# TestHelper pays per test file.
#
# Drop-in for the common TestHelper surface: ->new, ->generate_test_empire,
# ->use_existing_test_empire, ->build_infrastructure, ->post, ->get_building,
# ->session->id, ->empire->id, ->empire->home_planet->id, ->empire_name,
# TestClient->clear_all_test_empires. Tests that reach deeper into Lacuna objects
# are "bespoke" and should stay on TestHelper.

use strict;
use warnings;
use LWP::UserAgent;
use JSON qw(to_json from_json);
use Carp qw(croak);

sub new {
    my ($class, $args) = @_;
    $args ||= {};
    my $url = $ENV{LACUNA_TEST_SERVER_URL} || 'http://localhost:5000/';
    $url .= '/' unless $url =~ m{/$};
    my $self = bless {
        server_url     => $url,
        ua             => LWP::UserAgent->new(timeout => 30),
        big_producer   => $args->{big_producer} ? 1 : 0,
        empire_name    => $args->{empire_name},
        empire_id      => undef,
        session_id     => undef,
        home_planet_id => undef,
        password       => undef,
    }, $class;
    return $self;
}

# --- low-level HTTP -------------------------------------------------------

# JSON-RPC call -- identical wire format to TestHelper::post.
sub post {
    my ($self, $url, $method, $params) = @_;
    my $content = { jsonrpc => '2.0', id => 1, method => $method, params => $params };
    print "REQUEST: " . to_json($content) . "\n";
    my $response = $self->{ua}->post(
        $self->{server_url} . $url,
        Content_Type => 'application/json',
        Content      => to_json($content),
        Accept       => 'application/json',
    );
    print "RESPONSE: " . $response->content . "\n";
    return from_json($response->content);
}

# POST a JSON body to /test/<path>, return the decoded hash (croak on failure).
sub _setup {
    my ($self, $path, $body) = @_;
    my $response = $self->{ua}->post(
        $self->{server_url} . "test/$path",
        Content_Type => 'application/json',
        Content      => to_json($body || {}),
        Accept       => 'application/json',
    );
    unless ($response->is_success) {
        croak "POST /test/$path failed: " . $response->status_line . " -- " . $response->content;
    }
    return from_json($response->content);
}

# --- empire lifecycle ---------------------------------------------------------

sub generate_test_empire {
    my ($self, %opts) = @_;
    my $out = $self->_setup('generate_empire', {
        name     => $opts{name} || $self->{empire_name},
        password => $opts{password},
    });
    $self->_absorb($out);
    return $self;
}

sub use_existing_test_empire {
    my ($self, %opts) = @_;
    my $out = $self->_setup('use_existing_empire', {
        name     => $opts{name} || $self->{empire_name},
        password => $opts{password},
    });
    $self->_absorb($out);
    return $self;
}

sub _absorb {
    my ($self, $out) = @_;
    $self->{empire_id}      = $out->{empire_id};
    $self->{empire_name}    = $out->{empire_name};
    $self->{session_id}     = $out->{session_id};
    $self->{home_planet_id} = $out->{home_planet_id};
    $self->{password}       = $out->{password};
}

sub build_infrastructure {
    my ($self, %opts) = @_;
    $self->_setup('build_infrastructure', {
        empire_id    => $self->{empire_id},
        big_producer => (exists $opts{big_producer} ? $opts{big_producer} : $self->{big_producer}),
    });
    return $self;
}

sub build_big_colony {
    my ($self, %opts) = @_;
    $self->_setup('build_big_colony', {
        empire_id => $self->{empire_id},
        planet_id => $opts{planet_id},
    });
    return $self;
}

# --- buildings / resources ------------------------------------------------

# Returns a small stub so `$tester->build_building(...)->id` /
# `->finish_upgrade` keep working like TestHelper's building object.
sub build_building {
    my ($self, $class, $level) = @_;
    my $out = $self->_setup('build_building', {
        empire_id => $self->{empire_id},
        class     => $class,
        level     => $level,
    });
    return TestClient::Building->new($self, $out);
}

# TestHelper::get_building returns a live Building; here we only support the one
# thing naked tests do with it -- ->finish_upgrade (and ->id).
sub get_building {
    my ($self, $building_id) = @_;
    return TestClient::Building->new($self, { building_id => $building_id });
}

sub finish_building {
    my ($self, $building_id) = @_;
    return $self->_setup('finish_building', { building_id => $building_id });
}

sub finish_ships {
    my ($self, $shipyard_id) = @_;
    return $self->_setup('finish_ships', { shipyard_id => $shipyard_id });
}

# set_body_resources($planet_id, ore_capacity => ..., algae_stored => ..., tick => 1)
sub set_body_resources {
    my ($self, $planet_id, %cols) = @_;
    return $self->_setup('set_body_resources', { planet_id => $planet_id, %cols });
}

sub prime_captcha {
    my ($self, %opts) = @_;
    return $self->_setup('prime_captcha', {
        session_id => (exists $opts{session_id} ? $opts{session_id} : $self->{session_id}),
        ip         => $opts{ip},
    });
}

# --- teardown -----------------------------------------------------------

# Callable as class or instance method (incl. from END {}).
sub clear_all_test_empires {
    my ($invocant, $name) = @_;
    my $self = ref $invocant ? $invocant : TestClient->new;
    return $self->_setup('clear_empires', { name => $name });
}
sub cleanup { goto &clear_all_test_empires }

# --- accessors -----------------------------------------------------------

sub server_url      { $_[0]->{server_url} }
sub session_id      { $_[0]->{session_id} }
sub empire_id       { $_[0]->{empire_id} }
sub home_planet_id  { $_[0]->{home_planet_id} }
sub empire_name     { $_[0]->{empire_name} // 'TLE Test Empire' }
sub empire_password { $_[0]->{password} // '123qwe' }

# Back-compat object stubs so a header swap is usually the whole diff.
sub session { TestClient::Session->new($_[0]) }
sub empire  { TestClient::Empire->new($_[0]) }

# ======================================================================

package TestClient::Building;
sub new {
    my ($class, $client, $out) = @_;
    return bless { client => $client, %{ $out || {} } }, $class;
}
sub id    { $_[0]->{building_id} }
sub x     { $_[0]->{x} }
sub y     { $_[0]->{y} }
sub level { $_[0]->{level} }
sub finish_upgrade {
    my ($self) = @_;
    $self->{client}->finish_building($self->{building_id});
    return $self;
}

package TestClient::Session;
sub new { bless { client => $_[1] }, $_[0] }
sub id  { $_[0]->{client}->session_id }

package TestClient::Empire;
sub new          { bless { client => $_[1] }, $_[0] }
sub id           { $_[0]->{client}->empire_id }
sub name         { $_[0]->{client}->empire_name }
sub home_planet_id { $_[0]->{client}->home_planet_id }
sub home_planet  { TestClient::Body->new($_[0]->{client}) }

package TestClient::Body;
sub new { bless { client => $_[1] }, $_[0] }
sub id  { $_[0]->{client}->home_planet_id }

1;