MCP/Server/Toolset.pm

=head1 NAME

AnyEvent::MCP::Server::Toolset - MCP tool declarations and callbacks

=head1 DESCRIPTION

A Toolset answers two questions: which tools exist, and what code should run
when one is called? It holds tool declarations and their callbacks, but no
transport or client state. You can therefore give the same Toolset to
several servers without copying or re-registering the tools.

If your program only needs one standalone server, the function interface in
L<AnyEvent::MCP::Server::Simple> manages a default Toolset for you.

=head1 REQUEST AND TOOL WORKFLOW

Register tools with C<tool>, then pass the Toolset to a server through its
C<toolsets> option. The server handles the protocol and transport; the Toolset
supplies declarations for C<tools/list> and callbacks for C<tools/call>.

For a tool call, the server creates an L<AnyEvent::MCP::Server::Request>,
sets C<< $req->{tool} >> and C<< $req->{args} >>, and calls its C<on_request>
hook. It then finds the first Toolset containing that tool and invokes its
callback as C<$callback->($req, $args)>. C<$args> is the same hash reference
as C<< $req->{args} >>; C<< $req->{toolset} >> identifies the invoking Toolset.

The input schema describes the arguments to the client; the server does not
validate arguments against it. The handler must validate the arguments it
uses and complete the request with one reply.

=head2 Permission checks and retries

Configure the server's C<permissions> option with an
L<AnyEvent::MCP::Server::Permissions> object. The handler can check several
paths or operations in sequence:

   sub {
      my ($req, $args) = @_;

      my $source_grant = $req->require_permission ({
         tool => $req->{tool}, subject => $args->{source},
         subjects => [{ label => "source file", subject => $args->{source} }],
         capabilities => ["read"], reason => "read the source file",
      });

      my $destination_grant = $req->require_permission ({
         tool => $req->{tool}, subject => $args->{destination},
         subjects => [{ label => "destination file", subject => $args->{destination} }],
         capabilities => ["write"], reason => "write the destination file",
      });

      ... # read using $source_grant, write using $destination_grant
      $req->result ({ ... });
   }

Capability names and their implications belong to the application.
C<require_permission> returns the granted capability array reference, which
may be smaller than the requested set. Execute using those grants rather
than assuming that everything requested was allowed.

Grants are separate; Server does not combine them. When reading the source
and writing the destination separately, use each grant for its corresponding
operation.

Combining authority is needed when one operation spans several subjects,
such as renaming a file. Request the required capabilities for every affected
path: a rename needs write authority for both source and destination, unlike
the read/write example above. Check that every grant still permits the
operation after any reductions. For an application whose C<write> capability
authorizes rename, after requesting C<["write"]> for both paths:

   my $permissions = $req->{server}{permissions};
   my $source = $permissions->closure ($source_grant);
   my $destination = $permissions->closure ($destination_grant);

   die "Rename needs write permission for both paths\n"
      unless $source->{write} && $destination->{write};

C<closure> includes implied capabilities. If the operation needs one combined
capability set, use the intersection of these closures, rather than their
union: authority granted for one path must not authorize the other.
Do this before starting the operation.

A denial dies and becomes a tool error. The first missing permission throws
a special exception: Server catches it and asks. Modern MCP asking replies
with C<input_required>; the client supplies the answer in a repeated call.
Local asking, including the legacy fallback, retries the handler internally.
An explicit local asking configuration also applies to modern callers.

The handler starts again from the beginning, including the server's
C<on_request> hook. Earlier one-time grants survive these retries but do not
authorize another tool invocation. Current rules are rechecked, so a new
denial can supersede an earlier approval.

Complete all checks before side effects or asynchronous work. Do not catch
the permission-needed exception as an ordinary tool failure; it must reach
the server's synchronous dispatch boundary. A deferred callback cannot use
that boundary to restart the handler.

=head2 Replies and failures

=over

=item $req->reply ($result)

Sends the MCP result hash reference as supplied. Use this for arbitrary
content, structured errors or large results. The server adds the JSON-RPC
envelope.

=item $req->result ($data)

