view release on metacpan or  search on metacpan

t/04_client.t  view on Meta::CPAN

$client->close;
my $url = $server->url;
chop $url;
$client = AnyEvent::MCP::Client::HTTP->new (url => $url);
($success, $result) = wait_for (sub { $client->rpc ("ping", {}, $_[0]) });
ok $success, "URL token works without trailing slash";
$client->close;
$url = $server->url (0);
chop $url;
$client = AnyEvent::MCP::Client::HTTP->new (url => $url, bearer => "secret");
($success, $result) = wait_for (sub { $client->rpc ("ping", {}, $_[0]) });
ok $success, "bearer-authenticated endpoint works without trailing slash";
$client->close;
$url = $server->url;
$url =~ s{/secret/mcp/\z}{/wrong/mcp};
$client = AnyEvent::MCP::Client::HTTP->new (url => $url);
($success, $result) = wait_for (sub { $client->rpc ("ping", {}, $_[0]) });
ok !$success && $result->{transport} && $result->{message} =~ /404/,
   "unknown URL token without trailing slash still rejected";
$client->close;
$client = AnyEvent::MCP::Client::HTTP->new (url => $server->url . "extra");
($success, $result) = wait_for (sub { $client->rpc ("ping", {}, $_[0]) });
ok !$success && $result->{transport} && $result->{message} =~ /404/,
   "extra path component still rejected";
$client->close;
$client = AnyEvent::MCP::Client::HTTP->new (url => $server->url (0), bearer => "wrong");
($success, $result) = wait_for (sub { $client->rpc ("ping", {}, $_[0]) });
ok !$success && $result->{transport} && $result->{message} =~ /401/, "wrong bearer fails";
$client->close;
$server->close;

$server = AnyEvent::MCP::Server::HTTP->new (toolsets => [$toolset],
   tokens => ["secret"], path => "/custom/");
$server->listen;
$url = $server->url;
chop $url;
$client = AnyEvent::MCP::Client::HTTP->new (url => $url);
($success, $result) = wait_for (sub { $client->rpc ("ping", {}, $_[0]) });
ok $success, "configured endpoint path accepts omitted trailing slash";
$client->close;
$server->close;

$server = AnyEvent::MCP::Server::HTTP->new (toolsets => [$toolset],
   tokens => ["secret"], path => "/custom");
$server->listen;
$client = AnyEvent::MCP::Client::HTTP->new (url => $server->url . "/");
($success, $result) = wait_for (sub { $client->rpc ("ping", {}, $_[0]) });
ok !$success && $result->{transport} && $result->{message} =~ /404/,
   "endpoint without trailing slash still rejects an added slash";
$client->close;
$server->close;

$server = AnyEvent::MCP::Server::HTTP->new (toolsets => [$toolset], tokens => ["alpha", "beta"]);
$server->listen;
$client = AnyEvent::MCP::Client::HTTP->new (url => $server->url (0), bearer => "beta");
($success, $result) = wait_for (sub { $client->call (echo => {}, $_[0]) });
ok $success, "second token accepted in Authorization header";
$client->close;
$server->close;
eval { AnyEvent::MCP::Client::HTTP->new (url => "http://localhost/", bearer => "token", username => "alice", password => "pw") };
ok $@ =~ /Basic authentication is unsupported/, "Basic credentials rejected even with bearer";
eval { AnyEvent::MCP::Client::HTTP->new (url => "http://localhost/", username => "alice") };
ok $@ =~ /Basic authentication is unsupported/, "Basic client credentials rejected";

$server = AnyEvent::MCP::Server::HTTP->new (auth => "none", toolsets => [$toolset], versions => ["2025-06-18"]);
$server->listen;
$client = AnyEvent::MCP::Client::HTTP->new (url => $server->url);
($success, $result) = wait_for (sub { $client->call (echo => { value => 42 }, $_[0]) });
ok $success && $result->{structuredContent}{value} == 42, "legacy fallback tool call";
ok $client->{protocol_version} eq "2025-06-18", "negotiated legacy version";
ok $client->{server_info}{name} eq "AnyEvent::MCP", "legacy wire identity preserved";
$client->close;
$server->close;

# Old dispatchers can return an internal error for an unknown discovery method.
my $discoveries = 0;
$server = AnyEvent::MCP::Server::HTTP->new (auth => "none", 
   toolsets => [$toolset],
   on_request => sub {
      if ($_[1]{method} eq "server/discover") {
         ++$discoveries;
         die "Undefined discovery handler\n"
      }
   },
);
$server->listen;
$client = AnyEvent::MCP::Client::HTTP->new (url => $server->url);
($success, $result) = wait_for (sub { $client->call (echo => { value => 42 }, $_[0]) });
ok $success && $result->{structuredContent}{value} == 42, "discovery internal error falls back to initialization";
ok $discoveries == 1 && $client->{protocol_version} eq "2025-11-25", "fallback negotiates legacy once";
$client->close;
$server->close;

