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

+3 -2

bin/capitalize_sdk.ml

···

       44
        
             }

     

       45
        
         )

     

       46
        
       

     

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

     

       48
       -
       let _ = add_resource server

     

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

     

       0
        
       
     

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

     

       51
        
         ~mime_type:"text/plain"

     

       52
        
         (fun params ->

···

       44
        
             }

     

       45
        
         )

     

       46
        
       

     

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

     

       48
       +
       let _ = add_resource_template server

     

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

     

       50
       +
         ~name:"Greeting"

     

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

     

       52
        
         ~mime_type:"text/plain"

     

       53
        
         (fun params ->

+3 -2

bin/multimodal_sdk.ml

···

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

     

       336
        
         )

     

       337
        
       

     

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

     

       339
       -
       let _ = add_resource server

     

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

     

       0
        
       
     

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

     

       342
        
         ~mime_type:"application/json"

     

       343
        
         (fun params ->

···

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

     

       336
        
         )

     

       337
        
       

     

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

     

       339
       +
       let _ = add_resource_template server

     

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

     

       341
       +
         ~name:"Multimodal Greeting"

     

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

     

       343
        
         ~mime_type:"application/json"

     

       344
        
         (fun params ->

+3 -3

lib/mcp.ml

···

       102
        
           (* Resource methods *)

     

       103
        
           | ResourcesList

     

       104
        
           | ResourcesRead

     

       105
       -
           | ResourcesTemplatesList

     

       106
        
           | ResourcesSubscribe

     

       107
        
           | ResourcesListChanged

     

       108
        
           | ResourcesUpdated

     
···

       126
        
           | Initialized -> "notifications/initialized"

     

       127
        
           | ResourcesList -> "resources/list"

     

       128
        
           | ResourcesRead -> "resources/read"

     

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

     

       130
        
           | ResourcesSubscribe -> "resources/subscribe"

     

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

     

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

     
···

       144
        
           | "notifications/initialized" -> Initialized

     

       145
        
           | "resources/list" -> ResourcesList

     

       146
        
           | "resources/read" -> ResourcesRead

     

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

     

       148
        
           | "resources/subscribe" -> ResourcesSubscribe

     

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

     

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

···

       102
        
           (* Resource methods *)

     

       103
        
           | ResourcesList

     

       104
        
           | ResourcesRead

     

       105
       +
           | ResourceTemplatesList

     

       106
        
           | ResourcesSubscribe

     

       107
        
           | ResourcesListChanged

     

       108
        
           | ResourcesUpdated

     
···

       126
        
           | Initialized -> "notifications/initialized"

     

       127
        
           | ResourcesList -> "resources/list"

     

       128
        
           | ResourcesRead -> "resources/read"

     

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

     

       130
        
           | ResourcesSubscribe -> "resources/subscribe"

     

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

     

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

     
···

       144
        
           | "notifications/initialized" -> Initialized

     

       145
        
           | "resources/list" -> ResourcesList

     

       146
        
           | "resources/read" -> ResourcesRead

     

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

     

       148
        
           | "resources/subscribe" -> ResourcesSubscribe

     

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

     

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

+1 -1

lib/mcp.mli

···

       142
        
           (* Resource methods *)

     

       143
        
           | ResourcesList           (** Discover available resources *)

     

       144
        
           | ResourcesRead           (** Retrieve resource contents *)

     

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

     

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

     

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

     

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

···

       142
        
           (* Resource methods *)

     

       143
        
           | ResourcesList           (** Discover available resources *)

     

       144
        
           | ResourcesRead           (** Retrieve resource contents *)

     

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

     

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

     

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

     

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

+108

lib/mcp_rpc.ml

···

       122
        
           JSONRPCMessage.create_response ~id ~result

     

       123
        
       end

     

       124
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       125
        
       (* Resources/Read *)

     

       126
        
       module ResourcesRead = struct

     

       127
        
         module Request = struct

···

       122
        
           JSONRPCMessage.create_response ~id ~result

     

       123
        
       end

     

       124
        
       

     

       125
       +
       (* Resources/Templates/List *)

     

       126
       +
       module ListResourceTemplatesRequest = struct

     

       127
       +
         type t = {

     

       128
       +
           cursor: Cursor.t option;

     

       129
       +
         }

     

       130
       +
         

     

       131
       +
         let yojson_of_t { cursor } =

     

       132
       +
           let assoc = [] in

     

       133
       +
           let assoc = match cursor with

     

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

     

       135
       +
             | None -> assoc

     

       136
       +
           in

     

       137
       +
           `Assoc assoc

     

       138
       +
         

     

       139
       +
         let t_of_yojson = function

     

       140
       +
           | `Assoc fields ->

     

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

     

       142
       +
             { cursor }

     

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

     

       144
       +
           

     

       145
       +
       end

     

       146
       +
       

     

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

     

       148
       +
       module ListResourceTemplatesResult = struct

     

       149
       +
         module ResourceTemplate = struct

     

       150
       +
           type t = {

     

       151
       +
             uri_template: string;

     

       152
       +
             name: string;

     

       153
       +
             description: string option;

     

       154
       +
             mime_type: string option;

     

       155
       +
           }

     

       156
       +
           

     

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

     

       158
       +
             let assoc = [

     

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

     

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

     

       161
       +
             ] in

     

       162
       +
             let assoc = match description with

     

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

     

       164
       +
               | None -> assoc

     

       165
       +
             in

     

       166
       +
             let assoc = match mime_type with

     

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

     

       168
       +
               | None -> assoc

     

       169
       +
             in

     

       170
       +
             `Assoc assoc

     

       171
       +
           

     

       172
       +
           let t_of_yojson = function

     

       173
       +
             | `Assoc fields as json ->

     

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

     

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

     

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

     

       177
       +
               in

     

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

     

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

     

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

     

       181
       +
               in

     

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

     

       183
       +
                 | `String s -> s

     

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

     

       185
       +
               ) in

     

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

     

       187
       +
                 | `String s -> s

     

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

     

       189
       +
               ) in

     

       190
       +
               { uri_template; name; description; mime_type }

     

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

     

       192
       +
         end

     

       193
       +
         

     

       194
       +
         type t = {

     

       195
       +
           resource_templates: ResourceTemplate.t list;

     

       196
       +
           next_cursor: Cursor.t option;

     

       197
       +
         }

     

       198
       +
         

     

       199
       +
         let yojson_of_t { resource_templates; next_cursor } =

     

       200
       +
           let assoc = [

     

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

     

       202
       +
           ] in

     

       203
       +
           let assoc = match next_cursor with

     

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

     

       205
       +
             | None -> assoc

     

       206
       +
           in

     

       207
       +
           `Assoc assoc

     

       208
       +
         

     

       209
       +
         let t_of_yojson = function

     

       210
       +
           | `Assoc fields as json ->

     

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

     

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

     

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

     

       214
       +
             in

     

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

     

       216
       +
             { resource_templates; next_cursor }

     

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

     

       218
       +
           

     

       219
       +
         (* Request/response creation helpers *)

     

       220
       +
         let create_request ?cursor ?id () =

     

       221
       +
           let id = match id with

     

       222
       +
             | Some i -> i

     

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

     

       224
       +
           in

     

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

     

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

     

       227
       +
         

     

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

     

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

     

       230
       +
           JSONRPCMessage.create_response ~id ~result

     

       231
       +
       end

     

       232
       +
       

     

       233
        
       (* Resources/Read *)

     

       234
        
       module ResourcesRead = struct

     

       235
        
         module Request = struct

