package Net::Async::MCP::Server;
# ABSTRACT: Async MCP server for command execution

use strict;
use warnings;

use parent 'Net::Async::MCP';

use IO::Async::Process;
use IO::Async::Timer::Countdown;
use Future::AsyncAwait;

our $VERSION = '0.001';


use MCP::Run::Compress;
use JSON::MaybeXS qw( encode_json decode_json );

sub new {
    my ( $class, %params ) = @_;

    # Extract our custom params before passing to parent
    # (parent only accepts server/command/url)
    my %our_params = ();
    for my $key (qw( allowed_commands working_directory timeout compress validator )) {
        $our_params{$key} = delete $params{$key} if exists $params{$key};
    }

    my $self = $class->SUPER::new(%params);

    $self->{allowed_commands}   = $our_params{allowed_commands}   // [];
    $self->{working_directory}  = $our_params{working_directory};
    $self->{timeout}            = $our_params{timeout}            // 30;
    $self->{compress}           = $our_params{compress}           // 0;
    $self->{validator}          = $our_params{validator};
    $self->{_compressor}        = MCP::Run::Compress->new;

    return $self;
}

sub allowed_commands { shift->{allowed_commands} }
sub working_directory { shift->{working_directory} }
sub timeout { shift->{timeout} }
sub compress { shift->{compress} }
sub validator { shift->{validator} }
sub name { shift->{name} }

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

    # Extract our custom params before passing to parent
    my %our_params = ();
    for my $key (qw( name allowed_commands working_directory timeout compress validator )) {
        $our_params{$key} = delete $params{$key} if exists $params{$key};
    }

    # Store our custom params directly (parent doesn't know them)
    $self->{name} = $our_params{name} if defined $our_params{name};
    for my $key (qw( allowed_commands working_directory timeout compress validator )) {
        $self->{$key} = $our_params{$key} if defined $our_params{$key};
    }

    # Now call parent with remaining params (name is already deleted)
    $self->SUPER::configure(%params);
}

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

    # Set defaults if not already set by configure()
    $self->{allowed_commands} //= [];
    $self->{timeout}          //= 30;
    $self->{compress}         //= 0;
    $self->{_compressor}      = MCP::Run::Compress->new;

    $self->SUPER::_init($params);
}

sub _ensure_transport {
    # We are a server, not a client - don't create client transport
}

sub _add_to_loop {
    my ( $self, $loop ) = @_;
    $self->SUPER::_add_to_loop($loop);
    # Don't call _ensure_transport - we're a server, not a client
}

async sub initialize {
    my ( $self ) = @_;

    $self->{server_info} = {
        name    => $self->name,
        version => $VERSION,
    };
    $self->{server_capabilities} = {
        tools => {},
    };
    $self->{_initialized} = 1;

    return {
        protocolVersion => '2025-11-25',
        capabilities    => { tools => {} },
        serverInfo      => {
            name    => $self->name,
            version => $VERSION,
        },
    };
}

async sub list_tools {
    my ( $self ) = @_;
    return [ $self->_build_tool_definition ];
}

async sub call_tool {
    my ( $self, $name, $arguments ) = @_;

    if ( $name eq 'run' ) {
        return $self->_handle_run( $name, $arguments );
    }

    die "Unknown tool: $name";
}

