commit 9f536e50aa9ab42e146e9445043f9fae09866d71 · anil.recoil.org/slop

+19 -1

claudeio/lib/message.ml

···

       194
       194
        
       

     

       195
       195
        
       module System = struct

     

       196
       196
        
         module Data = struct

     

       197
       197
       -
           type t = value

     

       197
       197
       +
           (* Store both the raw JSON and provide typed accessors *)

     

       198
       198
       +
           type t = value  (* The full JSON data *)

     

       198
       199
        
           

     

       199
       200
        
           let empty = `O []

     

       200
       201
        
           

     
···

       205
       206
        
           let get_int t key = JU.get_field_int_opt t key

     

       206
       207
        
           

     

       207
       208
        
           let get_bool t key = JU.get_field_bool_opt t key

     

       209
       209
       +
           

     

       210
       210
       +
           let get_float t key = JU.get_field_float_opt t key

     

       211
       211
       +
           

     

       212
       212
       +
           let get_list t key = 

     

       213
       213
       +
             match t with

     

       214
       214
       +
             | `O fields -> 

     

       215
       215
       +
                 (match List.assoc_opt key fields with

     

       216
       216
       +
                 | Some (`A lst) -> Some lst

     

       217
       217
       +
                 | _ -> None)

     

       218
       218
       +
             | _ -> None

     

       219
       219
       +
           

     

       220
       220
       +
           let get_field t key =

     

       221
       221
       +
             match t with

     

       222
       222
       +
             | `O fields -> List.assoc_opt key fields

     

       223
       223
       +
             | _ -> None

     

       224
       224
       +
           

     

       225
       225
       +
           let raw_json t = t

     

       208
       226
        
           

     

       209
       227
        
           let to_json t = t

     

       210
       228
        
           let of_json json = json

+14 -1

claudeio/lib/message.mli

···

       112
       112
        
           (** System message data. *)

     

       113
       113
        
           

     

       114
       114
        
           type t

     

       115
       115
       -
           (** Abstract type for system message data. *)

     

       115
       115
       +
           (** Abstract type for system message data. Contains both the raw JSON

     

       116
       116
       +
               and typed accessors for common fields. *)

     

       116
       117
        
           

     

       117
       118
        
           val empty : t

     

       118
       119
        
           (** [empty] creates empty data. *)

     
···

       128
       129
        
           

     

       129
       130
        
           val get_bool : t -> string -> bool option

     

       130
       131
        
           (** [get_bool t key] returns the boolean value for [key], if present. *)

     

       132
       132
       +
           

     

       133
       133
       +
           val get_float : t -> string -> float option

     

       134
       134
       +
           (** [get_float t key] returns the float value for [key], if present. *)

     

       135
       135
       +
           

     

       136
       136
       +
           val get_list : t -> string -> Ezjsonm.value list option

     

       137
       137
       +
           (** [get_list t key] returns the list value for [key], if present. *)

     

       138
       138
       +
           

     

       139
       139
       +
           val get_field : t -> string -> Ezjsonm.value option

     

       140
       140
       +
           (** [get_field t key] returns the raw JSON value for [key], if present. *)

     

       141
       141
       +
           

     

       142
       142
       +
           val raw_json : t -> Ezjsonm.value

     

       143
       143
       +
           (** [raw_json t] returns the full underlying JSON data. *)

     

       131
       144
        
           

     

       132
       145
        
           val to_json : t -> Ezjsonm.value

     

       133
       146
        
           (** [to_json t] converts to JSON representation. Internal use only. *)

+53 -2

claudeio/lib/options.ml

···

       14
       14
        
         model : string option;

     

       15
       15
        
         cwd : Eio.Fs.dir_ty Eio.Path.t option;

     

       16
       16
        
         env : (string * string) list;

     

       17
       17
       +
         continue_conversation : bool;

     

       18
       18
       +
         resume : string option;

     

       19
       19
       +
         max_turns : int option;

     

       20
       20
       +
         permission_prompt_tool_name : string option;

     

       21
       21
       +
         settings : string option;

     

       22
       22
       +
         add_dirs : string list;

     

       23
       23
       +
         extra_args : (string * string option) list;

     

       24
       24
       +
         debug_stderr : Eio.Flow.sink_ty Eio.Flow.sink option;

     

       17
       25
        
       }

     

       18
       26
        
       

     

       19
       27
        
       let default = {

     
···

       27
       35
        
         model = None;

     

       28
       36
        
         cwd = None;

     

       29
       37
        
         env = [];

     

       38
       38
       +
         continue_conversation = false;

     

       39
       39
       +
         resume = None;

     

       40
       40
       +
         max_turns = None;

     

       41
       41
       +
         permission_prompt_tool_name = None;

     

       42
       42
       +
         settings = None;

     

       43
       43
       +
         add_dirs = [];

     

       44
       44
       +
         extra_args = [];

     

       45
       45
       +
         debug_stderr = None;

     

       30
       46
        
       }

     

       31
       47
        
       

     

       32
       48
        
       let create 

     
···

       40
       56
        
           ?model

     

       41
       57
        
           ?cwd

     

       42
       58
        
           ?(env = [])

     

       59
       59
       +
           ?(continue_conversation = false)

     

       60
       60
       +
           ?resume

     

       61
       61
       +
           ?max_turns

     

       62
       62
       +
           ?permission_prompt_tool_name

     

       63
       63
       +
           ?settings

     

       64
       64
       +
           ?(add_dirs = [])

     

       65
       65
       +
           ?(extra_args = [])

     

       66
       66
       +
           ?debug_stderr

     

       43
       67
        
           () =

     

       44
       68
        
         { allowed_tools; disallowed_tools; max_thinking_tokens;

     

       45
       69
        
           system_prompt; append_system_prompt; permission_mode;

     

       46
       46
       -
           permission_callback; model; cwd; env }

     

       70
       70
       +
           permission_callback; model; cwd; env;

     

       71
       71
       +
           continue_conversation; resume; max_turns;

     

       72
       72
       +
           permission_prompt_tool_name; settings; add_dirs;

     

       73
       73
       +
           extra_args; debug_stderr }

     

       47
       74
        
       

     

       48
       75
        
       let allowed_tools t = t.allowed_tools

     

       49
       76
        
       let disallowed_tools t = t.disallowed_tools

     