+34

lib/mcp_rpc.mli

···

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

     

       42
        
       end

     

       43
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

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

     

       45
        
       module ResourcesRead : sig

     

       46
        
         (** Request parameters *)

···

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

     

       42
        
       end

     

       43
        
       

     

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

     

       45
       +
       module ListResourceTemplatesRequest : sig

     

       46
       +
         type t = {

     

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

     

       48
       +
         }

     

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

     

       50
       +
       end

     

       51
       +
       

     

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

     

       53
       +
       module ListResourceTemplatesResult : sig

     

       54
       +
         (** Resource Template definition *)

     

       55
       +
         module ResourceTemplate : sig

     

       56
       +
           type t = {

     

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

     

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

     

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

     

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

     

       61
       +
           }

     

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

     

       63
       +
         end

     

       64
       +
         

     

       65
       +
         type t = {

     

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

     

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

     

       68
       +
         }

     

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

     

       70
       +
         

     

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

     

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

     

       73
       +
         

     

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

     

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

     

       76
       +
       end

     

       77
       +
       

     

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

     

       79
        
       module ResourcesRead : sig

     

       80
        
         (** Request parameters *)

+91 -11

lib/mcp_sdk.ml

···

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

     

       189
        
       

     

       190
        
         type t = {

     

       191
       -
           uri_template: string;

     

       0
        
       
     

       192
        
           description: string option;

     

       193
        
           mime_type: string option;

     

       194
        
           handler: handler;

     

       195
        
         }

     

       196
        
       

     

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

     

       198
       -
           { uri_template; description; mime_type; handler }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       199
        
       

     

       200
        
         let to_json resource =

     

       201
        
           let assoc = [

     

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

     

       0
        
       
     

       203
        
           ] in

     

       204
        
           let assoc = match resource.description with

     

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

     
···

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

     

       215
        
         let to_rpc_resource_list_resource (resource:t) =

     

       216
        
           Mcp_rpc.ResourcesList.Resource.{

     

       217
       -
             uri = resource.uri_template;

     

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

     

       219
        
             description = resource.description;

     

       220
        
             mime_type = resource.mime_type;

     

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

     
···

       331
        
           ("required", required_json)

     

       332
        
         ]

     

       333
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       334
        
       (* Main server type *)

     

       335
        
       type server = {

     

       336
        
         name: string;

     
···

       340
        
         mutable capabilities: Json.t;

     

       341
        
         mutable tools: Tool.t list;

     

       342
        
         mutable resources: Resource.t list;

     

       0
        
       
     

       343
        
         mutable prompts: Prompt.t list;

     

       344
        
       } 

     

       345
        
       

     
