view release on metacpan or  search on metacpan

t/lite_app.t  view on Meta::CPAN

use Mojo::Base -strict, -signatures;

use Test::More;

use Test::Mojo;
use Mojo::ByteStream qw(b);
use Mojo::File       qw(curfile);
use Mojo::JSON       qw(from_json true false);
use MCP::Client;
use MCP::Constants qw(PROTOCOL_VERSION);
use MCP::Server;

my $t = Test::Mojo->new(curfile->sibling('apps', 'lite_app.pl'));

subtest 'Normal HTTP endpoint' => sub {
  $t->get_ok('/')->status_is(200)->content_like(qr/Hello MCP!/);
};

subtest 'List changed without streaming' => sub {
  my $server = MCP::Server->new;
  $server->to_action;
  is $server->notify_list_changed('tools'), undef, 'no broadcast without streaming';
};

subtest 'MCP endpoint' => sub {
  $t->get_ok('/mcp')->status_is(405)->content_like(qr/Method not allowed/);
  $t->delete_ok('/mcp')->status_is(405)->content_like(qr/Method not allowed/);

  my $client = MCP::Client->new(ua => $t->ua, url => $t->ua->server->url->path('/mcp'));

  subtest 'Initialize session' => sub {
    is $client->session_id, undef, 'no session id';
    my $result = $client->initialize_session;
    is $result->{protocolVersion},     PROTOCOL_VERSION, 'protocol version';
    is $result->{serverInfo}{name},    'PerlServer',     'server name';
    is $result->{serverInfo}{version}, '1.0.0',          'server version';
    ok $result->{capabilities},                                 'has capabilities';
    ok $result->{capabilities}{prompts},                        'has prompts capability';
    ok $result->{capabilities}{resources},                      'has resources capability';
    ok $result->{capabilities}{tools},                          'has tools capability';
    ok !exists $result->{capabilities}{tools}{listChanged},     'no listChanged for tools';
    ok !exists $result->{capabilities}{prompts}{listChanged},   'no listChanged for prompts';
    ok !exists $result->{capabilities}{resources}{listChanged}, 'no listChanged for resources';
    ok $client->session_id,                                     'session id set';
  };

  subtest 'Ping' => sub {
    my $result = $client->ping;
    is_deeply $result, {}, 'ping response';
  };

  subtest 'List tools' => sub {
    my $result = $client->list_tools;
    is $result->{tools}[0]{name},        'echo',                'tool name';
    is $result->{tools}[0]{description}, 'Echo the input text', 'tool description';
    is_deeply $result->{tools}[0]{inputSchema},
      {type => 'object', properties => {msg => {type => 'string'}}, required => ['msg']}, 'tool input schema';
    ok !exists($result->{tools}[0]{outputSchema}), 'no output schema';
    is_deeply $result->{tools}[0]{annotations}, {title => 'echo'}, 'corrent number of annotations';
    is $result->{tools}[1]{name},        'echo_async',                         'tool name';
    is $result->{tools}[1]{description}, 'Echo the input text asynchronously', 'tool description';
    is_deeply $result->{tools}[1]{inputSchema},
      {type => 'object', properties => {msg => {type => 'string'}}, required => ['msg']}, 'tool input schema';
    ok !exists($result->{tools}[1]{outputSchema}), 'no output schema';
    is keys %{$result->{tools}[1]{annotations}}, 0,             'empty annotations not serialized';
    is $result->{tools}[2]{name},                'echo_header', 'tool name';
    is $result->{tools}[2]{description},         'Echo the input text with a header', 'tool description';
    is_deeply $result->{tools}[2]{inputSchema},
      {type => 'object', properties => {msg => {type => 'string'}}, required => ['msg']}, 'tool input schema';
    ok !exists($result->{tools}[2]{outputSchema}), 'no output schema';
    is $result->{tools}[3]{name},        'time',                                 'tool name';
    is $result->{tools}[3]{description}, 'Get the current time in epoch format', 'tool description';
    is_deeply $result->{tools}[3]{inputSchema}, {type => 'object'}, 'tool input schema';
    ok !exists($result->{tools}[3]{outputSchema}), 'no output schema';
    is $result->{tools}[4]{name},        'generate_image',                    'tool name';
    is $result->{tools}[4]{description}, 'Generate a simple image from text', 'tool description';
    is_deeply $result->{tools}[4]{inputSchema},
      {type => 'object', properties => {text => {type => 'string'}}, required => ['text']}, 'tool input schema';
    ok !exists($result->{tools}[4]{outputSchema}), 'no output schema';
    is $result->{tools}[5]{name},        'generate_audio',           'tool name';
    is $result->{tools}[5]{description}, 'Generate audio from text', 'tool description';
    is_deeply $result->{tools}[5]{inputSchema},