···

       55
       82
        
       let model t = t.model

     

       56
       83
        
       let cwd t = t.cwd

     

       57
       84
        
       let env t = t.env

     

       85
       85
       +
       let continue_conversation t = t.continue_conversation

     

       86
       86
       +
       let resume t = t.resume

     

       87
       87
       +
       let max_turns t = t.max_turns

     

       88
       88
       +
       let permission_prompt_tool_name t = t.permission_prompt_tool_name

     

       89
       89
       +
       let settings t = t.settings

     

       90
       90
       +
       let add_dirs t = t.add_dirs

     

       91
       91
       +
       let extra_args t = t.extra_args

     

       92
       92
       +
       let debug_stderr t = t.debug_stderr

     

       58
       93
        
       

     

       59
       94
        
       let with_allowed_tools tools t = { t with allowed_tools = tools }

     

       60
       95
        
       let with_disallowed_tools tools t = { t with disallowed_tools = tools }

     
···

       66
       101
        
       let with_model model t = { t with model = Some model }

     

       67
       102
        
       let with_cwd cwd t = { t with cwd = Some cwd }

     

       68
       103
        
       let with_env env t = { t with env }

     

       104
       104
       +
       let with_continue_conversation continue t = { t with continue_conversation = continue }

     

       105
       105
       +
       let with_resume session_id t = { t with resume = Some session_id }

     

       106
       106
       +
       let with_max_turns turns t = { t with max_turns = Some turns }

     

       107
       107
       +
       let with_permission_prompt_tool_name tool t = { t with permission_prompt_tool_name = Some tool }

     

       108
       108
       +
       let with_settings path t = { t with settings = Some path }

     

       109
       109
       +
       let with_add_dirs dirs t = { t with add_dirs = dirs }

     

       110
       110
       +
       let with_extra_args args t = { t with extra_args = args }

     

       111
       111
       +
       let with_debug_stderr sink t = { t with debug_stderr = Some sink }

     

       69
       112
        
       

     

       70
       113
        
       let to_json t =

     

       71
       114
        
         let fields = [] in

     
···

       148
       191
        
             { allowed_tools; disallowed_tools; max_thinking_tokens;

     

       149
       192
        
               system_prompt; append_system_prompt; permission_mode;

     

       150
       193
        
               permission_callback = Some Permissions.default_allow_callback;

     

       151
       151
       -
               model; cwd = None; env }

     

       194
       194
       +
               model; cwd = None; env;

     

       195
       195
       +
               continue_conversation = false;

     

       196
       196
       +
               resume = None;

     

       197
       197
       +
               max_turns = None;

     

       198
       198
       +
               permission_prompt_tool_name = None;

     

       199
       199
       +
               settings = None;

     

       200
       200
       +
               add_dirs = [];

     

       201
       201
       +
               extra_args = [];

     

       202
       202
       +
               debug_stderr = None }

     

       152
       203
        
         | _ -> raise (Invalid_argument "Options.of_json: expected object")

     

       153
       204
        
       

     

       154
       205
        
       let pp fmt t =

+68 -2

claudeio/lib/options.mli

···

       30
       30
        
         ?model:string ->

     

       31
       31
        
         ?cwd:Eio.Fs.dir_ty Eio.Path.t ->

     

       32
       32
        
         ?env:(string * string) list ->

     

       33
       33
       +
         ?continue_conversation:bool ->

     

       34
       34
       +
         ?resume:string ->

     

       35
       35
       +
         ?max_turns:int ->

     

       36
       36
       +
         ?permission_prompt_tool_name:string ->

     

       37
       37
       +
         ?settings:string ->

     

       38
       38
       +
         ?add_dirs:string list ->

     

       39
       39
       +
         ?extra_args:(string * string option) list ->

     

       40
       40
       +
         ?debug_stderr:Eio.Flow.sink_ty Eio.Flow.sink ->

     

       33
       41
        
         unit -> t

     

       34
       42
        
       (** [create ?allowed_tools ?disallowed_tools ?max_thinking_tokens ?system_prompt

     

       35
       35
       -
           ?append_system_prompt ?permission_mode ?permission_callback ?model ?cwd ?env ()]

     

       43
       43
       +
           ?append_system_prompt ?permission_mode ?permission_callback ?model ?cwd ?env

     

       44
       44
       +
           ?continue_conversation ?resume ?max_turns ?permission_prompt_tool_name ?settings

     

       45
       45
       +
           ?add_dirs ?extra_args ?debug_stderr ()]

     

       36
       46
        
           creates a new configuration.

     

       37
       47
        
           @param allowed_tools List of explicitly allowed tool names

     

       38
       48
        
           @param disallowed_tools List of explicitly disallowed tool names

     
···

       43
       53
        
           @param permission_callback Custom permission callback

     

       44
       54
        
           @param model Override the default model

     

       45
       55
        
           @param cwd Working directory for file operations

     

       46
       46
       -
           @param env Environment variables to set *)

     

       56
       56
       +
           @param env Environment variables to set

     

       57
       57
       +
           @param continue_conversation Continue an existing conversation

     

       58
       58
       +
           @param resume Resume from a specific session ID

     

       59
       59
       +
           @param max_turns Maximum number of conversation turns

     

       60
       60
       +
           @param permission_prompt_tool_name Tool name for permission prompts

     

       61
       61
       +
           @param settings Path to settings file

     

       62
       62
       +
           @param add_dirs Additional directories to allow access to

     

       63
       63
       +
           @param extra_args Additional CLI flags to pass through

     

       64
       64
       +
           @param debug_stderr Sink for debug output when debug-to-stderr is set *)

     

       47
       65
        
       

     

       48
       66
        
       (** {1 Accessors} *)

     

       49
       67
        
       

     
