File Coverage

blib/lib/Net/Async/MCP/Server.pm

Criterion	Covered	Total	%
statement	77	83	92.7
branch	19	26	73.0
condition	12	18	66.6
subroutine	22	23	95.6
pod	9	10	90.0
total	139	160	86.8

package Net::Async::MCP::Server;
# ABSTRACT: Async MCP server base class

use strict;
use warnings;

use parent 'IO::Async::Notifier';

use Future::AsyncAwait;

our $VERSION = '0.001';


sub _init {
  my ( $self, $params ) = @_;
  $self->SUPER::_init($params);
}

sub configure {
  my ( $self, %params ) = @_;
  if (exists $params{name}) {
    $self->{name} = delete $params{name};
  }
}

sub _add_to_loop {
  my ( $self, $loop ) = @_;
  $self->SUPER::_add_to_loop($loop);
}

sub name { shift->{name} // 'NetAsyncMCPServer' }


sub server_info {
    my ( $self ) = @_;
    return {
        name    => $self->name,
        version => $VERSION,
    };
}


sub server_capabilities {
    my ( $self ) = @_;
    return $self->{server_capabilities} // {};
}


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

    $self->{server_capabilities} = $self->_build_capabilities;
    $self->{_initialized} = 1;

    return {
        protocolVersion => '2025-11-25',
        capabilities    => $self->server_capabilities,
        serverInfo      => $self->server_info,
    };
}


sub _build_capabilities {
    my ( $self ) = @_;
    return { tools => {} };
}

sub tools {
    my ( $self ) = @_;
    return $self->{tools} // [];
}


sub register_tool {
    my ( $self, %tool ) = @_;
    $self->{tools} //= [];
    push @{ $self->{tools} }, \%tool;
}


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


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

    my $tool = $self->_find_tool($name);
    die "No tool registered: $name" unless $tool;

    if (my $code = $tool->{code}) {
        return $code->($arguments);
    }

    die "Tool '$name' has no implementation";
}

sub _find_tool {
    my ( $self, $name ) = @_;
    for my $tool (@{ $self->{tools} // [] }) {
        return $tool if $tool->{name} eq $name;
    }
    return undef;
}


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;

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

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

    if ( $method eq 'notifications/initialized' ) {
        return undef;
    }
    elsif ( $method eq 'shutdown' ) {
        return undef;
    }

    return undef;
}

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

    my $result = $self->initialize->get;

    return _jsonrpc_response( $result, $id );
}

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

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

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

    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 ) = @_;
    return {
        jsonrpc => '2.0',
        id      => $id,
        error   => { code => $code, message => $message },
    };
}

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

1;

__END__