view release on metacpan or  search on metacpan

lib/AnyEvent/MCP/Client/HTTP.pm  view on Meta::CPAN

=head1 NAME

AnyEvent::MCP::Client::HTTP - MCP over AnyEvent::HTTP

=head1 SYNOPSIS

   use AnyEvent::MCP::Client::HTTP;

   my $client = AnyEvent::MCP::Client::HTTP->new (
      name => "example", url => $url, bearer => $token,
      timeout => 30,
   );

=head1 DESCRIPTION

Use this transport to talk to an MCP server through HTTP. The caller supplies
the endpoint and, if needed, credentials; the common Client layer handles
discovery and tool calls. Unlike a browser, this client does not follow
redirects or silently retry requests. A redirected request could disclose
credentials to another host, and retrying a tool call could perform an
operation twice.

=head1 FIRST CALL

For a bundled MCP server already listening on HTTP, use the full URL
it prints with C<--print-url>:

   use AnyEvent;
   use AnyEvent::MCP::Client::HTTP;

   my $client = AnyEvent::MCP::Client::HTTP->new (
      url => "http://127.0.0.1:31740/TOKEN/",
   );
   my $cv = AE::cv;
   $client->call (workdirs => {}, sub { $cv->send (@_) });
   my ($success, $result) = $cv->recv;
   $success or die "$result->{message}\n";
   !$result->{isError} or die "$result->{content}[0]{text}\n";

Replace the example URL with the actual credential-bearing URL. The
common L<AnyEvent::MCP::Client> layer negotiates MCP and handles
callbacks. A successful JSON-RPC exchange can still return a tool error
as C<isError>; always inspect both.

=head1 METHODS

=over

=item $client = AnyEvent::MCP::Client::HTTP->new (%config)

Accepts the common L<AnyEvent::MCP::Client> options and these transport
options. Options are flat, rather than nested in an HTTP configuration hash.

=over

=item url => $url

Complete endpoint URL, optionally including a URL-path token. Required
unless supplied by the named client configuration.

=item bearer => $token

Supplies C<Authorization: Bearer TOKEN>. Without it, the URL alone is
used; a bearer token is not inferred from a URL. The server must accept
the selected credential. With the bundled servers, the URL-path token
and bearer header present the same static credential.

=item name => $name

Loads C<url>, C<bearer> and C<timeout> defaults from C<[client NAME]>.
Explicit constructor arguments override them, including explicitly undefined
credentials. Without a name no global configuration is accessed.

=item timeout => $seconds

HTTP inactivity timeout, defaulting to 300 seconds. Use the common
C<request_timeout> option for an overall tool-call deadline.

=item headers => { %headers }

Additional HTTP headers. Protocol headers and an explicitly configured
bearer header are supplied by this module.

=item max_size => $bytes

Bounds a JSON response or an individual buffered SSE event, defaulting to
8 MiB. SSE notifications are delivered incrementally rather than after
the HTTP response ends.

=back

C<proxy>, C<tls_ctx>, C<handle_params>, C<sessionid>, C<on_prepare>,
C<on_connect> and C<tcp_connect> are passed to L<AnyEvent::HTTP>.
No HTTP cookies or Basic authentication are supplied by this module.
Redirects and automatic HTTP retries are disabled.

Legacy session IDs are retained from initialization. An expired session fails
outstanding requests; a later operation can initialize again. Legacy GET
streams and the old separate SSE endpoint transport are not implemented.

=back

=cut

package AnyEvent::MCP::Client::HTTP;

use common::sense;
use parent "AnyEvent::MCP::Client";
use AnyEvent::HTTP ();
use JSON::XS ();
use MIME::Base64 ();
use Scalar::Util qw(weaken);

sub new {
   my ($class, %kv) = @_;

   if (defined $kv{name}) {
      require AnyEvent::MCP::Config;
      my $settings = AnyEvent::MCP::Config->global->{section}{"client $kv{name}"} || {};
      %kv = (
         (map { exists $settings->{$_} ? ($_ => $settings->{$_}) : () }
            qw(url bearer timeout)),
         %kv,
      );
   }

   defined $kv{url}
      or die "HTTP client requires a URL\n";
   !exists $kv{username} && !exists $kv{password}
      or die "HTTP Basic authentication is unsupported\n";
   die "Invalid bearer token\n" if defined $kv{bearer} && $kv{bearer} !~ /\A[^\s]+\z/;