···

       77
       95
        
       val env : t -> (string * string) list

     

       78
       96
        
       (** [env t] returns the environment variables. *)

     

       79
       97
        
       

     

       98
       98
       +
       val continue_conversation : t -> bool

     

       99
       99
       +
       (** [continue_conversation t] returns whether to continue an existing conversation. *)

     

       100
       100
       +
       

     

       101
       101
       +
       val resume : t -> string option

     

       102
       102
       +
       (** [resume t] returns the optional session ID to resume. *)

     

       103
       103
       +
       

     

       104
       104
       +
       val max_turns : t -> int option

     

       105
       105
       +
       (** [max_turns t] returns the optional maximum number of turns. *)

     

       106
       106
       +
       

     

       107
       107
       +
       val permission_prompt_tool_name : t -> string option

     

       108
       108
       +
       (** [permission_prompt_tool_name t] returns the optional tool name for permission prompts. *)

     

       109
       109
       +
       

     

       110
       110
       +
       val settings : t -> string option

     

       111
       111
       +
       (** [settings t] returns the optional path to settings file. *)

     

       112
       112
       +
       

     

       113
       113
       +
       val add_dirs : t -> string list

     

       114
       114
       +
       (** [add_dirs t] returns the list of additional allowed directories. *)

     

       115
       115
       +
       

     

       116
       116
       +
       val extra_args : t -> (string * string option) list

     

       117
       117
       +
       (** [extra_args t] returns the additional CLI flags. *)

     

       118
       118
       +
       

     

       119
       119
       +
       val debug_stderr : t -> Eio.Flow.sink_ty Eio.Flow.sink option

     

       120
       120
       +
       (** [debug_stderr t] returns the optional debug output sink. *)

     

       121
       121
       +
       

     

       80
       122
        
       (** {1 Builders} *)

     

       81
       123
        
       

     

       82
       124
        
       val with_allowed_tools : string list -> t -> t

     
···

       108
       150
        
       

     

       109
       151
        
       val with_env : (string * string) list -> t -> t

     

       110
       152
        
       (** [with_env env t] sets the environment variables. *)

     

       153
       153
       +
       

     

       154
       154
       +
       val with_continue_conversation : bool -> t -> t

     

       155
       155
       +
       (** [with_continue_conversation continue t] sets whether to continue conversation. *)

     

       156
       156
       +
       

     

       157
       157
       +
       val with_resume : string -> t -> t

     

       158
       158
       +
       (** [with_resume session_id t] sets the session ID to resume. *)

     

       159
       159
       +
       

     

       160
       160
       +
       val with_max_turns : int -> t -> t

     

       161
       161
       +
       (** [with_max_turns turns t] sets the maximum number of turns. *)

     

       162
       162
       +
       

     

       163
       163
       +
       val with_permission_prompt_tool_name : string -> t -> t

     

       164
       164
       +
       (** [with_permission_prompt_tool_name tool t] sets the permission prompt tool name. *)

     

       165
       165
       +
       

     

       166
       166
       +
       val with_settings : string -> t -> t

     

       167
       167
       +
       (** [with_settings path t] sets the path to settings file. *)

     

       168
       168
       +
       

     

       169
       169
       +
       val with_add_dirs : string list -> t -> t

     

       170
       170
       +
       (** [with_add_dirs dirs t] sets the additional allowed directories. *)

     

       171
       171
       +
       

     

       172
       172
       +
       val with_extra_args : (string * string option) list -> t -> t

     

       173
       173
       +
       (** [with_extra_args args t] sets the additional CLI flags. *)

     

       174
       174
       +
       

     

       175
       175
       +
       val with_debug_stderr : Eio.Flow.sink_ty Eio.Flow.sink -> t -> t

     

       176
       176
       +
       (** [with_debug_stderr sink t] sets the debug output sink. *)

     

       111
       177
        
       

     

       112
       178
        
       (** {1 Serialization} *)

     

       113
       179

+363

claudeio/lib/sdk_control.ml

