view release on metacpan or  search on metacpan

t/03_simple.t  view on Meta::CPAN

($header, $body) = post ($server, "/", "Bearer wrong");
ok $header =~ m{HTTP/1.1 401}, "wrong bearer rejected";
($header, $body) = post ($server, "/wrong/");
ok $header =~ m{HTTP/1.1 404}, "wrong cookie path rejected";

$server = AnyEvent::MCP::Server::HTTP->new (tokens => ["first", "second"]);
($header, $body) = post ($server, "/second/mcp/");
ok $header =~ m{HTTP/1.1 200}, "second token works in URL";
($header, $body) = post ($server, "/mcp/", "Bearer first");
ok $header =~ m{HTTP/1.1 200}, "first token works as bearer";
($header, $body) = post ($server, "/mcp/", "Basic YTpi");
ok $header =~ m{HTTP/1.1 401} && $header !~ /WWW-Authenticate: Basic/, "Basic authentication is not supported";

$server = AnyEvent::MCP::Server::HTTP->new (
   path => "/", tokens => ["first", "second"],
   token_users => { first => "global:alice", second => "global:bob" },
   on_request => sub { $_[1]->reply ({ user => $_[1]{user} }) },
);
($header, $body) = post ($server, "/first/");
ok JSON::XS::decode_json ($body)->{result}{user} eq "global:alice", "path token identifies user";
($header, $body) = post ($server, "/", "Bearer second");
ok JSON::XS::decode_json ($body)->{result}{user} eq "global:bob", "Bearer identifies distinct user";
($header, $body) = post ($server, "/first/", "Bearer second");
ok $header =~ m{HTTP/1.1 401}, "conflicting path and Bearer identities rejected";

$server = AnyEvent::MCP::Server::HTTP->new (tokens => ["standalone"]);
($header, $body) = post ($server, "/mcp/");
ok $header =~ m{HTTP/1.1 401}, "embedded server with tokens rejects unauthenticated requests";
$server = AnyEvent::MCP::Server::HTTP->new (auth => "none", 
   host => "::1", port => 31740, handle => { tls => "accept" },
);
ok $server->url eq "https://[::1]:31740/mcp/", "IPv6 and TLS URL";
$server->{url_host} = "[::1]";
ok $server->url eq "https://[::1]:31740/mcp/", "prebracketed IPv6 URL host is not bracketed twice";
$server->{url_host} = "example.net";
$server->{url_scheme} = "http";
ok $server->url eq "http://example.net:31740/mcp/", "advertised URL overrides";
delete $server->{url_host};
$server->{host} = "0.0.0.0";
ok $server->url eq "http://" . (POSIX::uname)[1] . ":31740/mcp/", "wildcard nodename";
$server->{port} = 0;
eval { $server->url };
ok $@ =~ /port is not known/, "unknown port has no URL";

my $dir = File::Temp::tempdir (CLEANUP => 1);
local $ENV{XDG_CONFIG_HOME} = $dir;
local $ENV{PERL_ANYEVENT_MCP_MULTIBROKER_PROTOCOL};
my $printed = "";
{
   local *STDOUT;
   open STDOUT, ">", \$printed or die $!;
   my $timer;
   mcp_start name => "example", server_version => 0.61, on_start => sub {
      $server = $_[0];
      $timer = AnyEvent->timer (after => 0.01, cb => sub { $server->close });
   };
}
ok $server->isa ("AnyEvent::MCP::Server::HTTP"), "normal startup uses HTTP";
ok $server->{port} && $printed eq "", "HTTP startup leaves stdout empty";
my $config = AnyEvent::MCP::Config->global;
ok $server->{tokens}[0] eq $config->user_credentials ("example")->[0][2],
   "startup token matches derived utility";
ok $server->{server_info}{name} eq "AnyEvent::MCP", "instance name is not the server implementation name";
ok JSON::XS::encode_json ($server->{server_info}) =~ /"version":"0\.61"/,
   "Simple stringifies numeric module versions";
$server->close;

my $err = Symbol::gensym;
my $pid = IPC::Open3::open3 (my $in, my $out, $err, $^X, "-Ilib", "-e", '
   use AnyEvent::MCP::Server::Simple;
   $ENV{XDG_CONFIG_HOME} = $ARGV[0];
   $ENV{PERL_ANYEVENT_MCP_MULTIBROKER_PROTOCOL} = "stdio";
   mcp_start;
', "$dir/stdio");
print {$in} "{\"jsonrpc\":\"2.0\",\"id\":42,\"method\":\"ping\"}\n";
$in->flush;
close $in;
local $/;
my $output = <$out>;
my $errors = <$err>;
waitpid $pid, 0;
ok !$? && !$errors, "multibroker startup succeeds";
ok eval { JSON::XS::decode_json ($output)->{id} == 42 }, "stdio output contains only RPC";
ok !-e "$dir/stdio", "stdio does not access global configuration";

$err = Symbol::gensym;
$pid = do {
   local $ENV{PERL_ANYEVENT_LOG} = ""; # inspect the normal activity log.
   IPC::Open3::open3 ($in, $out, $err, $^X, "-Ilib", "-e", '
   use AnyEvent::MCP::Server::Simple;
   my $timer;
   mcp_tool delayed => "delayed", {}, sub {
      my ($req) = @_;
      $timer = AnyEvent->timer (after => 0.03, cb => sub {
         $req->reply ({ content => [{ type => "text", text => "x" x 200000 }] });
      });
   };
   mcp_stdio;
   print STDERR "stopped\\n";
   ');
};
print {$in} JSON::XS::encode_json ({
   jsonrpc => "2.0", id => 1, method => "initialize", params => {
      protocolVersion => "2025-11-25", clientInfo => {}, capabilities => {},
   },
}), "\n";
print {$in} JSON::XS::encode_json ({
   jsonrpc => "2.0", id => 2, method => "tools/call", params => { name => "delayed" },
}), "\n";
close $in;
$output = <$out>;
$errors = <$err>;
waitpid $pid, 0;
ok !$? && $errors =~ /\bdelayed\b.*\nstopped\n\z/s,
   "mcp_stdio logs tool activity and returns after input EOF";
my @messages = map JSON::XS::decode_json ($_), split /\n/, $output;
ok @messages == 2 && $messages[1]{id} == 2
   && length $messages[1]{result}{content}[0]{text} == 200000,
   "EOF waits for an asynchronous reply and drains large output";

my ($started, $closed, $timer);