MCP/Server/Toolset.pm

=head1 NAME

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

=head1 DESCRIPTION

A Toolset holds tool declarations and their callbacks. It can be shared by
multiple servers and contains no transport or client state.

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