Sends the hash reference C<$data> as C<structuredContent> and also as JSON in
one text content item. This duplicates the data for clients that consume
only text; use C<reply> when that representation is unsuitable.

=item $req->error ($message)

Sends a tool result with C<isError> set and C<$message> as one text item.

=back

A synchronous handler exception becomes a tool error. Tool failures do not
become JSON-RPC errors; malformed protocol requests and unknown tools are
handled by Server.

Reply exactly once. Replying after completion is a bug and dies. A reply
finishes the request, but returning from the callback does not.

=head2 Asynchronous work and cancellation

The callback may keep C<$req> and return without replying. Reply when the
operation completes. The callback runs in the event loop; use asynchronous
operations rather than blocking it.

Set C<< $req->{on_cancel} >> to stop an outstanding operation. Cancellation
sets C<< $req->{cancelled} >> and C<< $req->{finished} >> and sends no reply.
A late completion callback must check C<< $req->{finished} >> before replying.

Server catches exceptions during synchronous dispatch, not exceptions in
later application callbacks. Such callbacks must handle their own failures.

C<< $req->progress ($progress, $total, $message) >> reports progress when
the client supplied a progress token. Delivery is best effort and may be
dropped by the transport; it does not complete the request.

=head1 METHODS

=over

=item $toolset = AnyEvent::MCP::Server::Toolset->new

Creates an empty tool registry.

=item $toolset->tool ($name, $description, $input_schema, $callback->($req, $args))

Registers a tool named C<$name>. Underscores are converted to hyphens and
duplicate names are rejected.

C<$description> is stripped of surrounding whitespace and common indentation.
C<$input_schema> is a JSON Schema hash reference describing the arguments.

C<$callback> receives an L<AnyEvent::MCP::Server::Request> object C<$req>
and its C<< $req->{args} >> hash reference as C<$args>, for convenience:

   sub {
      my ($req, $args) = @_;

      $req->reply ({
         content => [{ type => "text", text => $args->{text} }],
      });
   }

Registered tools are callbacks, not methods of the Toolset.

=item $definitions = $toolset->list

Returns the array reference of MCP tool definitions in registration order.
C<$definitions> contains no callbacks.

=item $toolset->call ($req)

Invokes the tool named by C<< $req->{tool} >> with C<$req> and
C<< $req->{args} >>. Sets C<< $req->{toolset} >> to this Toolset.

Unknown names and exceptions from the callback are left for the server to
handle.

=back

=cut

package AnyEvent::MCP::Server::Toolset;

use common::sense;
use AnyEvent::MCP ();

our @ISA = qw(AnyEvent::MCP::Base);

sub new {
   my $class = shift;

   $class->SUPER::new (tool => {}, list => [], @_)
}

sub tool {
   my ($self, $name, $description, $input_schema, $callback) = @_;

   $name =~ y/_/-/;

   die "duplicate MCP tool '$name'\n"
      if exists $self->{tool}{$name};

   my $definition = {
      name        => $name,
      description => AnyEvent::MCP::_clean_text $description,
      inputSchema => $input_schema,
   };

   $self->{tool}{$name} = {
      definition => $definition,
      callback   => $callback,
   };

   push @{$self->{list}}, $definition;
}

sub list {
   $_[0]{list}
}

sub call {
   my ($self, $req) = @_;
   my $name = $req->{tool};

   my $tool = $self->{tool}{$name}
      or die "unknown MCP tool '$name'\n";

   $req->{toolset} = $self;
   $tool->{callback}->($req, $req->{args})
}