···

       350
        
       let protocol_version { protocol_version; _ } = protocol_version

     

       351
        
       let tools { tools; _ } = tools

     

       352
        
       let resources { resources; _ } = resources

     

       0
        
       
     

       353
        
       let prompts { prompts; _ } = prompts

     

       354
        
       

     

       355
        
       (* Create a new server *)

     
···

       361
        
           capabilities = `Assoc [];

     

       362
        
           tools = [];

     

       363
        
           resources = [];

     

       0
        
       
     

       364
        
           prompts = [];

     

       365
        
           lifespan_context = [];

     

       366
        
         }

     

       367
        
       

     

       368
        
       (* Default capabilities for the server *)

     

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

     

       370
        
         let caps = [] in

     

       371
        
         let caps = 

     

       372
        
           if with_tools then

     
···

       433
        
         resource

     

       434
        
       

     

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

     

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

     

       437
        
         let handler' _ctx params =

     

       438
        
           try

     

       439
        
             Ok (handler params)

     
···

       441
        
             Error (Printexc.to_string exn)

     

       442
        
         in

     

       443
        
         let resource = Resource.create

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       444
        
           ~uri_template

     

       0
        
       
     

       445
        
           ?description

     

       446
        
           ?mime_type

     

       447
        
           ~handler:handler'

     

       448
        
           ()

     

       449
        
         in

     

       450
       -
         register_resource server resource

     

       451
        
       

     

       452
        
       (* Register a prompt *)

     

       453
        
       let register_prompt server prompt =

     
···

       479
        
         server.capabilities <- capabilities

     

       480
        
       

     

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

     

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

     

       483
        
         let with_tools = match with_tools with

     

       484
        
           | Some b -> b

     

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

     
···

       488
        
           | Some b -> b

     

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

     

       490
        
         in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       491
        
         let with_prompts = match with_prompts with

     

       492
        
           | Some b -> b

     

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

     

       494
        
         in

     

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

     

       496
        
         set_capabilities server capabilities;

     

       497
        
         server

···

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

     

       189
        
       

     

       190
        
         type t = {

     

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

     

       192
       +
           name: string;

     

       193
        
           description: string option;

     

       194
        
           mime_type: string option;

     

       195
        
           handler: handler;

     

       196
        
         }

     

       197
        
       

     

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

     

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

     

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

     

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

     

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

     

       203
        
       

     

       204
        
         let to_json resource =

     

       205
        
           let assoc = [

     

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

     

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

     

       208
        
           ] in

     

       209
        
           let assoc = match resource.description with

     

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

     
···

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

     

       220
        
         let to_rpc_resource_list_resource (resource:t) =

     

       221
        
           Mcp_rpc.ResourcesList.Resource.{

     

       222
       +
             uri = resource.uri;

     

       223
       +
             name = resource.name;

     

       224
        
             description = resource.description;

     

       225
        
             mime_type = resource.mime_type;

     

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

     
···

       336
        
           ("required", required_json)

     

       337
        
         ]

     

       338
        
       

     

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

     

       340
       +
       module ResourceTemplate = struct

     

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

     

       342
       +
       

     

       343
       +
         type t = {

     

       344
       +
           uri_template: string;

     

       345
       +
           name: string;

     

       346
       +
           description: string option;

     

       347
       +
           mime_type: string option;

     

       348
       +
           handler: handler;

     

       349
       +
         }

     

       350
       +
       

     

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

     

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

     

       353
       +
       

     

       354
       +
         let to_json resource_template =

     

       355
       +
           let assoc = [

     

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

     

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

     

       358
       +
           ] in

     

       359
       +
           let assoc = match resource_template.description with

     

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

     

       361
       +
             | None -> assoc

     

       362
       +
           in

     

       363
       +
           let assoc = match resource_template.mime_type with

     

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

     

       365
       +
             | None -> assoc

     

       366
       +
           in

     

       367
       +
           `Assoc assoc

     

       368
       +
           

     

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

     

       370
       +
         let to_rpc_resource_template (template:t) =

     

       371
       +
           Mcp_rpc.ListResourceTemplatesResult.ResourceTemplate.{

     

       372
       +
             uri_template = template.uri_template;

     

       373
       +
             name = template.name;

     

       374
       +
             description = template.description;

     

       375
       +
             mime_type = template.mime_type;

     

       376
       +
           }

     

       377
       +
           

     

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

     

       379
       +
         let to_rpc_resource_templates_list templates =

     

       380
       +
           List.map to_rpc_resource_template templates

     

       381
       +
       end

     

       382
       +
       

     

       383
        
       (* Main server type *)

     

       384
        
       type server = {

     

       385
        
         name: string;

     
···

       389
        
         mutable capabilities: Json.t;

     

       390
        
         mutable tools: Tool.t list;

     

       391
        
         mutable resources: Resource.t list;

     

       392
       +
         mutable resource_templates: ResourceTemplate.t list;

     

       393
        
         mutable prompts: Prompt.t list;

     

       394
        
       } 

     

       395
        
       

     