sub handle {
    my ( $self, $request, $context ) = @_;

    return _jsonrpc_error( -32700, 'Invalid JSON-RPC request' )
        unless ref $request eq 'HASH';

    my $method = $request->{method};
    my $id     = $request->{id};

    return _jsonrpc_error( -32600, 'Missing JSON-RPC method', $id )
        unless defined $method;

    # Handle requests (with id)
    if ( defined $id ) {
        if ( $method eq 'initialize' ) {
            return $self->_handle_initialize( $request->{params} // {}, $id );
        }
        elsif ( $method eq 'tools/list' ) {
            return $self->_handle_tools_list( $context, $id );
        }
        elsif ( $method eq 'tools/call' ) {
            return $self->_handle_tools_call( $request->{params} // {}, $id, $context );
        }
        elsif ( $method eq 'ping' ) {
            return _jsonrpc_response( {}, $id );
        }

        return _jsonrpc_error( -32601, "Method '$method' not found", $id );
    }

    # Handle notifications (no id)
    if ( $method eq 'notifications/initialized' ) {
        # Client is done initializing - nothing to do
        return undef;
    }
    elsif ( $method eq 'shutdown' ) {
        # Clean shutdown requested
        return undef;
    }

    # Unknown notification - ignore
    return undef;
}

sub _handle_initialize {
    my ( $self, $params, $id ) = @_;

    # Perform our initialization
    $self->initialize->get;

    return _jsonrpc_response( {
        protocolVersion => '2025-11-25',
        capabilities    => { tools => {} },
        serverInfo      => {
            name    => $self->name,
            version => $VERSION,
        },
    }, $id );
}

sub _handle_tools_list {
    my ( $self, $context, $id ) = @_;

    my $tools = $self->list_tools->get;
    return _jsonrpc_response( { tools => $tools }, $id );
}

sub _handle_tools_call {
    my ( $self, $params, $id, $context ) = @_;

    my $name = $params->{name}      // '';
    my $args = $params->{arguments} // {};

    my $result = $self->call_tool( $name, $args )->get;
    return _jsonrpc_response( $result, $id );
}

sub _jsonrpc_error {
    my ( $code, $message, $id ) = @_;
    $id //= undef;
    return { jsonrpc => '2.0', id => $id, error => { code => $code, message => $message } };
}

sub _jsonrpc_response {
    my ( $result, $id ) = @_;
    $id //= undef;
    return { jsonrpc => '2.0', id => $id, result => $result };
}

sub _build_tool_definition {
    my ( $self ) = @_;
    return {
        name        => 'run',
        description => 'Execute a command and return stdout, stderr, and exit code',
        inputSchema => {
            type       => 'object',
            properties => {
                command => {
                    type        => 'string',
                    description => 'The command to execute',
                },
                working_directory => {
                    type        => 'string',
                    description => 'Working directory',
                },
                timeout => {
                    type        => 'integer',
                    description => 'Timeout in seconds',
                },
                compress => {
                    type        => 'boolean',
                    description => 'Compress output',
                },
            },
            required => ['command'],
        },
    };
}

sub _handle_run {
    my ( $self, $tool, $arguments ) = @_;

    my $command = $arguments->{command};
    my $dir     = $arguments->{working_directory} // $self->working_directory;
    my $to      = $arguments->{timeout}    // $self->timeout;
    my $comp    = $arguments->{compress}  // $self->compress;

    # Validate command
    my $validation = $self->_validate_command( $command, $dir );
    if ( $validation ne '1' ) {
        return {
            content => [{ type => 'text', text => $validation // 'Command not allowed' }],
            isError => 1,
        };
    }

    # Execute command
    my $result = $self->_execute_command( $command, $dir, $to )->get;

    # Format result
    return $self->_format_result( $result, $comp );
}

sub _validate_command {
    my ( $self, $command, $working_directory ) = @_;

    # Check allowed_commands
    if ( @{ $self->allowed_commands } > 0 ) {
        my $program = ( split /\s+/, $command )[0];
        my $allowed = 0;
        for my $allowed_cmd ( @{ $self->allowed_commands } ) {
            if ( $program eq $allowed_cmd ) {
                $allowed = 1;
                last;
            }
        }
        unless ($allowed) {
            return "Command not allowed: $program";
        }
    }

    # Check validator
    if ( $self->validator ) {
        my $result = $self->validator->( $command, $working_directory );
        return $result if defined $result;
        return 'Command blocked by validator';
    }

    return '1';
}

async sub _execute_command {
    my ( $self, $command, $working_directory, $timeout ) = @_;

    my $timed_out = 0;
    my $process;
    my $stdout = '';

    # Build the full command with working_directory
    my $full_command = $command;
    if ( defined $working_directory && length $working_directory ) {
        my $escaped = $working_directory;
        $escaped =~ s/'/'\\''/g;
        $full_command = "cd '$escaped' && $command";
    }

    my $exit_code;
    my $done_future = $self->loop->new_future;

    $process = IO::Async::Process->new(
        command => [ '/bin/sh', '-c', $full_command ],
        stdout  => {
            via => 'pipe_read',
            on_read => sub {
                my ( $stream, $buffref, $eof ) = @_;
                $stdout .= $$buffref;
                $$buffref = '';
                return 0;
            },
        },
        on_finish => sub {
            my ( $pid, $status ) = @_;
            $exit_code = $status >> 8;
            $done_future->done($exit_code) unless $done_future->is_ready;
        },
    );

    my $timer = IO::Async::Timer::Countdown->new(
        delay => $timeout,
        on_expire => sub {
            $timed_out = 1;
            $process->kill('TERM');
        },
    );

    $self->add_child( $process );
    $self->add_child( $timer );
    $timer->start;

    await $done_future;

    $timer->stop;
    $self->remove_child( $timer );
    $self->remove_child( $process );

    if ( $timed_out ) {
        return {
            exit_code => 124,
            stdout    => '',
            stderr    => '',
            error     => "Command timed out after ${timeout}s",
        };
    }

    chomp $stdout;

    return {
        exit_code => $exit_code // 0,
        stdout    => $stdout,
        stderr    => '',
        error     => undef,
    };
}

sub _format_result {
    my ( $self, $result, $compress ) = @_;

    my ( $stdout, $stderr ) = ( $result->{stdout} // '', $result->{stderr} // '' );

    if ( $compress ) {
        ( $stdout, $stderr ) = $self->{_compressor}->compress( $result->{command} // '', $stdout, $stderr );
    }

    my $output = "Exit code: $result->{exit_code}\n\n=== STDOUT ===\n$stdout";
    $output .= "\n\n=== STDERR ===\n$stderr" if length $stderr;

    if ( my $error = $result->{error} ) {
        $output .= "\n\n=== ERROR ===\n$error";
    }

    return {
        content => [{ type => 'text', text => $output }],
        isError => $result->{exit_code} != 0 ? 1 : 0,
    };
}

sub run_stdio {
    my ( $class, %params ) = @_;

    require Net::Async::MCP::Server::Transport::Stdio;

    my $server = $class->new(%params);
    my $loop = IO::Async::Loop->new;
    $loop->add($server);

    Net::Async::MCP::Server::Transport::Stdio->new(
        server => $server,
    )->handle_requests;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Net::Async::MCP::Server - Async MCP server for command execution

=head1 VERSION

version 0.001

=head1 SYNOPSIS

    use IO::Async::Loop;
    use Net::Async::MCP::Server;

    my $loop = IO::Async::Loop->new;

    my $server = Net::Async::MCP::Server->new(
        name             => 'command-runner',
        allowed_commands => ['ls', 'cat', 'grep'],
        working_directory => '/tmp',
        timeout           => 30,
        compress          => 1,
    );

    $loop->add($server);

    async sub main {
        await $server->initialize;

        my $tools = await $server->list_tools;
        # [{name => 'run', description => '...', inputSchema => {...}}]

        my $result = await $server->call_tool('run', {
            command => 'ls -la',
            working_directory => '/tmp',
            timeout => 10,
        });
        # {content => [{type => 'text', text => '...'}], isError => 0}
    }

    main()->get;

=head1 DESCRIPTION

L<Net::Async::MCP::Server> is an asynchronous MCP (Model Context Protocol) server
for command execution, built on L<IO::Async> and L<Future::AsyncAwait>.

Extends L<Net::Async::MCP> to act as an MCP server (not client) that exposes a
C<run> tool for command execution. The async counterpart to L<MCP::Run::Bash>.

=head1 ATTRIBUTES

=head2 name (required)

The server name exposed via MCP protocol.

=head2 allowed_commands

ArrayRef of command names (first words) that are permitted. Commands not in
this list are rejected with an error result.

    $server->allowed_commands(['ls', 'cat', 'grep']);

=head2 working_directory

Default working directory for command execution. Can be overridden per-invocation.

    $server->working_directory('/var/data');

=head2 timeout

Default timeout in seconds. Defaults to 30.

    $server->timeout(60);

=head2 compress

Enable output compression via L<MCP::Run::Compress>. When enabled, command
output is filtered through compression filters before returning to the client.

    $server->compress(1);

=head2 validator

Coderef that validates a command before execution.

    $server->validator(sub ($cmd, $dir) {
        return 1 if $cmd =~ /^ls|^cat|^grep/;
        return "blocked by policy";
    });

=head1 METHODS

=head2 async method initialize()

Performs MCP server initialization. Handles the C<initialize> request from the
client, sends server info and capabilities, registers the 'run' tool.

=head2 async method list_tools()

Returns ArrayRef of tool definitions. Returns the registered 'run' tool.

=head2 async method call_tool($name, $arguments)

Calls the specified tool with arguments. For the 'run' tool:

    my $result = await $server->call_tool('run', {
        command => 'ls -la',
        working_directory => '/tmp',
        timeout => 10,
    });

=head2 run_stdio class method

Convenience constructor that creates a server and runs it in stdio mode.

    Net::Async::MCP::Server->run_stdio(name => 'my-server');

=head2 method handle($request, $context)

Handles a JSON-RPC request and returns a response. This is the main entry point
for the stdio transport.

    my $response = $server->handle($request);

Returns C<undef> for notifications (no response needed).

=head1 SEE ALSO

L<Net::Async::MCP>, L<MCP>, L<MCP::Server>, L<MCP::Run>, L<MCP::Run::Bash>.

=cut

=head1 SUPPORT

=head2 Issues

Please report bugs and feature requests on GitHub at
L<https://github.com/Getty/p5-net-async-mcp-run/issues>.

=head1 CONTRIBUTING

Contributions are welcome! Please fork the repository and submit a pull request.

=head1 AUTHOR

Torsten Raudssus <torsten@raudssus.de>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2026 by Torsten Raudssus <torsten@raudssus.de> L<https://raudssus.de/>.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
