commit 43c164326405ecb10948930a2e087dc72b3ed070 · anil.recoil.org/ocaml-mcp

+3 -2

bin/capitalize_sdk.ml

···

       44
       44
        
             }

     

       45
       45
        
         )

     

       46
       46
        
       

     

       47
       47
       -
       (* Define and register a resource example *)

     

       48
       48
       -
       let _ = add_resource server

     

       47
       47
       +
       (* Define and register a resource template example *)

     

       48
       48
       +
       let _ = add_resource_template server

     

       49
       49
        
         ~uri_template:"greeting://{name}"

     

       50
       50
       +
         ~name:"Greeting"

     

       50
       51
        
         ~description:"Get a greeting for a name"

     

       51
       52
        
         ~mime_type:"text/plain"

     

       52
       53
        
         (fun params ->

+3 -2

bin/multimodal_sdk.ml

···

       335
       335
        
             Tool.create_tool_result [Mcp.make_text_content (Printf.sprintf "Error: %s" msg)] ~is_error:true

     

       336
       336
        
         )

     

       337
       337
        
       

     

       338
       338
       -
       (* Define and register a resource example with multimodal content *)

     

       339
       339
       -
       let _ = add_resource server

     

       338
       338
       +
       (* Define and register a resource template example with multimodal content *)

     

       339
       339
       +
       let _ = add_resource_template server

     

       340
       340
        
         ~uri_template:"multimodal://{name}"

     

       341
       341
       +
         ~name:"Multimodal Greeting"

     

       341
       342
        
         ~description:"Get a multimodal greeting with text, image and audio"

     

       342
       343
        
         ~mime_type:"application/json"

     

       343
       344
        
         (fun params ->

+3 -3

lib/mcp.ml

···

       102
       102
        
           (* Resource methods *)

     

       103
       103
        
           | ResourcesList

     

       104
       104
        
           | ResourcesRead

     

       105
       105
       -
           | ResourcesTemplatesList

     

       105
       105
       +
           | ResourceTemplatesList

     

       106
       106
        
           | ResourcesSubscribe

     

       107
       107
        
           | ResourcesListChanged

     

       108
       108
        
           | ResourcesUpdated

     
···

       126
       126
        
           | Initialized -> "notifications/initialized"

     

       127
       127
        
           | ResourcesList -> "resources/list"

     

       128
       128
        
           | ResourcesRead -> "resources/read"

     

       129
       129
       -
           | ResourcesTemplatesList -> "resources/templates/list"

     

       129
       129
       +
           | ResourceTemplatesList -> "resources/templates/list"

     

       130
       130
        
           | ResourcesSubscribe -> "resources/subscribe"

     

       131
       131
        
           | ResourcesListChanged -> "notifications/resources/list_changed"

     

       132
       132
        
           | ResourcesUpdated -> "notifications/resources/updated"

     
···

       144
       144
        
           | "notifications/initialized" -> Initialized

     

       145
       145
        
           | "resources/list" -> ResourcesList

     

       146
       146
        
           | "resources/read" -> ResourcesRead

     

       147
       147
       -
           | "resources/templates/list" -> ResourcesTemplatesList

     

       147
       147
       +
           | "resources/templates/list" -> ResourceTemplatesList

     

       148
       148
        
           | "resources/subscribe" -> ResourcesSubscribe

     

       149
       149
        
           | "notifications/resources/list_changed" -> ResourcesListChanged

     

       150
       150
        
           | "notifications/resources/updated" -> ResourcesUpdated

+1 -1

lib/mcp.mli

···

       142
       142
        
           (* Resource methods *)

     

       143
       143
        
           | ResourcesList           (** Discover available resources *)

     

       144
       144
        
           | ResourcesRead           (** Retrieve resource contents *)

     

       145
       145
       -
           | ResourcesTemplatesList  (** List available resource templates *)

     

       145
       145
       +
           | ResourceTemplatesList  (** List available resource templates *)

     

       146
       146
        
           | ResourcesSubscribe      (** Subscribe to resource changes *)

     

       147
       147
        
           | ResourcesListChanged    (** Resource list has changed *)

     

       148
       148
        
           | ResourcesUpdated        (** Resource has been updated *)

+108

lib/mcp_rpc.ml

···

       122
       122
        
           JSONRPCMessage.create_response ~id ~result

     

       123
       123
        
       end

     

       124
       124
        
       

     

       125
       125
       +
       (* Resources/Templates/List *)

     

       126
       126
       +
       module ListResourceTemplatesRequest = struct

     

       127
       127
       +
         type t = {

     

       128
       128
       +
           cursor: Cursor.t option;

     

       129
       129
       +
         }

     

       130
       130
       +
         

     

       131
       131
       +
         let yojson_of_t { cursor } =

     

       132
       132
       +
           let assoc = [] in

     

       133
       133
       +
           let assoc = match cursor with

     

       134
       134
       +
             | Some c -> ("cursor", Cursor.yojson_of_t c) :: assoc

     

       135
       135
       +
             | None -> assoc

     

       136
       136
       +
           in

     

       137
       137
       +
           `Assoc assoc

     

       138
       138
       +
         

     

       139
       139
       +
         let t_of_yojson = function

     

       140
       140
       +
           | `Assoc fields ->

     

       141
       141
       +
             let cursor = List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson in

     

       142
       142
       +
             { cursor }

     

       143
       143
       +
           | j -> Util.json_error "Expected object for ListResourceTemplatesRequest.t" j

     

       144
       144
       +
           

     

       145
       145
       +
       end

     

       146
       146
       +
       

     

       147
       147
       +
       (* Resources/Templates/List Response *)

     

       148
       148
       +
       module ListResourceTemplatesResult = struct

     

       149
       149
       +
         module ResourceTemplate = struct

     

       150
       150
       +
           type t = {

     

       151
       151
       +
             uri_template: string;

     

       152
       152
       +
             name: string;

     

       153
       153
       +
             description: string option;

     

       154
       154
       +
             mime_type: string option;

     

       155
       155
       +
           }

     

       156
       156
       +
           

     

       157
       157
       +
           let yojson_of_t { uri_template; name; description; mime_type } =

     

       158
       158
       +
             let assoc = [

     

       159
       159
       +
               ("uriTemplate", `String uri_template);

     

       160
       160
       +
               ("name", `String name);

     

       161
       161
       +
             ] in

     

       162
       162
       +
             let assoc = match description with

     

       163
       163
       +
               | Some desc -> ("description", `String desc) :: assoc

     

       164
       164
       +
               | None -> assoc

     

       165
       165
       +
             in

     

       166
       166
       +
             let assoc = match mime_type with

     

       167
       167
       +
               | Some mime -> ("mimeType", `String mime) :: assoc

     

       168
       168
       +
               | None -> assoc

     

       169
       169
       +
             in

     

       170
       170
       +
             `Assoc assoc

     

       171
       171
       +
           

     

       172
       172
       +
           let t_of_yojson = function

     

       173
       173
       +
             | `Assoc fields as json ->

     

       174
       174
       +
               let uri_template = match List.assoc_opt "uriTemplate" fields with

     

       175
       175
       +
                 | Some (`String s) -> s

     

       176
       176
       +
                 | _ -> Util.json_error "Missing or invalid 'uriTemplate' field" json

     

       177
       177
       +
               in

     

       178
       178
       +
               let name = match List.assoc_opt "name" fields with

     

       179
       179
       +
                 | Some (`String s) -> s

     

       180
       180
       +
                 | _ -> Util.json_error "Missing or invalid 'name' field" json

     

       181
       181
       +
               in

     

       182
       182
       +
               let description = List.assoc_opt "description" fields |> Option.map (function

     

       183
       183
       +
                 | `String s -> s

     

       184
       184
       +
                 | j -> Util.json_error "Expected string for description" j

     

       185
       185
       +
               ) in

     

       186
       186
       +
               let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function

     

       187
       187
       +
                 | `String s -> s

     

       188
       188
       +
                 | j -> Util.json_error "Expected string for mimeType" j

     

       189
       189
       +
               ) in

     

       190
       190
       +
               { uri_template; name; description; mime_type }

     

       191
       191
       +
             | j -> Util.json_error "Expected object for ListResourceTemplatesResult.ResourceTemplate.t" j

     

       192
       192
       +
         end

     

       193
       193
       +
         

     

       194
       194
       +
         type t = {

     

       195
       195
       +
           resource_templates: ResourceTemplate.t list;

     

       196
       196
       +
           next_cursor: Cursor.t option;

     

       197
       197
       +
         }

     

       198
       198
       +
         

     

       199
       199
       +
         let yojson_of_t { resource_templates; next_cursor } =

     

       200
       200
       +
           let assoc = [

     

       201
       201
       +
             ("resourceTemplates", `List (List.map ResourceTemplate.yojson_of_t resource_templates));

     

       202
       202
       +
           ] in

     

       203
       203
       +
           let assoc = match next_cursor with

     

       204
       204
       +
             | Some c -> ("nextCursor", Cursor.yojson_of_t c) :: assoc

     

       205
       205
       +
             | None -> assoc

     

       206
       206
       +
           in

     

       207
       207
       +
           `Assoc assoc

     

       208
       208
       +
         

     

       209
       209
       +
         let t_of_yojson = function

     

       210
       210
       +
           | `Assoc fields as json ->

     

       211
       211
       +
             let resource_templates = match List.assoc_opt "resourceTemplates" fields with

     

       212
       212
       +
               | Some (`List items) -> List.map ResourceTemplate.t_of_yojson items

     

       213
       213
       +
               | _ -> Util.json_error "Missing or invalid 'resourceTemplates' field" json

     

       214
       214
       +
             in

     

       215
       215
       +
             let next_cursor = List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson in

     

       216
       216
       +
             { resource_templates; next_cursor }

     

       217
       217
       +
           | j -> Util.json_error "Expected object for ListResourceTemplatesResult.t" j

     

       218
       218
       +
           

     

       219
       219
       +
         (* Request/response creation helpers *)

     

       220
       220
       +
         let create_request ?cursor ?id () =

     

       221
       221
       +
           let id = match id with

     

       222
       222
       +
             | Some i -> i

     

       223
       223
       +
             | None -> `Int (Random.int 10000)

     

       224
       224
       +
           in

     

       225
       225
       +
           let params = ListResourceTemplatesRequest.yojson_of_t { cursor } in

     

       226
       226
       +
           JSONRPCMessage.create_request ~id ~meth:Method.ResourceTemplatesList ~params:(Some params) ()

     

       227
       227
       +
         

     

       228
       228
       +
         let create_response ~id ~resource_templates ?next_cursor () =

     

       229
       229
       +
           let result = yojson_of_t { resource_templates; next_cursor } in

     

       230
       230
       +
           JSONRPCMessage.create_response ~id ~result

     

       231
       231
       +
       end

     

       232
       232
       +
       

     

       125
       233
        
       (* Resources/Read *)

     

       126
       234
        
       module ResourcesRead = struct

     

       127
       235
        
         module Request = struct

+34

lib/mcp_rpc.mli

···

       41
       41
        
         val create_response : id:RequestId.t -> resources:Resource.t list -> ?next_cursor:Cursor.t -> unit -> JSONRPCMessage.t

     

       42
       42
        
       end

     

       43
       43
        
       

     

       44
       44
       +
       (** Resources/Templates/List - Request to list available resource templates *)

     

       45
       45
       +
       module ListResourceTemplatesRequest : sig

     

       46
       46
       +
         type t = {

     

       47
       47
       +
           cursor: Cursor.t option; (** Optional pagination cursor *)

     

       48
       48
       +
         }

     

       49
       49
       +
         include Json.Jsonable.S with type t := t

     

       50
       50
       +
       end

     

       51
       51
       +
       

     

       52
       52
       +
       (** Resources/Templates/List - Response with resource templates *)

     

       53
       53
       +
       module ListResourceTemplatesResult : sig

     

       54
       54
       +
         (** Resource Template definition *)

     

       55
       55
       +
         module ResourceTemplate : sig

     

       56
       56
       +
           type t = {

     

       57
       57
       +
             uri_template: string; (** URI template for the resource *)

     

       58
       58
       +
             name: string; (** Human-readable name *)

     

       59
       59
       +
             description: string option; (** Optional description *)

     

       60
       60
       +
             mime_type: string option; (** Optional MIME type *)

     

       61
       61
       +
           }

     

       62
       62
       +
           include Json.Jsonable.S with type t := t

     

       63
       63
       +
         end

     

       64
       64
       +
         

     

       65
       65
       +
         type t = {

     

       66
       66
       +
           resource_templates: ResourceTemplate.t list; (** List of available resource templates *)

     

       67
       67
       +
           next_cursor: Cursor.t option; (** Optional cursor for the next page *)

     

       68
       68
       +
         }

     

       69
       69
       +
         include Json.Jsonable.S with type t := t

     

       70
       70
       +
         

     

       71
       71
       +
         (** Create a resources/templates/list request *)

     

       72
       72
       +
         val create_request : ?cursor:Cursor.t -> ?id:RequestId.t -> unit -> JSONRPCMessage.t

     

       73
       73
       +
         

     

       74
       74
       +
         (** Create a resources/templates/list response *)

     

       75
       75
       +
         val create_response : id:RequestId.t -> resource_templates:ResourceTemplate.t list -> ?next_cursor:Cursor.t -> unit -> JSONRPCMessage.t

     

       76
       76
       +
       end

     

       77
       77
       +
       

     

       44
       78
        
       (** Resources/Read - Request to read resource contents *)

     

       45
       79
        
       module ResourcesRead : sig

     

       46
       80
        
         (** Request parameters *)

+91 -11

lib/mcp_sdk.ml

···

       188
       188
        
         type handler = Context.t -> string list -> (string, string) result

     

       189
       189
        
       

     

       190
       190
        
         type t = {

     

       191
       191
       -
           uri_template: string;

     

       191
       191
       +
           uri: string;  (* For resources, this is the exact URI (no variables) *)

     

       192
       192
       +
           name: string;

     

       192
       193
        
           description: string option;

     

       193
       194
        
           mime_type: string option;

     

       194
       195
        
           handler: handler;

     

       195
       196
        
         }

     

       196
       197
        
       

     

       197
       197
       -
         let create ~uri_template ?description ?mime_type ~handler () = 

     

       198
       198
       -
           { uri_template; description; mime_type; handler }

     

       198
       198
       +
         let create ~uri ~name ?description ?mime_type ~handler () =

     

       199
       199
       +
           (* Validate that the URI doesn't contain template variables *)

     

       200
       200
       +
           if String.contains uri '{' || String.contains uri '}' then

     

       201
       201
       +
             Log.warningf "Resource '%s' contains template variables. Consider using add_resource_template instead." uri;

     

       202
       202
       +
           { uri; name; description; mime_type; handler }

     

       199
       203
        
       

     

       200
       204
        
         let to_json resource =

     

       201
       205
        
           let assoc = [

     

       202
       202
       -
             ("uriTemplate", `String resource.uri_template);

     

       206
       206
       +
             ("uri", `String resource.uri);

     

       207
       207
       +
             ("name", `String resource.name);

     

       203
       208
        
           ] in

     

       204
       209
        
           let assoc = match resource.description with

     

       205
       210
        
             | Some desc -> ("description", `String desc) :: assoc

     
···

       214
       219
        
         (* Convert to Mcp_rpc.ResourcesList.Resource.t *)

     

       215
       220
        
         let to_rpc_resource_list_resource (resource:t) =

     

       216
       221
        
           Mcp_rpc.ResourcesList.Resource.{

     

       217
       217
       -
             uri = resource.uri_template;

     

       218
       218
       -
             name = resource.uri_template; (* Use uri as name by default *)

     

       222
       222
       +
             uri = resource.uri;

     

       223
       223
       +
             name = resource.name;

     

       219
       224
        
             description = resource.description;

     

       220
       225
        
             mime_type = resource.mime_type;

     

       221
       226
        
             size = None; (* Size can be added when we have actual resource content *)

     
···

       331
       336
        
           ("required", required_json)

     

       332
       337
        
         ]

     

       333
       338
        
       

     

       339
       339
       +
       (* Resource Templates for the MCP server *)

     

       340
       340
       +
       module ResourceTemplate = struct

     

       341
       341
       +
         type handler = Context.t -> string list -> (string, string) result

     

       342
       342
       +
       

     

       343
       343
       +
         type t = {

     

       344
       344
       +
           uri_template: string;

     

       345
       345
       +
           name: string;

     

       346
       346
       +
           description: string option;

     

       347
       347
       +
           mime_type: string option;

     

       348
       348
       +
           handler: handler;

     

       349
       349
       +
         }

     

       350
       350
       +
       

     

       351
       351
       +
         let create ~uri_template ~name ?description ?mime_type ~handler () = 

     

       352
       352
       +
           { uri_template; name; description; mime_type; handler }

     

       353
       353
       +
       

     

       354
       354
       +
         let to_json resource_template =

     

       355
       355
       +
           let assoc = [

     

       356
       356
       +
             ("uriTemplate", `String resource_template.uri_template);

     

       357
       357
       +
             ("name", `String resource_template.name);

     

       358
       358
       +
           ] in

     

       359
       359
       +
           let assoc = match resource_template.description with

     

       360
       360
       +
             | Some desc -> ("description", `String desc) :: assoc

     

       361
       361
       +
             | None -> assoc

     

       362
       362
       +
           in

     

       363
       363
       +
           let assoc = match resource_template.mime_type with

     

       364
       364
       +
             | Some mime -> ("mimeType", `String mime) :: assoc

     

       365
       365
       +
             | None -> assoc

     

       366
       366
       +
           in

     

       367
       367
       +
           `Assoc assoc

     

       368
       368
       +
           

     

       369
       369
       +
         (* Convert to Mcp_rpc.ResourceTemplatesList.ResourceTemplate.t *)

     

       370
       370
       +
         let to_rpc_resource_template (template:t) =

     

       371
       371
       +
           Mcp_rpc.ListResourceTemplatesResult.ResourceTemplate.{

     

       372
       372
       +
             uri_template = template.uri_template;

     

       373
       373
       +
             name = template.name;

     

       374
       374
       +
             description = template.description;

     

       375
       375
       +
             mime_type = template.mime_type;

     

       376
       376
       +
           }

     

       377
       377
       +
           

     

       378
       378
       +
         (* Convert a list of ResourceTemplate.t to the format needed for resources/templates/list response *)

     

       379
       379
       +
         let to_rpc_resource_templates_list templates =

     

       380
       380
       +
           List.map to_rpc_resource_template templates

     

       381
       381
       +
       end

     

       382
       382
       +
       

     

       334
       383
        
       (* Main server type *)

     

       335
       384
        
       type server = {

     

       336
       385
        
         name: string;

     
···

       340
       389
        
         mutable capabilities: Json.t;

     

       341
       390
        
         mutable tools: Tool.t list;

     

       342
       391
        
         mutable resources: Resource.t list;

     

       392
       392
       +
         mutable resource_templates: ResourceTemplate.t list;

     

       343
       393
        
         mutable prompts: Prompt.t list;

     

       344
       394
        
       } 

     

       345
       395
        
       

     
···

       350
       400
        
       let protocol_version { protocol_version; _ } = protocol_version

     

       351
       401
        
       let tools { tools; _ } = tools

     

       352
       402
        
       let resources { resources; _ } = resources

     

       403
       403
       +
       let resource_templates { resource_templates; _ } = resource_templates

     

       353
       404
        
       let prompts { prompts; _ } = prompts

     

       354
       405
        
       

     

       355
       406
        
       (* Create a new server *)

     
···

       361
       412
        
           capabilities = `Assoc [];

     

       362
       413
        
           tools = [];

     

       363
       414
        
           resources = [];

     

       415
       415
       +
           resource_templates = [];

     

       364
       416
        
           prompts = [];

     

       365
       417
        
           lifespan_context = [];

     

       366
       418
        
         }

     

       367
       419
        
       

     

       368
       420
        
       (* Default capabilities for the server *)

     

       369
       369
       -
       let default_capabilities ?(with_tools=true) ?(with_resources=false) ?(with_prompts=false) () =

     

       421
       421
       +
       let default_capabilities ?(with_tools=true) ?(with_resources=false) ?(with_resource_templates=false) ?(with_prompts=false) () =

     

       370
       422
        
         let caps = [] in

     

       371
       423
        
         let caps = 

     

       372
       424
        
           if with_tools then

     
···

       433
       485
        
         resource

     

       434
       486
        
       

     

       435
       487
        
       (* Create and register a resource in one step *)

     

       436
       436
       -
       let add_resource server ~uri_template ?description ?mime_type handler =

     

       488
       488
       +
       let add_resource server ~uri ~name ?description ?mime_type handler =

     

       437
       489
        
         let handler' _ctx params =

     

       438
       490
        
           try

     

       439
       491
        
             Ok (handler params)

     
···

       441
       493
        
             Error (Printexc.to_string exn)

     

       442
       494
        
         in

     

       443
       495
        
         let resource = Resource.create

     

       496
       496
       +
           ~uri

     

       497
       497
       +
           ~name

     

       498
       498
       +
           ?description

     

       499
       499
       +
           ?mime_type

     

       500
       500
       +
           ~handler:handler'

     

       501
       501
       +
           ()

     

       502
       502
       +
         in

     

       503
       503
       +
         register_resource server resource

     

       504
       504
       +
       

     

       505
       505
       +
       (* Register a resource template *)

     

       506
       506
       +
       let register_resource_template server template =

     

       507
       507
       +
         server.resource_templates <- template :: server.resource_templates;

     

       508
       508
       +
         template

     

       509
       509
       +
       

     

       510
       510
       +
       (* Create and register a resource template in one step *)

     

       511
       511
       +
       let add_resource_template server ~uri_template ~name ?description ?mime_type handler =

     

       512
       512
       +
         let handler' _ctx params =

     

       513
       513
       +
           try

     

       514
       514
       +
             Ok (handler params)

     

       515
       515
       +
           with exn ->

     

       516
       516
       +
             Error (Printexc.to_string exn)

     

       517
       517
       +
         in

     

       518
       518
       +
         let template = ResourceTemplate.create

     

       444
       519
        
           ~uri_template

     

       520
       520
       +
           ~name

     

       445
       521
        
           ?description

     

       446
       522
        
           ?mime_type

     

       447
       523
        
           ~handler:handler'

     

       448
       524
        
           ()

     

       449
       525
        
         in

     

       450
       450
       -
         register_resource server resource

     

       526
       526
       +
         register_resource_template server template

     

       451
       527
        
       

     

       452
       528
        
       (* Register a prompt *)

     

       453
       529
        
       let register_prompt server prompt =

     
···

       479
       555
        
         server.capabilities <- capabilities

     

       480
       556
        
       

     

       481
       557
        
       (* Configure server with default capabilities based on registered components *)

     

       482
       482
       -
       let configure_server server ?with_tools ?with_resources ?with_prompts () =

     

       558
       558
       +
       let configure_server server ?with_tools ?with_resources ?with_resource_templates ?with_prompts () =

     

       483
       559
        
         let with_tools = match with_tools with

     

       484
       560
        
           | Some b -> b

     

       485
       561
        
           | None -> server.tools <> []

     
···

       488
       564
        
           | Some b -> b

     

       489
       565
        
           | None -> server.resources <> []

     

       490
       566
        
         in

     

       567
       567
       +
         let with_resource_templates = match with_resource_templates with

     

       568
       568
       +
           | Some b -> b

     

       569
       569
       +
           | None -> server.resource_templates <> []

     

       570
       570
       +
         in

     

       491
       571
        
         let with_prompts = match with_prompts with

     

       492
       572
        
           | Some b -> b

     

       493
       573
        
           | None -> server.prompts <> []

     

       494
       574
        
         in

     

       495
       495
       -
         let capabilities = default_capabilities ~with_tools ~with_resources ~with_prompts () in

     

       575
       575
       +
         let capabilities = default_capabilities ~with_tools ~with_resources ~with_resource_templates ~with_prompts () in

     

       496
       576
        
         set_capabilities server capabilities;

     

       497
       577
        
         server

+32 -5

lib/mcp_sdk.mli

···

       83
       83
        
         type handler = Context.t -> string list -> (string, string) result

     

       84
       84
        
       

     

       85
       85
        
         type t = {

     

       86
       86
       -
           uri_template: string;

     

       86
       86
       +
           uri: string;

     

       87
       87
       +
           name: string;

     

       87
       88
        
           description: string option;

     

       88
       89
        
           mime_type: string option;

     

       89
       90
        
           handler: handler;

     

       90
       91
        
         }

     

       91
       92
        
       

     

       92
       92
       -
         val create : uri_template:string -> ?description:string -> ?mime_type:string -> handler:handler -> unit -> t

     

       93
       93
       +
         val create : uri:string -> name:string -> ?description:string -> ?mime_type:string -> handler:handler -> unit -> t

     

       93
       94
        
         val to_json : t -> Json.t

     

       94
       95
        
         

     

       95
       96
        
         (** Convert to Mcp_rpc.ResourcesList.Resource.t *)

     
···

       99
       100
        
         val to_rpc_resources_list : t list -> Mcp_rpc.ResourcesList.Resource.t list

     

       100
       101
        
       end

     

       101
       102
        
       

     

       103
       103
       +
       (** Resource Templates for the MCP server *)

     

       104
       104
       +
       module ResourceTemplate : sig

     

       105
       105
       +
         type handler = Context.t -> string list -> (string, string) result

     

       106
       106
       +
       

     

       107
       107
       +
         type t = {

     

       108
       108
       +
           uri_template: string;

     

       109
       109
       +
           name: string;

     

       110
       110
       +
           description: string option;

     

       111
       111
       +
           mime_type: string option;

     

       112
       112
       +
           handler: handler;

     

       113
       113
       +
         }

     

       114
       114
       +
       

     

       115
       115
       +
         val create : uri_template:string -> name:string -> ?description:string -> ?mime_type:string -> handler:handler -> unit -> t

     

       116
       116
       +
         val to_json : t -> Json.t

     

       117
       117
       +
         

     

       118
       118
       +
         (** Convert to Mcp_rpc.ResourceTemplatesList.ResourceTemplate.t *)

     

       119
       119
       +
         val to_rpc_resource_template : t -> Mcp_rpc.ListResourceTemplatesResult.ResourceTemplate.t

     

       120
       120
       +
         

     

       121
       121
       +
         (** Convert a list of ResourceTemplate.t to the format needed for resources/templates/list response *)

     

       122
       122
       +
         val to_rpc_resource_templates_list : t list -> Mcp_rpc.ListResourceTemplatesResult.ResourceTemplate.t list

     

       123
       123
       +
       end

     

       124
       124
       +
       

     

       102
       125
        
       (** Prompts for the MCP server *)

     

       103
       126
        
       module Prompt : sig

     

       104
       127
        
         type argument = {

     
···

       150
       173
        
       val capabilities : server -> Json.t

     

       151
       174
        
       val tools : server -> Tool.t list

     

       152
       175
        
       val resources : server -> Resource.t list

     

       176
       176
       +
       val resource_templates : server -> ResourceTemplate.t list

     

       153
       177
        
       val prompts : server -> Prompt.t list

     

       154
       178
        
       

     

       155
       179
        
       (** Create a new server *)

     

       156
       180
        
       val create_server : name:string -> ?version:string -> ?protocol_version:string -> unit -> server

     

       157
       181
        
       

     

       158
       182
        
       (** Default capabilities for the server *)

     

       159
       159
       -
       val default_capabilities : ?with_tools:bool -> ?with_resources:bool -> ?with_prompts:bool -> unit -> Json.t

     

       183
       183
       +
       val default_capabilities : ?with_tools:bool -> ?with_resources:bool -> ?with_resource_templates:bool -> ?with_prompts:bool -> unit -> Json.t

     

       160
       184
        
       

     

       161
       185
        
       (** Create and register a tool in one step *)

     

       162
       186
        
       val add_tool : server -> name:string -> ?description:string -> ?schema_properties:(string * string * string) list -> ?schema_required:string list -> (Json.t -> Json.t) -> Tool.t

     

       163
       187
        
       

     

       164
       188
        
       (** Create and register a resource in one step *)

     

       165
       165
       -
       val add_resource : server -> uri_template:string -> ?description:string -> ?mime_type:string -> (string list -> string) -> Resource.t

     

       189
       189
       +
       val add_resource : server -> uri:string -> name:string -> ?description:string -> ?mime_type:string -> (string list -> string) -> Resource.t

     

       190
       190
       +
       

     

       191
       191
       +
       (** Create and register a resource template in one step *)

     

       192
       192
       +
       val add_resource_template : server -> uri_template:string -> name:string -> ?description:string -> ?mime_type:string -> (string list -> string) -> ResourceTemplate.t

     

       166
       193
        
       

     

       167
       194
        
       (** Create and register a prompt in one step *)

     

       168
       195
        
       val add_prompt : server -> name:string -> ?description:string -> ?arguments:(string * string option * bool) list -> ((string * string) list -> Prompt.message list) -> Prompt.t

     

       169
       196
        
       

     

       170
       197
        
       (** Configure server with default capabilities based on registered components *)

     

       171
       171
       -
       val configure_server : server -> ?with_tools:bool -> ?with_resources:bool -> ?with_prompts:bool -> unit -> server

     

       198
       198
       +
       val configure_server : server -> ?with_tools:bool -> ?with_resources:bool -> ?with_resource_templates:bool -> ?with_prompts:bool -> unit -> server

     

       172
       199
        
       

     

       173
       200
        
       val make_tool_schema : (string * string * string) list -> string list -> Json.t

+100 -47

lib/mcp_server.ml

···

       60
       60
        
         let response = Mcp_rpc.ResourcesList.create_response ~id:req.id ~resources:resources_list () in

     

       61
       61
        
         Some response

     

       62
       62
        
       

     

       63
       63
       +
       (* Utility module for resource template matching *)

     

       64
       64
       +
       module Resource_matcher = struct

     

       65
       65
       +
         (* Define variants for resource handling result *)

     

       66
       66
       +
         type resource_match =

     

       67
       67
       +
           | DirectResource of Resource.t * string list

     

       68
       68
       +
           | TemplateResource of ResourceTemplate.t * string list

     

       69
       69
       +
           | NoMatch

     

       70
       70
       +
       

     

       71
       71
       +
         (* Extract parameters from a template URI *)

     

       72
       72
       +
         let extract_template_vars template_uri uri =

     

       73
       73
       +
           (* Simple template variable extraction - could be enhanced with regex *)

     

       74
       74
       +
           let template_parts = String.split_on_char '/' template_uri in

     

       75
       75
       +
           let uri_parts = String.split_on_char '/' uri in

     

       76
       76
       +
           

     

       77
       77
       +
           if List.length template_parts <> List.length uri_parts then

     

       78
       78
       +
             None

     

       79
       79
       +
           else

     

       80
       80
       +
             (* Match parts and extract variables *)

     

       81
       81
       +
             let rec match_parts tparts uparts acc =

     

       82
       82
       +
               match tparts, uparts with

     

       83
       83
       +
               | [], [] -> Some (List.rev acc)

     

       84
       84
       +
               | th::tt, uh::ut ->

     

       85
       85
       +
                   (* Check if this part is a template variable *)

     

       86
       86
       +
                   if String.length th > 2 && 

     

       87
       87
       +
                      String.get th 0 = '{' && 

     

       88
       88
       +
                      String.get th (String.length th - 1) = '}' then

     

       89
       89
       +
                     (* Extract variable value and continue *)

     

       90
       90
       +
                     match_parts tt ut (uh::acc)

     

       91
       91
       +
                   else if th = uh then

     

       92
       92
       +
                     (* Fixed part matches, continue *)

     

       93
       93
       +
                     match_parts tt ut acc

     

       94
       94
       +
                   else

     

       95
       95
       +
                     (* Fixed part doesn't match, fail *)

     

       96
       96
       +
                     None

     

       97
       97
       +
               | _, _ -> None

     

       98
       98
       +
             in

     

       99
       99
       +
             match_parts template_parts uri_parts []

     

       100
       100
       +
       

     

       101
       101
       +
         (* Find a matching resource or template for a URI *)

     

       102
       102
       +
         let find_match server uri =

     

       103
       103
       +
           (* Try direct resource match first *)

     

       104
       104
       +
           match List.find_opt (fun resource -> resource.Resource.uri = uri) (resources server) with

     

       105
       105
       +
           | Some resource -> DirectResource (resource, [])

     

       106
       106
       +
           | None ->

     

       107
       107
       +
               (* Try template match next *)

     

       108
       108
       +
               let templates = resource_templates server in

     

       109
       109
       +
               

     

       110
       110
       +
               (* Try each template to see if it matches *)

     

       111
       111
       +
               let rec try_templates templates =

     

       112
       112
       +
                 match templates with

     

       113
       113
       +
                 | [] -> NoMatch

     

       114
       114
       +
                 | template::rest ->

     

       115
       115
       +
                     match extract_template_vars template.ResourceTemplate.uri_template uri with

     

       116
       116
       +
                     | Some params -> TemplateResource (template, params)

     

       117
       117
       +
                     | None -> try_templates rest

     

       118
       118
       +
               in

     

       119
       119
       +
               try_templates templates

     

       120
       120
       +
       end

     

       121
       121
       +
       

     

       63
       122
        
       (* Process resources/read request *)

     

       64
       123
        
       let handle_resources_read server (req:JSONRPCMessage.request) =

     

       65
       124
        
         Log.debug "Processing resources/read request";

     
···

       72
       131
        
             let uri = req_data.uri in

     

       73
       132
        
             Log.debugf "Resource URI: %s" uri;

     

       74
       133
        
             

     

       75
       75
       -
             (* Find matching resource handler by URI template *)

     

       76
       76
       -
             let find_resource_handler uri =

     

       77
       77
       -
               let parse_uri_template template uri =

     

       78
       78
       -
                 (* Simple URI template parsing: extract parameters from a URI based on a template *)

     

       79
       79
       -
                 let template_parts = String.split_on_char '/' template in

     

       80
       80
       -
                 let uri_parts = String.split_on_char '/' uri in

     

       81
       81
       -
                 

     

       82
       82
       -
                 (* If parts don't match in length, this template doesn't match *)

     

       83
       83
       -
                 if List.length template_parts <> List.length uri_parts then

     

       84
       84
       -
                   None

     

       85
       85
       -
                 else

     

       86
       86
       -
                   (* Extract parameters where template has {param} format *)

     

       87
       87
       -
                   let params, matches = 

     

       88
       88
       -
                     List.fold_left2 (fun (params, matches) template_part uri_part ->

     

       89
       89
       -
                       if String.length template_part > 2 && 

     

       90
       90
       -
                          template_part.[0] = '{' && 

     

       91
       91
       -
                          template_part.[String.length template_part - 1] = '}' then

     

       92
       92
       -
                         (* This is a parameter, extract its value *)

     

       93
       93
       -
                         let _param_name = String.sub template_part 1 (String.length template_part - 2) in

     

       94
       94
       -
                         (uri_part :: params, matches)

     

       95
       95
       -
                       else if template_part = uri_part then

     

       96
       96
       -
                         (* Constant part matches *)

     

       97
       97
       -
                         (params, true && matches)

     

       98
       98
       -
                       else

     

       99
       99
       -
                         (* Constant part doesn't match *)

     

       100
       100
       -
                         (params, false && matches)

     

       101
       101
       -
                     ) ([], true) template_parts uri_parts

     

       102
       102
       -
                   in

     

       103
       103
       -
                   

     

       104
       104
       -
                   if matches then Some (List.rev params) else None

     

       105
       105
       -
               in

     

       106
       106
       -
               

     

       107
       107
       -
               let rec find_handler = function

     

       108
       108
       -
                 | [] -> None

     

       109
       109
       -
                 | resource :: rest ->

     

       110
       110
       -
                     match parse_uri_template resource.Resource.uri_template uri with

     

       111
       111
       -
                     | Some params -> Some (resource, params)

     

       112
       112
       -
                     | None -> find_handler rest

     

       113
       113
       -
               in

     

       114
       114
       -
               

     

       115
       115
       -
               find_handler (resources server)

     

       116
       116
       -
             in

     

       117
       117
       -
             

     

       118
       118
       -
             match find_resource_handler uri with

     

       119
       119
       -
             | Some (resource, params) ->

     

       134
       134
       +
             (* Find matching resource or template *)

     

       135
       135
       +
             match Resource_matcher.find_match server uri with

     

       136
       136
       +
             | Resource_matcher.DirectResource (resource, params) ->

     

       120
       137
        
                 (* Create context for this request *)

     

       121
       138
        
                 let ctx = Context.create 

     

       122
       139
        
                   ?request_id:(Some req.id)

     
···

       124
       141
        
                   ~lifespan_context:[("resources/read", `Assoc [("uri", `String uri)])] 

     

       125
       142
        
                   () 

     

       126
       143
        
                 in

     

       144
       144
       +
                 

     

       145
       145
       +
                 Log.debugf "Handling direct resource: %s" resource.name;

     

       127
       146
        
                 

     

       128
       147
        
                 (* Call the resource handler *)

     

       129
       148
        
                 (match resource.handler ctx params with

     
···

       144
       163
        
                  | Error err ->

     

       145
       164
        
                      Log.errorf "Error reading resource: %s" err;

     

       146
       165
        
                      Some (create_jsonrpc_error req.id ErrorCode.InternalError ("Error reading resource: " ^ err) ()))

     

       147
       147
       -
             | None ->

     

       166
       166
       +
                      

     

       167
       167
       +
             | Resource_matcher.TemplateResource (template, params) ->

     

       168
       168
       +
                 (* Create context for this request *)

     

       169
       169
       +
                 let ctx = Context.create 

     

       170
       170
       +
                   ?request_id:(Some req.id)

     

       171
       171
       +
                   ?progress_token:req.progress_token

     

       172
       172
       +
                   ~lifespan_context:[("resources/read", `Assoc [("uri", `String uri)])] 

     

       173
       173
       +
                   () 

     

       174
       174
       +
                 in

     

       175
       175
       +
                 

     

       176
       176
       +
                 Log.debugf "Handling resource template: %s with params: [%s]" 

     

       177
       177
       +
                   template.name 

     

       178
       178
       +
                   (String.concat ", " params);

     

       179
       179
       +
                 

     

       180
       180
       +
                 (* Call the template handler *)

     

       181
       181
       +
                 (match template.handler ctx params with

     

       182
       182
       +
                  | Ok content ->

     

       183
       183
       +
                      (* Create text resource content *)

     

       184
       184
       +
                      let mime_type = match template.mime_type with

     

       185
       185
       +
                        | Some mime -> mime

     

       186
       186
       +
                        | None -> "text/plain"

     

       187
       187
       +
                      in

     

       188
       188
       +
                      let text_resource = {

     

       189
       189
       +
                        TextResourceContents.uri;

     

       190
       190
       +
                        text = content;

     

       191
       191
       +
                        mime_type = Some mime_type

     

       192
       192
       +
                      } in

     

       193
       193
       +
                      let resource_content = Mcp_rpc.ResourcesRead.ResourceContent.TextResource text_resource in

     

       194
       194
       +
                      let response = Mcp_rpc.ResourcesRead.create_response ~id:req.id ~contents:[resource_content] () in

     

       195
       195
       +
                      Some response

     

       196
       196
       +
                  | Error err ->

     

       197
       197
       +
                      Log.errorf "Error reading resource template: %s" err;

     

       198
       198
       +
                      Some (create_jsonrpc_error req.id ErrorCode.InternalError ("Error reading resource template: " ^ err) ()))

     

       199
       199
       +
             

     

       200
       200
       +
             | Resource_matcher.NoMatch ->

     

       148
       201
        
                 Log.errorf "Resource not found: %s" uri;

     

       149
       202
        
                 Some (create_jsonrpc_error req.id ErrorCode.InvalidParams ("Resource not found: " ^ uri) ())

     

       150
       203
        
       

     
···

       377
       430
        
             ()

     

       378
       431
        
         | exn ->

     

       379
       432
        
             Log.errorf "Exception while reading: %s" (Printexc.to_string exn);

     

       380
       380
       -
             ()

     

       433
       433
       +
             ()