···

       400
        
       let protocol_version { protocol_version; _ } = protocol_version

     

       401
        
       let tools { tools; _ } = tools

     

       402
        
       let resources { resources; _ } = resources

     

       403
       +
       let resource_templates { resource_templates; _ } = resource_templates

     

       404
        
       let prompts { prompts; _ } = prompts

     

       405
        
       

     

       406
        
       (* Create a new server *)

     
···

       412
        
           capabilities = `Assoc [];

     

       413
        
           tools = [];

     

       414
        
           resources = [];

     

       415
       +
           resource_templates = [];

     

       416
        
           prompts = [];

     

       417
        
           lifespan_context = [];

     

       418
        
         }

     

       419
        
       

     

       420
        
       (* Default capabilities for the server *)

     

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

     

       422
        
         let caps = [] in

     

       423
        
         let caps = 

     

       424
        
           if with_tools then

     
···

       485
        
         resource

     

       486
        
       

     

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

     

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

     

       489
        
         let handler' _ctx params =

     

       490
        
           try

     

       491
        
             Ok (handler params)

     
···

       493
        
             Error (Printexc.to_string exn)

     

       494
        
         in

     

       495
        
         let resource = Resource.create

     

       496
       +
           ~uri

     

       497
       +
           ~name

     

       498
       +
           ?description

     

       499
       +
           ?mime_type

     

       500
       +
           ~handler:handler'

     

       501
       +
           ()

     

       502
       +
         in

     

       503
       +
         register_resource server resource

     

       504
       +
       

     

       505
       +
       (* Register a resource template *)

     

       506
       +
       let register_resource_template server template =

     

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

     

       508
       +
         template

     

       509
       +
       

     

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

     

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

     

       512
       +
         let handler' _ctx params =

     

       513
       +
           try

     

       514
       +
             Ok (handler params)

     

       515
       +
           with exn ->

     

       516
       +
             Error (Printexc.to_string exn)

     

       517
       +
         in

     

       518
       +
         let template = ResourceTemplate.create

     

       519
        
           ~uri_template

     

       520
       +
           ~name

     

       521
        
           ?description

     

       522
        
           ?mime_type

     

       523
        
           ~handler:handler'

     

       524
        
           ()

     

       525
        
         in

     

       526
       +
         register_resource_template server template

     

       527
        
       

     

       528
        
       (* Register a prompt *)

     

       529
        
       let register_prompt server prompt =

     
···

       555
        
         server.capabilities <- capabilities

     

       556
        
       

     

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

     

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

     

       559
        
         let with_tools = match with_tools with

     

       560
        
           | Some b -> b

     

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

     
···

       564
        
           | Some b -> b

     

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

     

       566
        
         in

     

       567
       +
         let with_resource_templates = match with_resource_templates with

     

       568
       +
           | Some b -> b

     

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

     

       570
       +
         in

     

       571
        
         let with_prompts = match with_prompts with

     

       572
        
           | Some b -> b

     

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

     

       574
        
         in

     

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

     

       576
        
         set_capabilities server capabilities;

     

       577
        
         server

+32 -5

lib/mcp_sdk.mli

···

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

     

       84
        
       

     

       85
        
         type t = {

     

       86
       -
           uri_template: string;

     

       0
        
       
     

       87
        
           description: string option;

     

       88
        
           mime_type: string option;

     

       89
        
           handler: handler;

     

       90
        
         }

     

       91
        
       

     

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

     

       93
        
         val to_json : t -> Json.t

     

       94
        
         

     

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

     
···

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

     

       100
        
       end

     

       101
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       102
        
       (** Prompts for the MCP server *)

     

       103
        
       module Prompt : sig

     

       104
        
         type argument = {

     
···

       150
        
       val capabilities : server -> Json.t

     

       151
        
       val tools : server -> Tool.t list

     

       152
        
       val resources : server -> Resource.t list

     

       0
        
       
     

       153
        
       val prompts : server -> Prompt.t list

     

       154
        
       

     

       155
        
       (** Create a new server *)

     

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

     

       157
        
       

     

       158
        
       (** Default capabilities for the server *)

     

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

     

       160
        
       

     

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

     

       162
        
       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
        
       

     

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

     

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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       166
        
       

     

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

     

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

     

       169
        
       

     

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

     

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

     

       172
        
       

     

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

···

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

     

       84
        
       

     

       85
        
         type t = {

     

       86
       +
           uri: string;

     

       87
       +
           name: string;

     

       88
        
           description: string option;

     

       89
        
           mime_type: string option;

     

       90
        
           handler: handler;

     

       91
        
         }

     

       92
        
       

     

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

     

       94
        
         val to_json : t -> Json.t

     

       95
        
         

     

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

     
···

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

     

       101
        
       end

     

       102
        
       

     

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

     

       104
       +
       module ResourceTemplate : sig

     

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

     

       106
       +
       

     

       107
       +
         type t = {

     

       108
       +
           uri_template: string;

     

       109
       +
           name: string;

     

       110
       +
           description: string option;

     

       111
       +
           mime_type: string option;

     

       112
       +
           handler: handler;

     

       113
       +
         }

     

       114
       +
       

     

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

     

       116
       +
         val to_json : t -> Json.t

     

       117
       +
         

     

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

     

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

     

       120
       +
         

     

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

     

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

     

       123
       +
       end

     

       124
       +
       

     

       125
        
       (** Prompts for the MCP server *)

     

       126
        
       module Prompt : sig

     

       127
        
         type argument = {

     
···

       173
        
       val capabilities : server -> Json.t

     

       174
        
       val tools : server -> Tool.t list

     

       175
        
       val resources : server -> Resource.t list

     

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

     

       177
        
       val prompts : server -> Prompt.t list

     

       178
        
       

     

       179
        
       (** Create a new server *)

     

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

     

       181
        
       

     

       182
        
       (** Default capabilities for the server *)

     

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

     

       184
        
       

     

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

     

       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

     

       187
        
       

     

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

     

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

     

       190
       +
       

     

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

     

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

     

       193
        
       

     

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

     

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

     

       196
        
       

     

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

     

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

     

       199
        
       

     

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

+100 -47

lib/mcp_server.ml

···

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

     

       61
        
         Some response

     

       62
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       63
        
       (* Process resources/read request *)

     

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

     

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

     
···

       72
        
             let uri = req_data.uri in

     

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

     

       74
        
             

     

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

     

       76
       -
             let find_resource_handler uri =

     

       77
       -
               let parse_uri_template template uri =

     

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

     

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

     

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

     

       81
       -
                 

     

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

     

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

     

       84
       -
                   None

     

       85
       -
                 else

     

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

     

       87
       -
                   let params, matches = 

     

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

     

       89
       -
                       if String.length template_part > 2 && 

     

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

     

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

     

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

     

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

     

       94
       -
                         (uri_part :: params, matches)

     

       95
       -
                       else if template_part = uri_part then

     

       96
       -
                         (* Constant part matches *)

     

       97
       -
                         (params, true && matches)

     

       98
       -
                       else

     

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

     

       100
       -
                         (params, false && matches)

     

       101
       -
                     ) ([], true) template_parts uri_parts

     

       102
       -
                   in

     

       103
       -
                   

     

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

     

       105
       -
               in

     

       106
       -
               

     

       107
       -
               let rec find_handler = function

     

       108
       -
                 | [] -> None

     

       109
       -
                 | resource :: rest ->

     

       110
       -
                     match parse_uri_template resource.Resource.uri_template uri with

     

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

     

       112
       -
                     | None -> find_handler rest

     

       113
       -
               in

     

       114
       -
               

     

       115
       -
               find_handler (resources server)

     

       116
       -
             in

     

       117
       -
             

     

       118
       -
             match find_resource_handler uri with

     

       119
       -
             | Some (resource, params) ->

     

       120
        
                 (* Create context for this request *)

     

       121
        
                 let ctx = Context.create 

     

       122
        
                   ?request_id:(Some req.id)

     
···

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

     

       125
        
                   () 

     

       126
        
                 in

     

       0
        
       
     

       0
        
       
     

       127
        
                 

     

       128
        
                 (* Call the resource handler *)

     

       129
        
                 (match resource.handler ctx params with

     
···

       144
        
                  | Error err ->

     

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

     

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

     

       147
       -
             | None ->

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

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

     

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

     

       150
        
       

     
···

       377
        
             ()

     

       378
        
         | exn ->

     

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

     

       380
       -
             ()

···

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

     

       61
        
         Some response

     

       62
        
       

     

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

     

       64
       +
       module Resource_matcher = struct

     

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

     

       66
       +
         type resource_match =

     

       67
       +
           | DirectResource of Resource.t * string list

     

       68
       +
           | TemplateResource of ResourceTemplate.t * string list

     

       69
       +
           | NoMatch

     

       70
       +
       

     

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

     

       72
       +
         let extract_template_vars template_uri uri =

     

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

     

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

     

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

     

       76
       +
           

     

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

     

       78
       +
             None

     

       79
       +
           else

     

       80
       +
             (* Match parts and extract variables *)

     

       81
       +
             let rec match_parts tparts uparts acc =

     

       82
       +
               match tparts, uparts with

     

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

     

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

     

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

     

       86
       +
                   if String.length th > 2 && 

     

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

     

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

     

       89
       +
                     (* Extract variable value and continue *)

     

       90
       +
                     match_parts tt ut (uh::acc)

     

       91
       +
                   else if th = uh then

     

       92
       +
                     (* Fixed part matches, continue *)

     

       93
       +
                     match_parts tt ut acc

     

       94
       +
                   else

     

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

     

       96
       +
                     None

     

       97
       +
               | _, _ -> None

     

       98
       +
             in

     

       99
       +
             match_parts template_parts uri_parts []

     

       100
       +
       

     

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

     

       102
       +
         let find_match server uri =

     

       103
       +
           (* Try direct resource match first *)

     

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

     

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

     

       106
       +
           | None ->

     

       107
       +
               (* Try template match next *)

     

       108
       +
               let templates = resource_templates server in

     

       109
       +
               

     

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

     

       111
       +
               let rec try_templates templates =

     

       112
       +
                 match templates with

     

       113
       +
                 | [] -> NoMatch

     

       114
       +
                 | template::rest ->

     

       115
       +
                     match extract_template_vars template.ResourceTemplate.uri_template uri with

     

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

     

       117
       +
                     | None -> try_templates rest

     

       118
       +
               in

     

       119
       +
               try_templates templates

     

       120
       +
       end

     

       121
       +
       

     

       122
        
       (* Process resources/read request *)

     

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

     

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

     
···

       131
        
             let uri = req_data.uri in

     

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

     

       133
        
             

     

       134
       +
             (* Find matching resource or template *)

     

       135
       +
             match Resource_matcher.find_match server uri with

     

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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       137
        
                 (* Create context for this request *)

     

       138
        
                 let ctx = Context.create 

     

       139
        
                   ?request_id:(Some req.id)

     
···

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

     

       142
        
                   () 

     

       143
        
                 in

     

       144
       +
                 

     

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

     

       146
        
                 

     

       147
        
                 (* Call the resource handler *)

     

       148
        
                 (match resource.handler ctx params with

     
···

       163
        
                  | Error err ->

     

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

     

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

     

       166
       +
                      

     

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

     

       168
       +
                 (* Create context for this request *)

     

       169
       +
                 let ctx = Context.create 

     

       170
       +
                   ?request_id:(Some req.id)

     

       171
       +
                   ?progress_token:req.progress_token

     

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

     

       173
       +
                   () 

     

       174
       +
                 in

     

       175
       +
                 

     

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

     

       177
       +
                   template.name 

     

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

     

       179
       +
                 

     

       180
       +
                 (* Call the template handler *)

     

       181
       +
                 (match template.handler ctx params with

     

       182
       +
                  | Ok content ->

     

       183
       +
                      (* Create text resource content *)

     

       184
       +
                      let mime_type = match template.mime_type with

     

       185
       +
                        | Some mime -> mime

     

       186
       +
                        | None -> "text/plain"

     

       187
       +
                      in

     

       188
       +
                      let text_resource = {

     

       189
       +
                        TextResourceContents.uri;

     

       190
       +
                        text = content;

     

       191
       +
                        mime_type = Some mime_type

     

       192
       +
                      } in

     

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

     

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

     

       195
       +
                      Some response

     

       196
       +
                  | Error err ->

     

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

     

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

     

       199
       +
             

     

       200
       +
             | Resource_matcher.NoMatch ->

     

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

     

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

     

       203
        
       

     
···

       430
        
             ()

     

       431
        
         | exn ->

     

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

     

       433
       +
             ()