view release on metacpan or  search on metacpan

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

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);
mcp_http auth => "none", port => 0, name => "local-instance",
   server_name => "advertised", server_version => 1.2,
   on_start => sub {
      $server = $_[0];
      $timer = AnyEvent->timer (after => 0.01, cb => sub { $server->close });
   };
ok $server->{server_info}{name} eq "advertised",
   "Simple server name is independent of instance name";
ok JSON::XS::encode_json ($server->{server_info}) =~ /"version":"1\.2"/,
   "flat Simple version is sent as a JSON string";
my $raw = { name => "raw", version => "7" };
mcp_http auth => "none", port => 0, name => "local-instance",
   server_info => $raw,
   on_start => sub {
      $server = $_[0];
      $timer = AnyEvent->timer (after => 0.01, cb => sub { $server->close });
   };
ok $server->{server_info} == $raw,
   "explicit raw server_info is passed through unchanged";
eval { mcp_http auth => "none", port => 0,
   server_name => "advertised", server_info => $raw };
ok $@ =~ /Cannot combine server_info with server_name/,
   "Simple rejects mixing raw and flat identity settings";

mcp_http auth => "none", port => 0, name => "another-instance",
   on_start => sub {
      $server = $_[0];
      $timer = AnyEvent->timer (after => 0.01, cb => sub { $server->close });
   };
ok $server->{server_info}{name} eq "AnyEvent::MCP",
   "Simple defaults to the library implementation name";
ok JSON::XS::encode_json ($server->{server_info}) =~ /"version":"\Q$AnyEvent::MCP::VERSION\E"/,
   "Simple defaults to the library version as a JSON string";

mcp_http auth => "none", port => 0, on_start => sub {
   my ($server) = @_;
   ++$started;
   $timer = AnyEvent->timer (after => 0.01, cb => sub { $server->close });
}, on_close => sub { ++$closed };
ok $started == 1 && $closed == 1, "mcp_http blocks through startup and returns on close";

eval { mcp_http auth => "none", port => 0, on_start => sub { die "startup failed\n" } };
ok $@ =~ /startup failed/, "startup hook exception closes the server and propagates";

{
   local @ARGV = ("--auto-deny=*,write", "--auto-allow=read_lines,read",
      "--auto-deny=*,*,*");
   my $options = mcp_getoptions ({ name => "auto-test" });
   ok JSON::XS::encode_json ($options->{auto_rules}) eq JSON::XS::encode_json ([
      ["deny", "*,write"], ["allow", "read_lines,read"], ["deny", "*,*,*"],
   ]), "CLI collects repeatable allow/deny rules in original order";

   my $perm = AnyEvent::MCP::Server::Permissions->new (
      rules => [{ decision => "deny", action => "^" }],
   );
   my $timer;
   mcp_http %$options, auth => "none", port => 0, permissions => $perm,
      on_start => sub {
         my ($server) = @_;
         $timer = AnyEvent->timer (after => 0.01, cb => sub { $server->close });
      };
   my $call = { action => "read", sandbox_grants => [], reason => "test" };
   ok $perm->check ($call, "read-lines")->{decision} eq "allow",
      "Simple starter installs ordered allow rule";
   ok $perm->check ({ %$call, action => "write" }, "read-lines")->{decision} eq "deny",
      "earlier auto-deny takes precedence over later allow";
   ok $perm->check ($call, "exec")->{decision} eq "deny",
      "later wildcard deny catches unmatched tools";

   my $created;
   mcp_http auth => "none", port => 0, auto_rules => [["deny", "*"]],
      on_start => sub {
         my ($server) = @_;
         $created = $server->{permissions};
         $timer = AnyEvent->timer (after => 0.01, cb => sub { $server->close });
      };
   ok $created && $created->check ($call, "anything")->{decision} eq "deny",
      "Simple starter creates a permission engine for automatic denial";
}