My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1(** High-level MCP server session API.
2
3 This module provides a convenient server-side API for hosting MCP servers.
4 It handles the initialization handshake, routes incoming requests to handlers,
5 and provides helpers for sending notifications to clients.
6
7 {1 Example Usage}
8
9 {[
10 let config = {
11 server_info = Capabilities.Implementation.make
12 ~name:"my-server"
13 ~version:"1.0.0";
14 server_capabilities = Capabilities.Server.make
15 ~tools:(Some (Capabilities.Tools.make ()))
16 ();
17 instructions = Some "This is my MCP server";
18 } in
19
20 let handlers = {
21 list_tools = Some (fun ~cursor ->
22 Messages.Tools.make_list_result
23 ~tools:[
24 Messages.Tools.make_tool
25 ~name:"example"
26 ~description:"An example tool"
27 ~input_schema:(`Object [])
28 ();
29 ]
30 ()
31 );
32 call_tool = Some (fun ~name ~arguments ->
33 Messages.Tools.make_call_result
34 ~content:[Content.text "Tool result"]
35 ()
36 );
37 (* ... other handlers ... *)
38 list_resources = None;
39 list_resource_templates = None;
40 read_resource = None;
41 subscribe_resource = None;
42 unsubscribe_resource = None;
43 list_prompts = None;
44 get_prompt = None;
45 complete = None;
46 ping = None;
47 } in
48
49 Eio.Switch.run @@ fun sw ->
50 let server = Server_session.create
51 ~sw
52 ~transport
53 config
54 handlers
55 in
56 (* Server is now running and handling requests *)
57 (* Send notifications as needed *)
58 Server_session.send_tool_list_changed server
59 ]} *)
60
61(** {1 Types} *)
62
63type t
64(** Server session handle *)
65
66(** {1 Configuration} *)
67
68type config = {
69 server_info : Capabilities.Implementation.t;
70 (** Server implementation information (name, version) *)
71 server_capabilities : Capabilities.Server.t;
72 (** Server capabilities to advertise to client *)
73 instructions : string option;
74 (** Optional instructions for using the server *)
75}
76(** Server configuration *)
77
78(** {1 Request Handlers} *)
79
80type handlers = {
81 (* Resources *)
82 list_resources : (cursor:string option -> Messages.Resources.list_result) option;
83 (** Handler for resources/list requests *)
84
85 list_resource_templates : (cursor:string option -> Messages.Resources.list_result) option;
86 (** Handler for resources/templates/list requests *)
87
88 read_resource : (uri:string -> Messages.Resources.read_result) option;
89 (** Handler for resources/read requests *)
90
91 subscribe_resource : (uri:string -> unit) option;
92 (** Handler for resources/subscribe requests *)
93
94 unsubscribe_resource : (uri:string -> unit) option;
95 (** Handler for resources/unsubscribe requests *)
96
97 (* Tools *)
98 list_tools : (cursor:string option -> Messages.Tools.list_result) option;
99 (** Handler for tools/list requests *)
100
101 call_tool : (name:string -> arguments:Jsont.json option -> Messages.Tools.call_result) option;
102 (** Handler for tools/call requests *)
103
104 (* Prompts *)
105 list_prompts : (cursor:string option -> Messages.Prompts.list_result) option;
106 (** Handler for prompts/list requests *)
107
108 get_prompt : (name:string -> arguments:(string * string) list option -> Messages.Prompts.get_result) option;
109 (** Handler for prompts/get requests *)
110
111 (* Completions *)
112 complete : (ref_:Messages.Completions.completion_ref -> argument:string -> Messages.Completions.result) option;
113 (** Handler for completion/complete requests *)
114
115 (* Ping *)
116 ping : (unit -> unit) option;
117 (** Handler for ping requests *)
118}
119(** Request handler callbacks.
120 Set to [None] to indicate the method is not supported.
121 If a request is received for an unsupported method, a METHOD_NOT_FOUND error is returned. *)
122
123(** {1 Server Creation} *)
124
125val create :
126 sw:Eio.Switch.t ->
127 transport:Transport.t ->
128 ?timeout:float ->
129 ?clock:Session.clock ->
130 config ->
131 handlers ->
132 t
133(** Create and initialize a server session.
134
135 This function:
136 1. Creates an underlying Session
137 2. Waits for the Initialize request from the client
138 3. Returns the Initialize response with server capabilities
139 4. Waits for the Initialized notification
140 5. Returns a ready-to-use server session
141
142 The server will then handle incoming requests by routing them to the provided handlers.
143
144 @param sw Switch for the session background fibers
145 @param transport Transport layer for communication
146 @param timeout Optional request timeout in seconds
147 @param clock Optional clock for timeout handling (required if timeout is set)
148 @raise Invalid_argument if initialization fails or times out *)
149
150(** {1 Client Information} *)
151
152val client_capabilities : t -> Capabilities.Client.t
153(** Get the client's advertised capabilities *)
154
155val client_info : t -> Capabilities.Implementation.t
156(** Get the client's implementation information *)
157
158val protocol_version : t -> string
159(** Get the negotiated protocol version *)
160
161(** {1 Sending Notifications} *)
162
163val send_resource_updated : t -> uri:string -> unit
164(** Send a notification that a resource has been updated.
165 Only works if client supports resource subscriptions.
166 @param uri The URI of the updated resource *)
167
168val send_resource_list_changed : t -> unit
169(** Send a notification that the resource list has changed.
170 Only works if client supports resource list_changed capability. *)
171
172val send_tool_list_changed : t -> unit
173(** Send a notification that the tool list has changed.
174 Only works if server advertised tools capability. *)
175
176val send_prompt_list_changed : t -> unit
177(** Send a notification that the prompt list has changed.
178 Only works if server advertised prompts capability. *)
179
180val send_roots_list_changed : t -> unit
181(** Send a notification that the roots list has changed.
182 Only works if client supports roots capability. *)
183
184val send_log_message : t -> level:Messages.Logging.level -> ?logger:string -> data:Jsont.json -> unit -> unit
185(** Send a log message notification.
186 Only works if server advertised logging capability.
187 @param level Log level
188 @param logger Optional logger name
189 @param data Log message data (any JSON value) *)
190
191val send_progress : t -> progress_token:string -> progress:float -> ?total:float -> unit -> unit
192(** Send a progress notification.
193 @param progress_token Unique token identifying the operation
194 @param progress Progress value (0.0 to 1.0)
195 @param total Optional total value *)
196
197(** {1 Requesting from Client} *)
198
199val request_roots_list : t -> Messages.Roots.list_result option
200(** Request the list of roots from the client.
201 Returns [None] if the client doesn't support the roots capability.
202 @raise Session.Timeout if the request times out
203 @raise Session.Remote_error if the client returns an error *)
204
205(** {1 Session Management} *)
206
207val close : t -> unit
208(** Close the server session and underlying transport *)