my $calls = 0;
my @input;
$server = AnyEvent::MCP::Server::HTTP->new (auth => "none", on_tools_call => sub {
   my ($server, $req, $args) = @_;
   ++$calls;
   if (exists $req->{params}{inputResponses}) {
      ok $req->{params}{requestState} eq "opaque", "request state echoed";
      ok $req->{params}{inputResponses}{question}{content}{answer} == 42, "input answer echoed";
      ok $args->{original} eq "keep", "original tool arguments preserved";
      $req->result ({ answer => 42 });
   } else {
      $req->reply ({
         resultType => "input_required", requestState => "opaque",
         inputRequests => { question => {
            method => "elicitation/create", params => { message => "question" },
         } },
      });
   }
});
$server->listen;
$client = AnyEvent::MCP::Client::HTTP->new (
   url => $server->url, client_capabilities => { elicitation => { form => {} } },
   on_request => sub {
      my ($client, $req) = @_;
      push @input, $req;
      $req->reply ({ action => "accept", content => { answer => 42 } });
   },
);
($success, $result) = wait_for (sub { $client->call (question => { original => "keep" }, $_[0]) });
ok $success && $result->{structuredContent}{answer} == 42, "modern input continuation";

t/04_client.t  view on Meta::CPAN

            . $extra . "Content-Length: " . length ($body) . "\r\nConnection: close\r\n\r\n$body"
         );
      });
   });
}, sub { $port = $_[2]; () };
$client = AnyEvent::MCP::Client::HTTP->new (
   url => "http://127.0.0.1:$port/", versions => ["2025-06-18"],
);
($success, $result) = wait_for (sub { $client->rpc ("ping", {}, $_[0]) });
ok !$success && $result->{message} =~ /session expired/ && !$client->{connected}, "session expiry invalidates client";
ok $session_header && $initializations == 1, "session header retained without retry";
($success, $result) = wait_for (sub { $client->rpc ("ping", {}, $_[0]) });
ok !$success && $initializations == 2, "later operation creates a fresh session";
$client->close;
$_->destroy for @http_handles;
@http_handles = ();
undef $listener;

my $sent = 0;
$listener = AnyEvent::Socket::tcp_server "127.0.0.1", 0, sub {
   my $handle = AnyEvent::Handle->new (
      fh => $_[0], on_error => sub { $_[0]->destroy }, on_eof => sub { $_[0]->destroy },
   );
   push @http_handles, $handle;
   $handle->push_read (line => "\r\n\r\n", sub {
      ++$sent;
      $_[0]->destroy;
   });
}, sub { $port = $_[2]; () };
$client = AnyEvent::MCP::Client::HTTP->new (url => "http://127.0.0.1:$port/");
$client->{connected} = 1;
$client->{protocol_version} = "2026-07-28";
($success, $result) = wait_for (sub { $client->call (change => {}, $_[0]) });
ok !$success && $result->{transport} && $sent == 1, "broken HTTP tool call is not replayed";
$client->close;
$_->destroy for @http_handles;
@http_handles = ();
undef $listener;

my ($redirect_target, $redirect_port, $redirected);
$redirect_target = AnyEvent::Socket::tcp_server "127.0.0.1", 0, sub {
   ++$redirected;
   close $_[0];
}, sub { $redirect_port = $_[2]; () };
$listener = AnyEvent::Socket::tcp_server "127.0.0.1", 0, sub {
   my $handle = AnyEvent::Handle->new (
      fh => $_[0], on_error => sub { $_[0]->destroy }, on_eof => sub { $_[0]->destroy },
   );
   push @http_handles, $handle;
   $handle->push_read (line => "\r\n\r\n", sub {
      $_[0]->push_write (
         "HTTP/1.1 302 Found\r\nContent-Length: 0\r\nConnection: close\r\n"
         . "Location: http://127.0.0.1:$redirect_port/\r\n\r\n"
      );
   });
}, sub { $port = $_[2]; () };
$client = AnyEvent::MCP::Client::HTTP->new (url => "http://127.0.0.1:$port/", bearer => "secret");
$client->{connected} = 1;
$client->{protocol_version} = "2026-07-28";
($success, $result) = wait_for (sub { $client->rpc ("ping", {}, $_[0]) });
ok !$success && !$redirected && $result->{message} =~ /302/, "redirect does not forward credentials";
$client->close;
$_->destroy for @http_handles;
undef $listener;
undef $redirect_target;