1
Revision:	1.2
Committed:	Fri Oct 9 09:36:49 2026 UTC (4 weeks, 3 days ago) by root
Branch:	MAIN
Changes since 1.1:	+7 -2 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			AnyEvent::MCP::Server::Toolset - MCP tool declarations and callbacks
4
5			=head1 DESCRIPTION
6
7	root	1.2	A Toolset answers two questions: which tools exist, and what code should run
8			when one is called? It holds tool declarations and their callbacks, but no
9			transport or client state. You can therefore give the same Toolset to
10			several servers without copying or re-registering the tools.
11
12			If your program only needs one standalone server, the function interface in
13			L<AnyEvent::MCP::Server::Simple> manages a default Toolset for you.
14	root	1.1
15			=head1 REQUEST AND TOOL WORKFLOW
16
17			Register tools with C<tool>, then pass the Toolset to a server through its
18			C<toolsets> option. The server handles the protocol and transport; the Toolset
19			supplies declarations for C<tools/list> and callbacks for C<tools/call>.
20
21			For a tool call, the server creates an L<AnyEvent::MCP::Server::Request>,
22			sets C<< $req->{tool} >> and C<< $req->{args} >>, and calls its C<on_request>
23			hook. It then finds the first Toolset containing that tool and invokes its
24			callback as C<$callback->($req, $args)>. C<$args> is the same hash reference
25			as C<< $req->{args} >>; C<< $req->{toolset} >> identifies the invoking Toolset.
26
27			The input schema describes the arguments to the client; the server does not
28			validate arguments against it. The handler must validate the arguments it
29			uses and complete the request with one reply.
30
31			=head2 Permission checks and retries
32
33			Configure the server's C<permissions> option with an
34			L<AnyEvent::MCP::Server::Permissions> object. The handler can check several
35			paths or operations in sequence:
36
37			sub {
38			my ($req, $args) = @_;
39
40			my $source_grant = $req->require_permission ({
41			tool => $req->{tool}, subject => $args->{source},
42			subjects => [{ label => "source file", subject => $args->{source} }],
43			capabilities => ["read"], reason => "read the source file",
44			});
45
46			my $destination_grant = $req->require_permission ({
47			tool => $req->{tool}, subject => $args->{destination},
48			subjects => [{ label => "destination file", subject => $args->{destination} }],
49			capabilities => ["write"], reason => "write the destination file",
50			});
51
52			... # read using $source_grant, write using $destination_grant
53			$req->result ({ ... });
54			}
55
56			Capability names and their implications belong to the application.
57			C<require_permission> returns the granted capability array reference, which
58			may be smaller than the requested set. Execute using those grants rather
59			than assuming that everything requested was allowed.
60
61			Grants are separate; Server does not combine them. When reading the source
62			and writing the destination separately, use each grant for its corresponding
63			operation.
64
65			Combining authority is needed when one operation spans several subjects,
66			such as renaming a file. Request the required capabilities for every affected
67			path: a rename needs write authority for both source and destination, unlike
68			the read/write example above. Check that every grant still permits the
69			operation after any reductions. For an application whose C<write> capability
70			authorizes rename, after requesting C<["write"]> for both paths:
71
72			my $permissions = $req->{server}{permissions};
73			my $source = $permissions->closure ($source_grant);
74			my $destination = $permissions->closure ($destination_grant);
75
76			die "Rename needs write permission for both paths\n"
77			unless $source->{write} && $destination->{write};
78
79			C<closure> includes implied capabilities. If the operation needs one combined
80			capability set, use the intersection of these closures, rather than their
81			union: authority granted for one path must not authorize the other.
82			Do this before starting the operation.
83
84			A denial dies and becomes a tool error. The first missing permission throws
85			a special exception: Server catches it and asks. Modern MCP asking replies
86			with C<input_required>; the client supplies the answer in a repeated call.
87			Local asking, including the legacy fallback, retries the handler internally.
88			An explicit local asking configuration also applies to modern callers.
89
90			The handler starts again from the beginning, including the server's
91			C<on_request> hook. Earlier one-time grants survive these retries but do not
92			authorize another tool invocation. Current rules are rechecked, so a new
93			denial can supersede an earlier approval.
94
95			Complete all checks before side effects or asynchronous work. Do not catch
96			the permission-needed exception as an ordinary tool failure; it must reach
97			the server's synchronous dispatch boundary. A deferred callback cannot use
98			that boundary to restart the handler.
99
100			=head2 Replies and failures
101
102			=over
103
104			=item $req->reply ($result)
105
106			Sends the MCP result hash reference as supplied. Use this for arbitrary
107			content, structured errors or large results. The server adds the JSON-RPC
108			envelope.
109
110			=item $req->result ($data)
111
112			Sends the hash reference C<$data> as C<structuredContent> and also as JSON in
113			one text content item. This duplicates the data for clients that consume
114			only text; use C<reply> when that representation is unsuitable.
115
116			=item $req->error ($message)
117
118			Sends a tool result with C<isError> set and C<$message> as one text item.
119
120			=back
121
122			A synchronous handler exception becomes a tool error. Tool failures do not
123			become JSON-RPC errors; malformed protocol requests and unknown tools are
124			handled by Server.
125
126			Reply exactly once. Replying after completion is a bug and dies. A reply
127			finishes the request, but returning from the callback does not.
128
129			=head2 Asynchronous work and cancellation
130
131			The callback may keep C<$req> and return without replying. Reply when the
132			operation completes. The callback runs in the event loop; use asynchronous
133			operations rather than blocking it.
134
135			Set C<< $req->{on_cancel} >> to stop an outstanding operation. Cancellation
136			sets C<< $req->{cancelled} >> and C<< $req->{finished} >> and sends no reply.
137			A late completion callback must check C<< $req->{finished} >> before replying.
138
139			Server catches exceptions during synchronous dispatch, not exceptions in
140			later application callbacks. Such callbacks must handle their own failures.
141
142			C<< $req->progress ($progress, $total, $message) >> reports progress when
143			the client supplied a progress token. Delivery is best effort and may be
144			dropped by the transport; it does not complete the request.
145
146			=head1 METHODS
147
148			=over
149
150			=item $toolset = AnyEvent::MCP::Server::Toolset->new
151
152			Creates an empty tool registry.
153
154			=item $toolset->tool ($name, $description, $input_schema, $callback->($req, $args))
155
156			Registers a tool named C<$name>. Underscores are converted to hyphens and
157			duplicate names are rejected.
158
159			C<$description> is stripped of surrounding whitespace and common indentation.
160			C<$input_schema> is a JSON Schema hash reference describing the arguments.
161
162			C<$callback> receives an L<AnyEvent::MCP::Server::Request> object C<$req>
163			and its C<< $req->{args} >> hash reference as C<$args>, for convenience:
164
165			sub {
166			my ($req, $args) = @_;
167
168			$req->reply ({
169			content => [{ type => "text", text => $args->{text} }],
170			});
171			}
172
173			Registered tools are callbacks, not methods of the Toolset.
174
175			=item $definitions = $toolset->list
176
177			Returns the array reference of MCP tool definitions in registration order.
178			C<$definitions> contains no callbacks.
179
180			=item $toolset->call ($req)
181
182			Invokes the tool named by C<< $req->{tool} >> with C<$req> and
183			C<< $req->{args} >>. Sets C<< $req->{toolset} >> to this Toolset.
184
185			Unknown names and exceptions from the callback are left for the server to
186			handle.
187
188			=back
189
190			=cut
191
192			package AnyEvent::MCP::Server::Toolset;
193
194			use common::sense;
195			use AnyEvent::MCP ();
196
197			our @ISA = qw(AnyEvent::MCP::Base);
198
199			sub new {
200			my $class = shift;
201
202			$class->SUPER::new (tool => {}, list => [], @_)
203			}
204
205			sub tool {
206			my ($self, $name, $description, $input_schema, $callback) = @_;
207
208			$name =~ y/_/-/;
209
210			die "duplicate MCP tool '$name'\n"
211			if exists $self->{tool}{$name};
212
213			my $definition = {
214			name => $name,
215			description => AnyEvent::MCP::_clean_text $description,
216			inputSchema => $input_schema,
217			};
218
219			$self->{tool}{$name} = {
220			definition => $definition,
221			callback => $callback,
222			};
223
224			push @{$self->{list}}, $definition;
225			}
226
227			sub list {
228			$_[0]{list}
229			}
230
231			sub call {
232			my ($self, $req) = @_;
233			my $name = $req->{tool};
234
235			my $tool = $self->{tool}{$name}
236			or die "unknown MCP tool '$name'\n";
237
238			$req->{toolset} = $self;
239			$tool->{callback}->($req, $req->{args})
240			}
241
242			1