···

       1
       1
       +
       open Ezjsonm

     

       2
       2
       +
       

     

       3
       3
       +
       let src = Logs.Src.create "claude.sdk_control" ~doc:"Claude SDK control protocol"

     

       4
       4
       +
       module Log = (val Logs.src_log src : Logs.LOG)

     

       5
       5
       +
       

     

       6
       6
       +
       module JU = Json_utils

     

       7
       7
       +
       

     

       8
       8
       +
       module Request = struct

     

       9
       9
       +
         type interrupt = {

     

       10
       10
       +
           subtype : [`Interrupt];

     

       11
       11
       +
         }

     

       12
       12
       +
         

     

       13
       13
       +
         type permission = {

     

       14
       14
       +
           subtype : [`Can_use_tool];

     

       15
       15
       +
           tool_name : string;

     

       16
       16
       +
           input : value;

     

       17
       17
       +
           permission_suggestions : Permissions.Update.t list option;

     

       18
       18
       +
           blocked_path : string option;

     

       19
       19
       +
         }

     

       20
       20
       +
         

     

       21
       21
       +
         type initialize = {

     

       22
       22
       +
           subtype : [`Initialize];

     

       23
       23
       +
           hooks : (string * value) list option;

     

       24
       24
       +
         }

     

       25
       25
       +
         

     

       26
       26
       +
         type set_permission_mode = {

     

       27
       27
       +
           subtype : [`Set_permission_mode];

     

       28
       28
       +
           mode : Permissions.Mode.t;

     

       29
       29
       +
         }

     

       30
       30
       +
         

     

       31
       31
       +
         type hook_callback = {

     

       32
       32
       +
           subtype : [`Hook_callback];

     

       33
       33
       +
           callback_id : string;

     

       34
       34
       +
           input : value;

     

       35
       35
       +
           tool_use_id : string option;

     

       36
       36
       +
         }

     

       37
       37
       +
         

     

       38
       38
       +
         type mcp_message = {

     

       39
       39
       +
           subtype : [`Mcp_message];

     

       40
       40
       +
           server_name : string;

     

       41
       41
       +
           message : value;

     

       42
       42
       +
         }

     

       43
       43
       +
         

     

       44
       44
       +
         type t =

     

       45
       45
       +
           | Interrupt of interrupt

     

       46
       46
       +
           | Permission of permission

     

       47
       47
       +
           | Initialize of initialize

     

       48
       48
       +
           | Set_permission_mode of set_permission_mode

     

       49
       49
       +
           | Hook_callback of hook_callback

     

       50
       50
       +
           | Mcp_message of mcp_message

     

       51
       51
       +
         

     

       52
       52
       +
         let interrupt () = Interrupt { subtype = `Interrupt }

     

       53
       53
       +
         

     

       54
       54
       +
         let permission ~tool_name ~input ?permission_suggestions ?blocked_path () =

     

       55
       55
       +
           Permission {

     

       56
       56
       +
             subtype = `Can_use_tool;

     

       57
       57
       +
             tool_name;

     

       58
       58
       +
             input;

     

       59
       59
       +
             permission_suggestions;

     

       60
       60
       +
             blocked_path;

     

       61
       61
       +
           }

     

       62
       62
       +
         

     

       63
       63
       +
         let initialize ?hooks () =

     

       64
       64
       +
           Initialize { subtype = `Initialize; hooks }

     

       65
       65
       +
         

     

       66
       66
       +
         let set_permission_mode ~mode =

     

       67
       67
       +
           Set_permission_mode { subtype = `Set_permission_mode; mode }

     

       68
       68
       +
         

     

       69
       69
       +
         let hook_callback ~callback_id ~input ?tool_use_id () =

     

       70
       70
       +
           Hook_callback {

     

       71
       71
       +
             subtype = `Hook_callback;

     

       72
       72
       +
             callback_id;

     

       73
       73
       +
             input;

     

       74
       74
       +
             tool_use_id;

     

       75
       75
       +
           }

     

       76
       76
       +
         

     

       77
       77
       +
         let mcp_message ~server_name ~message =

     

       78
       78
       +
           Mcp_message {

     

       79
       79
       +
             subtype = `Mcp_message;

     

       80
       80
       +
             server_name;

     

       81
       81
       +
             message;

     

       82
       82
       +
           }

     

       83
       83
       +
         

     

       84
       84
       +
         let to_json = function

     

       85
       85
       +
           | Interrupt _ ->

     

       86
       86
       +
               `O [("subtype", `String "interrupt")]

     

       87
       87
       +
           | Permission p ->

     

       88
       88
       +
               let fields = [

     

       89
       89
       +
                 ("subtype", `String "can_use_tool");

     

       90
       90
       +
                 ("tool_name", `String p.tool_name);

     

       91
       91
       +
                 ("input", p.input);

     

       92
       92
       +
               ] in

     

       93
       93
       +
               let fields = match p.permission_suggestions with

     

       94
       94
       +
                 | Some suggestions ->

     

       95
       95
       +
                     ("permission_suggestions", 

     

       96
       96
       +
                      `A (List.map Permissions.Update.to_json suggestions)) :: fields

     

       97
       97
       +
                 | None -> fields

     

       98
       98
       +
               in

     

       99
       99
       +
               let fields = match p.blocked_path with

     

       100
       100
       +
                 | Some path -> ("blocked_path", `String path) :: fields

     

       101
       101
       +
                 | None -> fields

     

       102
       102
       +
               in

     

       103
       103
       +
               `O fields

     

       104
       104
       +
           | Initialize i ->

     

       105
       105
       +
               let fields = [("subtype", `String "initialize")] in

     

       106
       106
       +
               let fields = match i.hooks with

     

       107
       107
       +
                 | Some hooks ->

     

       108
       108
       +
                     ("hooks", `O hooks) :: fields

     

       109
       109
       +
                 | None -> fields

     

       110
       110
       +
               in

     

       111
       111
       +
               `O fields

     

       112
       112
       +
           | Set_permission_mode s ->

     

       113
       113
       +
               `O [

     

       114
       114
       +
                 ("subtype", `String "set_permission_mode");

     

       115
       115
       +
                 ("mode", Permissions.Mode.to_json s.mode);

     

       116
       116
       +
               ]

     

       117
       117
       +
           | Hook_callback h ->

     

       118
       118
       +
               let fields = [

     

       119
       119
       +
                 ("subtype", `String "hook_callback");

     

       120
       120
       +
                 ("callback_id", `String h.callback_id);

     

       121
       121
       +
                 ("input", h.input);

     

       122
       122
       +
               ] in

     

       123
       123
       +
               let fields = match h.tool_use_id with

     

       124
       124
       +
                 | Some id -> ("tool_use_id", `String id) :: fields

     

       125
       125
       +
                 | None -> fields

     

       126
       126
       +
               in

     

       127
       127
       +
               `O fields

     

       128
       128
       +
           | Mcp_message m ->

     

       129
       129
       +
               `O [

     

       130
       130
       +
                 ("subtype", `String "mcp_message");

     

       131
       131
       +
                 ("server_name", `String m.server_name);

     

       132
       132
       +
                 ("message", m.message);

     

       133
       133
       +
               ]

     

       134
       134
       +
         

     

       135
       135
       +
         let of_json = function

     

       136
       136
       +
           | `O fields ->

     

       137
       137
       +
               let subtype = JU.assoc_string "subtype" fields in

     

       138
       138
       +
               (match subtype with

     

       139
       139
       +
               | "interrupt" ->

     

       140
       140
       +
                   Interrupt { subtype = `Interrupt }

     

       141
       141
       +
               | "can_use_tool" ->

     

       142
       142
       +
                   let tool_name = JU.assoc_string "tool_name" fields in

     

       143
       143
       +
                   let input = List.assoc "input" fields in

     

       144
       144
       +
                   let permission_suggestions =

     

       145
       145
       +
                     match List.assoc_opt "permission_suggestions" fields with

     

       146
       146
       +
                     | Some (`A lst) -> 

     

       147
       147
       +
                         Some (List.map Permissions.Update.of_json lst)

     

       148
       148
       +
                     | _ -> None

     

       149
       149
       +
                   in

     

       150
       150
       +
                   let blocked_path = JU.assoc_string_opt "blocked_path" fields in

     

       151
       151
       +
                   Permission {

     

       152
       152
       +
                     subtype = `Can_use_tool;

     

       153
       153
       +
                     tool_name;

     

       154
       154
       +
                     input;

     

       155
       155
       +
                     permission_suggestions;

     

       156
       156
       +
                     blocked_path;

     

       157
       157
       +
                   }

     

       158
       158
       +
               | "initialize" ->

     

       159
       159
       +
                   let hooks =

     

       160
       160
       +
                     match List.assoc_opt "hooks" fields with

     

       161
       161
       +
                     | Some (`O hooks) -> Some hooks

     

       162
       162
       +
                     | _ -> None

     

       163
       163
       +
                   in

     

       164
       164
       +
                   Initialize { subtype = `Initialize; hooks }

     

       165
       165
       +
               | "set_permission_mode" ->

     

       166
       166
       +
                   let mode = List.assoc "mode" fields |> Permissions.Mode.of_json in

     

       167
       167
       +
                   Set_permission_mode { subtype = `Set_permission_mode; mode }

     

       168
       168
       +
               | "hook_callback" ->

     

       169
       169
       +
                   let callback_id = JU.assoc_string "callback_id" fields in

     

       170
       170
       +
                   let input = List.assoc "input" fields in

     

       171
       171
       +
                   let tool_use_id = JU.assoc_string_opt "tool_use_id" fields in

     

       172
       172
       +
                   Hook_callback {

     

       173
       173
       +
                     subtype = `Hook_callback;

     

       174
       174
       +
                     callback_id;

     

       175
       175
       +
                     input;

     

       176
       176
       +
                     tool_use_id;

     

       177
       177
       +
                   }

     

       178
       178
       +
               | "mcp_message" ->

     

       179
       179
       +
                   let server_name = JU.assoc_string "server_name" fields in

     

       180
       180
       +
                   let message = List.assoc "message" fields in

     

       181
       181
       +
                   Mcp_message {

     

       182
       182
       +
                     subtype = `Mcp_message;

     

       183
       183
       +
                     server_name;

     

       184
       184
       +
                     message;

     

       185
       185
       +
                   }

     

       186
       186
       +
               | _ -> raise (Invalid_argument ("Unknown request subtype: " ^ subtype)))

     

       187
       187
       +
           | _ -> raise (Invalid_argument "Request.of_json: expected object")

     

       188
       188
       +
         

     

       189
       189
       +
         let pp fmt = function

     

       190
       190
       +
           | Interrupt _ ->

     

       191
       191
       +
               Fmt.pf fmt "@[<2>Interrupt@]"

     

       192
       192
       +
           | Permission p ->

     

       193
       193
       +
               Fmt.pf fmt "@[<2>Permission@ { tool = %S;@ blocked_path = %a }@]"

     

       194
       194
       +
                 p.tool_name Fmt.(option string) p.blocked_path

     

       195
       195
       +
           | Initialize i ->

     

       196
       196
       +
               Fmt.pf fmt "@[<2>Initialize@ { hooks = %s }@]"

     

       197
       197
       +
                 (if Option.is_some i.hooks then "present" else "none")

     

       198
       198
       +
           | Set_permission_mode s ->

     

       199
       199
       +
               Fmt.pf fmt "@[<2>SetPermissionMode@ { mode = %a }@]"

     

       200
       200
       +
                 Permissions.Mode.pp s.mode

     

       201
       201
       +
           | Hook_callback h ->

     

       202
       202
       +
               Fmt.pf fmt "@[<2>HookCallback@ { id = %S;@ tool_use_id = %a }@]"

     

       203
       203
       +
                 h.callback_id Fmt.(option string) h.tool_use_id

     

       204
       204
       +
           | Mcp_message m ->

     

       205
       205
       +
               Fmt.pf fmt "@[<2>McpMessage@ { server = %S }@]"

     

       206
       206
       +
                 m.server_name

     

       207
       207
       +
       end

     

       208
       208
       +
       

     

       209
       209
       +
       module Response = struct

     

       210
       210
       +
         type success = {

     

       211
       211
       +
           subtype : [`Success];

     

       212
       212
       +
           request_id : string;

     

       213
       213
       +
           response : value option;

     

       214
       214
       +
         }

     

       215
       215
       +
         

     

       216
       216
       +
         type error = {

     

       217
       217
       +
           subtype : [`Error];

     

       218
       218
       +
           request_id : string;

     

       219
       219
       +
           error : string;

     

       220
       220
       +
         }

     

       221
       221
       +
         

     

       222
       222
       +
         type t =

     

       223
       223
       +
           | Success of success

     

       224
       224
       +
           | Error of error

     

       225
       225
       +
         

     

       226
       226
       +
         let success ~request_id ?response () =

     

       227
       227
       +
           Success {

     

       228
       228
       +
             subtype = `Success;

     

       229
       229
       +
             request_id;

     

       230
       230
       +
             response;

     

       231
       231
       +
           }

     

       232
       232
       +
         

     

       233
       233
       +
         let error ~request_id ~error =

     

       234
       234
       +
           Error {

     

       235
       235
       +
             subtype = `Error;

     

       236
       236
       +
             request_id;

     

       237
       237
       +
             error;

     

       238
       238
       +
           }

     

       239
       239
       +
         

     

       240
       240
       +
         let to_json = function

     

       241
       241
       +
           | Success s ->

     

       242
       242
       +
               let fields = [

     

       243
       243
       +
                 ("subtype", `String "success");

     

       244
       244
       +
                 ("request_id", `String s.request_id);

     

       245
       245
       +
               ] in

     

       246
       246
       +
               let fields = match s.response with

     

       247
       247
       +
                 | Some resp -> ("response", resp) :: fields

     

       248
       248
       +
                 | None -> fields

     

       249
       249
       +
               in

     

       250
       250
       +
               `O fields

     

       251
       251
       +
           | Error e ->

     

       252
       252
       +
               `O [

     

       253
       253
       +
                 ("subtype", `String "error");

     

       254
       254
       +
                 ("request_id", `String e.request_id);

     

       255
       255
       +
                 ("error", `String e.error);

     

       256
       256
       +
               ]

     

       257
       257
       +
         

     

       258
       258
       +
         let of_json = function

     

       259
       259
       +
           | `O fields ->

     

       260
       260
       +
               let subtype = JU.assoc_string "subtype" fields in

     

       261
       261
       +
               let request_id = JU.assoc_string "request_id" fields in

     

       262
       262
       +
               (match subtype with

     

       263
       263
       +
               | "success" ->

     

       264
       264
       +
                   let response = List.assoc_opt "response" fields in

     

       265
       265
       +
                   Success {

     

       266
       266
       +
                     subtype = `Success;

     

       267
       267
       +
                     request_id;

     

       268
       268
       +
                     response;

     

       269
       269
       +
                   }

     

       270
       270
       +
               | "error" ->

     

       271
       271
       +
                   let error = JU.assoc_string "error" fields in

     

       272
       272
       +
                   Error {

     

       273
       273
       +
                     subtype = `Error;

     

       274
       274
       +
                     request_id;

     

       275
       275
       +
                     error;

     

       276
       276
       +
                   }

     

       277
       277
       +
               | _ -> raise (Invalid_argument ("Unknown response subtype: " ^ subtype)))

     

       278
       278
       +
           | _ -> raise (Invalid_argument "Response.of_json: expected object")

     

       279
       279
       +
         

     

       280
       280
       +
         let pp fmt = function

     

       281
       281
       +
           | Success s ->

     

       282
       282
       +
               Fmt.pf fmt "@[<2>Success@ { request_id = %S;@ response = %s }@]"

     

       283
       283
       +
                 s.request_id (if Option.is_some s.response then "present" else "none")

     

       284
       284
       +
           | Error e ->

     

       285
       285
       +
               Fmt.pf fmt "@[<2>Error@ { request_id = %S;@ error = %S }@]"

     

       286
       286
       +
                 e.request_id e.error

     

       287
       287
       +
       end

     

       288
       288
       +
       

     

       289
       289
       +
       type control_request = {

     

       290
       290
       +
         type_ : [`Control_request];

     

       291
       291
       +
         request_id : string;

     

       292
       292
       +
         request : Request.t;

     

       293
       293
       +
       }

     

       294
       294
       +
       

     

       295
       295
       +
       type control_response = {

     

       296
       296
       +
         type_ : [`Control_response];

     

       297
       297
       +
         response : Response.t;

     

       298
       298
       +
       }

     

       299
       299
       +
       

     

       300
       300
       +
       type t =

     

       301
       301
       +
         | Request of control_request

     

       302
       302
       +
         | Response of control_response

     

       303
       303
       +
       

     

       304
       304
       +
       let create_request ~request_id ~request =

     

       305
       305
       +
         Request {

     

       306
       306
       +
           type_ = `Control_request;

     

       307
       307
       +
           request_id;

     

       308
       308
       +
           request;

     

       309
       309
       +
         }

     

       310
       310
       +
       

     

       311
       311
       +
       let create_response ~response =

     

       312
       312
       +
         Response {

     

       313
       313
       +
           type_ = `Control_response;

     

       314
       314
       +
           response;

     

       315
       315
       +
         }

     

       316
       316
       +
       

     

       317
       317
       +
       let to_json = function

     

       318
       318
       +
         | Request r ->

     

       319
       319
       +
             `O [

     

       320
       320
       +
               ("type", `String "control_request");

     

       321
       321
       +
               ("request_id", `String r.request_id);

     

       322
       322
       +
               ("request", Request.to_json r.request);

     

       323
       323
       +
             ]

     

       324
       324
       +
         | Response r ->

     

       325
       325
       +
             `O [

     

       326
       326
       +
               ("type", `String "control_response");

     

       327
       327
       +
               ("response", Response.to_json r.response);

     

       328
       328
       +
             ]

     

       329
       329
       +
       

     

       330
       330
       +
       let of_json = function

     

       331
       331
       +
         | `O fields ->

     

       332
       332
       +
             let type_ = JU.assoc_string "type" fields in

     

       333
       333
       +
             (match type_ with

     

       334
       334
       +
             | "control_request" ->

     

       335
       335
       +
                 let request_id = JU.assoc_string "request_id" fields in

     

       336
       336
       +
                 let request = List.assoc "request" fields |> Request.of_json in

     

       337
       337
       +
                 Request {

     

       338
       338
       +
                   type_ = `Control_request;

     

       339
       339
       +
                   request_id;

     

       340
       340
       +
                   request;

     

       341
       341
       +
                 }

     

       342
       342
       +
             | "control_response" ->

     

       343
       343
       +
                 let response = List.assoc "response" fields |> Response.of_json in

     

       344
       344
       +
                 Response {

     

       345
       345
       +
                   type_ = `Control_response;

     

       346
       346
       +
                   response;

     

       347
       347
       +
                 }

     

       348
       348
       +
             | _ -> raise (Invalid_argument ("Unknown control type: " ^ type_)))

     

       349
       349
       +
         | _ -> raise (Invalid_argument "of_json: expected object")

     

       350
       350
       +
       

     

       351
       351
       +
       let pp fmt = function

     

       352
       352
       +
         | Request r ->

     

       353
       353
       +
             Fmt.pf fmt "@[<2>ControlRequest@ { id = %S;@ request = %a }@]"

     

       354
       354
       +
               r.request_id Request.pp r.request

     

       355
       355
       +
         | Response r ->

     

       356
       356
       +
             Fmt.pf fmt "@[<2>ControlResponse@ { %a }@]"

     

       357
       357
       +
               Response.pp r.response

     

       358
       358
       +
       

     

       359
       359
       +
       let log_request req =

     

       360
       360
       +
         Log.debug (fun m -> m "SDK control request: %a" Request.pp req)

     

       361
       361
       +
       

     

       362
       362
       +
       let log_response resp =

     

       363
       363
       +
         Log.debug (fun m -> m "SDK control response: %a" Response.pp resp)

+188

claudeio/lib/sdk_control.mli

···

       1
       1
       +
       (** SDK Control Protocol for Claude.

     

       2
       2
       +
           

     

       3
       3
       +
           This module defines the typed SDK control protocol for communication

     

       4
       4
       +
           between the SDK and Claude, including request and response types. *)

     

       5
       5
       +
       

     

       6
       6
       +
       open Ezjsonm

     

       7
       7
       +
       

     

       8
       8
       +
       (** The log source for SDK control operations *)

     

       9
       9
       +
       val src : Logs.Src.t

     

       10
       10
       +
       

     

       11
       11
       +
       (** {1 Request Types} *)

     

       12
       12
       +
       

     

       13
       13
       +
       module Request : sig

     

       14
       14
       +
         (** SDK control request types. *)

     

       15
       15
       +
         

     

       16
       16
       +
         type interrupt = {

     

       17
       17
       +
           subtype : [`Interrupt];

     

       18
       18
       +
         }

     

       19
       19
       +
         (** Interrupt request to stop execution. *)

     

       20
       20
       +
         

     

       21
       21
       +
         type permission = {

     

       22
       22
       +
           subtype : [`Can_use_tool];

     

       23
       23
       +
           tool_name : string;

     

       24
       24
       +
           input : value;

     

       25
       25
       +
           permission_suggestions : Permissions.Update.t list option;

     

       26
       26
       +
           blocked_path : string option;

     

       27
       27
       +
         }

     

       28
       28
       +
         (** Permission request for tool usage. *)

     

       29
       29
       +
         

     

       30
       30
       +
         type initialize = {

     

       31
       31
       +
           subtype : [`Initialize];

     

       32
       32
       +
           hooks : (string * value) list option;  (* Hook event to configuration *)

     

       33
       33
       +
         }

     

       34
       34
       +
         (** Initialize request with optional hook configuration. *)

     

       35
       35
       +
         

     

       36
       36
       +
         type set_permission_mode = {

     

       37
       37
       +
           subtype : [`Set_permission_mode];

     

       38
       38
       +
           mode : Permissions.Mode.t;

     

       39
       39
       +
         }

     

       40
       40
       +
         (** Request to change permission mode. *)

     

       41
       41
       +
         

     

       42
       42
       +
         type hook_callback = {

     

       43
       43
       +
           subtype : [`Hook_callback];

     

       44
       44
       +
           callback_id : string;

     

       45
       45
       +
           input : value;

     

       46
       46
       +
           tool_use_id : string option;

     

       47
       47
       +
         }

     

       48
       48
       +
         (** Hook callback request. *)

     

       49
       49
       +
         

     

       50
       50
       +
         type mcp_message = {

     

       51
       51
       +
           subtype : [`Mcp_message];

     

       52
       52
       +
           server_name : string;

     

       53
       53
       +
           message : value;

     

       54
       54
       +
         }

     

       55
       55
       +
         (** MCP server message request. *)

     

       56
       56
       +
         

     

       57
       57
       +
         type t =

     

       58
       58
       +
           | Interrupt of interrupt

     

       59
       59
       +
           | Permission of permission

     

       60
       60
       +
           | Initialize of initialize

     

       61
       61
       +
           | Set_permission_mode of set_permission_mode

     

       62
       62
       +
           | Hook_callback of hook_callback

     

       63
       63
       +
           | Mcp_message of mcp_message

     

       64
       64
       +
         (** The type of SDK control requests. *)

     

       65
       65
       +
         

     

       66
       66
       +
         val interrupt : unit -> t

     

       67
       67
       +
         (** [interrupt ()] creates an interrupt request. *)

     

       68
       68
       +
         

     

       69
       69
       +
         val permission : 

     

       70
       70
       +
           tool_name:string -> 

     

       71
       71
       +
           input:value -> 

     

       72
       72
       +
           ?permission_suggestions:Permissions.Update.t list -> 

     

       73
       73
       +
           ?blocked_path:string -> 

     

       74
       74
       +
           unit -> t

     

       75
       75
       +
         (** [permission ~tool_name ~input ?permission_suggestions ?blocked_path ()] 

     

       76
       76
       +
             creates a permission request. *)

     

       77
       77
       +
         

     

       78
       78
       +
         val initialize : ?hooks:(string * value) list -> unit -> t

     

       79
       79
       +
         (** [initialize ?hooks ()] creates an initialize request. *)

     

       80
       80
       +
         

     

       81
       81
       +
         val set_permission_mode : mode:Permissions.Mode.t -> t

     

       82
       82
       +
         (** [set_permission_mode ~mode] creates a permission mode change request. *)

     

       83
       83
       +
         

     

       84
       84
       +
         val hook_callback : 

     

       85
       85
       +
           callback_id:string -> 

     

       86
       86
       +
           input:value -> 

     

       87
       87
       +
           ?tool_use_id:string -> 

     

       88
       88
       +
           unit -> t

     

       89
       89
       +
         (** [hook_callback ~callback_id ~input ?tool_use_id ()] creates a hook callback request. *)

     

       90
       90
       +
         

     

       91
       91
       +
         val mcp_message : server_name:string -> message:value -> t

     

       92
       92
       +
         (** [mcp_message ~server_name ~message] creates an MCP message request. *)

     

       93
       93
       +
         

     

       94
       94
       +
         val to_json : t -> value

     

       95
       95
       +
         (** [to_json t] converts a request to JSON. *)

     

       96
       96
       +
         

     

       97
       97
       +
         val of_json : value -> t

     

       98
       98
       +
         (** [of_json json] parses a request from JSON.

     

       99
       99
       +
             @raise Invalid_argument if the JSON is not a valid request. *)

     

       100
       100
       +
         

     

       101
       101
       +
         val pp : Format.formatter -> t -> unit

     

       102
       102
       +
         (** [pp fmt t] pretty-prints the request. *)

     

       103
       103
       +
       end

     

       104
       104
       +
       

     

       105
       105
       +
       (** {1 Response Types} *)

     

       106
       106
       +
       

     

       107
       107
       +
       module Response : sig

     

       108
       108
       +
         (** SDK control response types. *)

     

       109
       109
       +
         

     

       110
       110
       +
         type success = {

     

       111
       111
       +
           subtype : [`Success];

     

       112
       112
       +
           request_id : string;

     

       113
       113
       +
           response : value option;

     

       114
       114
       +
         }

     

       115
       115
       +
         (** Successful response. *)

     

       116
       116
       +
         

     

       117
       117
       +
         type error = {

     

       118
       118
       +
           subtype : [`Error];

     

       119
       119
       +
           request_id : string;

     

       120
       120
       +
           error : string;

     

       121
       121
       +
         }

     

       122
       122
       +
         (** Error response. *)

     

       123
       123
       +
         

     

       124
       124
       +
         type t =

     

       125
       125
       +
           | Success of success

     

       126
       126
       +
           | Error of error

     

       127
       127
       +
         (** The type of SDK control responses. *)

     

       128
       128
       +
         

     

       129
       129
       +
         val success : request_id:string -> ?response:value -> unit -> t

     

       130
       130
       +
         (** [success ~request_id ?response ()] creates a success response. *)

     

       131
       131
       +
         

     

       132
       132
       +
         val error : request_id:string -> error:string -> t

     

       133
       133
       +
         (** [error ~request_id ~error] creates an error response. *)

     

       134
       134
       +
         

     

       135
       135
       +
         val to_json : t -> value

     

       136
       136
       +
         (** [to_json t] converts a response to JSON. *)

     

       137
       137
       +
         

     

       138
       138
       +
         val of_json : value -> t

     

       139
       139
       +
         (** [of_json json] parses a response from JSON.

     

       140
       140
       +
             @raise Invalid_argument if the JSON is not a valid response. *)

     

       141
       141
       +
         

     

       142
       142
       +
         val pp : Format.formatter -> t -> unit

     

       143
       143
       +
         (** [pp fmt t] pretty-prints the response. *)

     

       144
       144
       +
       end

     

       145
       145
       +
       

     

       146
       146
       +
       (** {1 Control Messages} *)

     

       147
       147
       +
       

     

       148
       148
       +
       type control_request = {

     

       149
       149
       +
         type_ : [`Control_request];

     

       150
       150
       +
         request_id : string;

     

       151
       151
       +
         request : Request.t;

     

       152
       152
       +
       }

     

       153
       153
       +
       (** Control request message. *)

     

       154
       154
       +
       

     

       155
       155
       +
       type control_response = {

     

       156
       156
       +
         type_ : [`Control_response];

     

       157
       157
       +
         response : Response.t;

     

       158
       158
       +
       }

     

       159
       159
       +
       (** Control response message. *)

     

       160
       160
       +
       

     

       161
       161
       +
       type t =

     

       162
       162
       +
         | Request of control_request

     

       163
       163
       +
         | Response of control_response

     

       164
       164
       +
       (** The type of SDK control messages. *)

     

       165
       165
       +
       

     

       166
       166
       +
       val create_request : request_id:string -> request:Request.t -> t

     

       167
       167
       +
       (** [create_request ~request_id ~request] creates a control request message. *)

     

       168
       168
       +
       

     

       169
       169
       +
       val create_response : response:Response.t -> t

     

       170
       170
       +
       (** [create_response ~response] creates a control response message. *)

     

       171
       171
       +
       

     

       172
       172
       +
       val to_json : t -> value

     

       173
       173
       +
       (** [to_json t] converts a control message to JSON. *)

     

       174
       174
       +
       

     

       175
       175
       +
       val of_json : value -> t

     

       176
       176
       +
       (** [of_json json] parses a control message from JSON.

     

       177
       177
       +
           @raise Invalid_argument if the JSON is not a valid control message. *)

     

       178
       178
       +
       

     

       179
       179
       +
       val pp : Format.formatter -> t -> unit

     

       180
       180
       +
       (** [pp fmt t] pretty-prints the control message. *)

     

       181
       181
       +
       

     

       182
       182
       +
       (** {1 Logging} *)

     

       183
       183
       +
       

     

       184
       184
       +
       val log_request : Request.t -> unit

     

       185
       185
       +
       (** [log_request req] logs an SDK control request. *)

     

       186
       186
       +
       

     

       187
       187
       +
       val log_response : Response.t -> unit

     

       188
       188
       +
       (** [log_response resp] logs an SDK control response. *)