commit c2e26fb6c5c7b8170ec862898b67846aeab865f8 · anil.recoil.org/slop

claudeio/examples/dune

···

       1
       +
       (executable

     

       2
       +
        (name mcp_server_example)

     

       3
       +
        (libraries mcp eio_main))

+220

claudeio/examples/mcp_server_example.ml

···

       1
       +
       (** Example MCP server using the Server_session API.

     

       2
       +
       

     

       3
       +
           This example demonstrates how to create a simple MCP server that provides:

     

       4
       +
           - A few example tools (add, echo)

     

       5
       +
           - A simple resource (example://greeting)

     

       6
       +
           - Basic ping support

     

       7
       +
       

     

       8
       +
           Note: This is a template/demonstration. A real MCP server would typically:

     

       9
       +
           1. Read JSON-RPC messages from stdin

     

       10
       +
           2. Write JSON-RPC responses to stdout

     

       11
       +
           3. Use proper error handling and logging

     

       12
       +
       

     

       13
       +
           To use this as a real server, you would need to:

     

       14
       +
           - Create a custom Transport that reads/writes to stdio

     

       15
       +
           - Handle process lifecycle properly

     

       16
       +
           - Add comprehensive error handling

     

       17
       +
       *)

     

       18
       +
       

     

       19
       +
       open Mcp

     

       20
       +
       

     

       21
       +
       (* Helper to find field in Jsont.Object *)

     

       22
       +
       let find_field name fields =

     

       23
       +
         List.find_map (fun ((n, _), value) ->

     

       24
       +
           if n = name then Some value else None

     

       25
       +
         ) fields

     

       26
       +
       

     

       27
       +
       (* Example tool: Add two numbers *)

     

       28
       +
       let handle_add_tool ~name:_ ~arguments =

     

       29
       +
         let open Messages.Tools in

     

       30
       +
         match arguments with

     

       31
       +
         | Some (Jsont.Object (fields, _)) ->

     

       32
       +
             let a = match find_field "a" fields with

     

       33
       +
               | Some (Jsont.Number (n, _)) -> n

     

       34
       +
               | _ -> 0.0

     

       35
       +
             in

     

       36
       +
             let b = match find_field "b" fields with

     

       37
       +
               | Some (Jsont.Number (n, _)) -> n

     

       38
       +
               | _ -> 0.0

     

       39
       +
             in

     

       40
       +
             let result = a +. b in

     

       41
       +
             let content = [

     

       42
       +
               Content.text (Printf.sprintf "Result: %.2f" result)

     

       43
       +
             ] in

     

       44
       +
             make_call_result ~content ()

     

       45
       +
         | _ ->

     

       46
       +
             make_call_result

     

       47
       +
               ~content:[Content.text "Invalid arguments"]

     

       48
       +
               ~is_error:true

     

       49
       +
               ()

     

       50
       +
       

     

       51
       +
       (* Example tool: Echo a message *)

     

       52
       +
       let handle_echo_tool ~name:_ ~arguments =

     

       53
       +
         let open Messages.Tools in

     

       54
       +
         match arguments with

     

       55
       +
         | Some (Jsont.Object (fields, _)) ->

     

       56
       +
             (match find_field "message" fields with

     

       57
       +
              | Some (Jsont.String (msg, _)) ->

     

       58
       +
                  let content = [Content.text msg] in

     

       59
       +
                  make_call_result ~content ()

     

       60
       +
              | _ ->

     

       61
       +
                  make_call_result

     

       62
       +
                    ~content:[Content.text "No message provided"]

     

       63
       +
                    ~is_error:true

     

       64
       +
                    ())

     

       65
       +
         | _ ->

     

       66
       +
             make_call_result

     

       67
       +
               ~content:[Content.text "Invalid arguments"]

     

       68
       +
               ~is_error:true

     

       69
       +
               ()

     

       70
       +
       

     

       71
       +
       (* Tool dispatcher *)

     

       72
       +
       let call_tool ~name ~arguments =

     

       73
       +
         match name with

     

       74
       +
         | "add" -> handle_add_tool ~name ~arguments

     

       75
       +
         | "echo" -> handle_echo_tool ~name ~arguments

     

       76
       +
         | _ ->

     

       77
       +
             Messages.Tools.make_call_result

     

       78
       +
               ~content:[Content.text (Printf.sprintf "Unknown tool: %s" name)]

     

       79
       +
               ~is_error:true

     

       80
       +
               ()

     

       81
       +
       

     

       82
       +
       (* List available tools *)

     

       83
       +
       let list_tools ~cursor:_ =

     

       84
       +
         let open Messages.Tools in

     

       85
       +
         let meta = Jsont.Meta.none in

     

       86
       +
         let tools = [

     

       87
       +
           make_tool

     

       88
       +
             ~name:"add"

     

       89
       +
             ~description:"Add two numbers together"

     

       90
       +
             ~input_schema:(Jsont.Object ([

     

       91
       +
               (("type", meta), Jsont.String ("object", meta));

     

       92
       +
               (("properties", meta), Jsont.Object ([

     

       93
       +
                 (("a", meta), Jsont.Object ([(("type", meta), Jsont.String ("number", meta))], meta));

     

       94
       +
                 (("b", meta), Jsont.Object ([(("type", meta), Jsont.String ("number", meta))], meta));

     

       95
       +
               ], meta));

     

       96
       +
               (("required", meta), Jsont.Array ([Jsont.String ("a", meta); Jsont.String ("b", meta)], meta));

     

       97
       +
             ], meta))

     

       98
       +
             ();

     

       99
       +
           make_tool

     

       100
       +
             ~name:"echo"

     

       101
       +
             ~description:"Echo a message back"

     

       102
       +
             ~input_schema:(Jsont.Object ([

     

       103
       +
               (("type", meta), Jsont.String ("object", meta));

     

       104
       +
               (("properties", meta), Jsont.Object ([

     

       105
       +
                 (("message", meta), Jsont.Object ([(("type", meta), Jsont.String ("string", meta))], meta));

     

       106
       +
               ], meta));

     

       107
       +
               (("required", meta), Jsont.Array ([Jsont.String ("message", meta)], meta));

     

       108
       +
             ], meta))

     

       109
       +
             ();

     

       110
       +
         ] in

     

       111
       +
         make_list_result ~tools ()

     

       112
       +
       

     

       113
       +
       (* Example resource *)

     

       114
       +
       let read_resource ~uri =

     

       115
       +
         let open Messages.Resources in

     

       116
       +
         match uri with

     

       117
       +
         | "example://greeting" ->

     

       118
       +
             let contents = [

     

       119
       +
               make_text_contents

     

       120
       +
                 ~uri

     

       121
       +
                 ~text:"Hello from the MCP server!"

     

       122
       +
                 ~mime_type:"text/plain"

     

       123
       +
                 ()

     

       124
       +
             ] in

     

       125
       +
             make_read_result ~contents

     

       126
       +
         | _ ->

     

       127
       +
             failwith (Printf.sprintf "Unknown resource: %s" uri)

     

       128
       +
       

     

       129
       +
       let list_resources ~cursor:_ =

     

       130
       +
         let open Messages.Resources in

     

       131
       +
         let resources = [

     

       132
       +
           make_resource

     

       133
       +
             ~uri:"example://greeting"

     

       134
       +
             ~name:"Greeting"

     

       135
       +
             ~description:"A simple greeting message"

     

       136
       +
             ~mime_type:"text/plain"

     

       137
       +
             ()

     

       138
       +
         ] in

     

       139
       +
         make_list_result ~resources ()

     

       140
       +
       

     

       141
       +
       (* Ping handler *)

     

       142
       +
       let ping () = ()

     

       143
       +
       

     

       144
       +
       (* Main server function *)

     

       145
       +
       let run_server env =

     

       146
       +
         let open Eio in

     

       147
       +
       

     

       148
       +
         Switch.run @@ fun sw ->

     

       149
       +
           (* Create stdio transport for the server *)

     

       150
       +
           (* Note: For a real server, you would typically use a transport that

     

       151
       +
              reads from stdin and writes to stdout. Here we create a simple

     

       152
       +
              in-process transport for demonstration. *)

     

       153
       +
           let params = {

     

       154
       +
             Transport_stdio.command = "cat";  (* Echo back for demo *)

     

       155
       +
             args = [];

     

       156
       +
             env = None;

     

       157
       +
             max_buffer_size = None;

     

       158
       +
           } in

     

       159
       +
           let transport = Transport_stdio.create

     

       160
       +
             ~sw

     

       161
       +
             ~process_mgr:(Eio.Stdenv.process_mgr env)

     

       162
       +
             params

     

       163
       +
           in

     

       164
       +
       

     

       165
       +
           (* Configure server *)

     

       166
       +
           let config = {

     

       167
       +
             Server_session.server_info = Capabilities.Implementation.make

     

       168
       +
               ~name:"example-mcp-server"

     

       169
       +
               ~version:"1.0.0";

     

       170
       +
             server_capabilities = Capabilities.Server.make

     

       171
       +
               ~tools:(Capabilities.Tools.make ())

     

       172
       +
               ~resources:(Capabilities.Resources.make ())

     

       173
       +
               ()

     

       174
       +
             ;

     

       175
       +
             instructions = Some "Example MCP server with basic tools and resources";

     

       176
       +
           } in

     

       177
       +
       

     

       178
       +
           (* Set up handlers *)

     

       179
       +
           let handlers = {

     

       180
       +
             Server_session.list_resources = Some list_resources;

     

       181
       +
             list_resource_templates = None;

     

       182
       +
             read_resource = Some read_resource;

     

       183
       +
             subscribe_resource = None;

     

       184
       +
             unsubscribe_resource = None;

     

       185
       +
             list_tools = Some list_tools;

     

       186
       +
             call_tool = Some call_tool;

     

       187
       +
             list_prompts = None;

     

       188
       +
             get_prompt = None;

     

       189
       +
             complete = None;

     

       190
       +
             ping = Some ping;

     

       191
       +
           } in

     

       192
       +
       

     

       193
       +
           (* Create and run server *)

     

       194
       +
           let server = Server_session.create

     

       195
       +
             ~sw

     

       196
       +
             ~transport

     

       197
       +
             config

     

       198
       +
             handlers

     

       199
       +
           in

     

       200
       +
       

     

       201
       +
           (* Log server startup *)

     

       202
       +
           let client_info = Server_session.client_info server in

     

       203
       +
           Eio.traceln "MCP server started, connected to client: %s v%s"

     

       204
       +
             client_info.Capabilities.Implementation.name

     

       205
       +
             client_info.Capabilities.Implementation.version;

     

       206
       +
       

     

       207
       +
           (* The server runs in the background via the Session's receive loop *)

     

       208
       +
           (* The switch will keep the server alive until it's explicitly closed or an error occurs *)

     

       209
       +
           (* For this example, we just let it run until the process is terminated *)

     

       210
       +
           ()

     

       211
       +
           (* Note: In a real server, you would wait for some termination signal or condition *)

     

       212
       +
       

     

       213
       +
       let () =

     

       214
       +
         Eio_main.run @@ fun env ->

     

       215
       +
           try

     

       216
       +
             run_server env

     

       217
       +
           with

     

       218
       +
           | exn ->

     

       219
       +
               Printf.eprintf "Server error: %s\n%!" (Printexc.to_string exn);

     

       220
       +
               exit 1