comparing 020cd88ca86851b9ca3d3143c398486510402617 and jsont on anil.recoil.org/slop

claudeio/claude.opam

···

       10
       10
        
         "fmt"

     

       11
       11
        
         "logs"

     

       12
       12
        
         "ezjsonm"

     

       13
       13
       +
         "jsont" {>= "0.2.0"}

     

       13
       14
        
         "alcotest" {with-test}

     

       14
       15
        
         "odoc" {with-doc}

     

       15
       16
        
       ]

claudeio/dune-project

···

       13
       13
        
         fmt

     

       14
       14
        
         logs

     

       15
       15
        
         ezjsonm

     

       16
       16
       +
         (jsont (>= 0.2.0))

     

       16
       17
        
         (alcotest :with-test)))

claudeio/lib/claude.ml

···

       1
       1
       +
       module Model = Model

     

       1
       2
        
       module Content_block = Content_block

     

       2
       3
        
       module Message = Message

     

       3
       4
        
       module Control = Control

     

       4
       5
        
       module Permissions = Permissions

     

       5
       6
        
       module Hooks = Hooks

     

       7
       7
       +
       module Sdk_control = Sdk_control

     

       8
       8
       +
       module Structured_output = Structured_output

     

       6
       9
        
       module Options = Options

     

       7
       10
        
       module Transport = Transport

     

       8
       11
        
       module Client = Client

claudeio/lib/claude.mli

···

       153
       153
        
       module Options = Options

     

       154
       154
        
       (** Configuration options for Claude sessions. *)

     

       155
       155
        
       

     

       156
       156
       +
       module Model = Model

     

       157
       157
       +
       (** Claude AI model identifiers with type-safe variants. *)

     

       158
       158
       +
       

     

       156
       159
        
       module Content_block = Content_block

     

       157
       160
        
       (** Content blocks for messages (text, tool use, tool results, thinking). *)

     

       158
       161
        
       

     
···

       167
       170
        
       

     

       168
       171
        
       module Hooks = Hooks

     

       169
       172
        
       (** Hooks system for event interception. *)

     

       173
       173
       +
       

     

       174
       174
       +
       module Sdk_control = Sdk_control

     

       175
       175
       +
       (** SDK control protocol for dynamic configuration. *)

     

       176
       176
       +
       

     

       177
       177
       +
       module Structured_output = Structured_output

     

       178
       178
       +
       (** Structured output support using JSON Schema. *)

     

       170
       179
        
       

     

       171
       180
        
       module Transport = Transport

     

       172
       181
        
       (** Low-level transport layer for CLI communication. *)

+80 -1

claudeio/lib/client.ml

···

       8
       8
        
         hook_callbacks : (string, Hooks.callback) Hashtbl.t;

     

       9
       9
        
         mutable next_callback_id : int;

     

       10
       10
        
         mutable session_id : string option;

     

       11
       11
       +
         control_responses : (string, Ezjsonm.value) Hashtbl.t;

     

       12
       12
       +
         control_mutex : Eio.Mutex.t;

     

       13
       13
       +
         control_condition : Eio.Condition.t;

     

       11
       14
        
       }

     

       12
       15
        
       

     

       13
       16
        
       let handle_control_request t control_msg =

     
···

       166
       169
        
                       (* Handle control responses (e.g., initialize response) *)

     

       167
       170
        
                       let request_id = Json_utils.find_string json ["response"; "request_id"] in

     

       168
       171
        
                       Log.debug (fun m -> m "Received control response for request_id: %s" request_id);

     

       169
       169
       -
                       (* Don't yield control responses as messages, just loop *)

     

       172
       172
       +
                       (* Store the response and signal waiting threads *)

     

       173
       173
       +
                       Eio.Mutex.use_rw ~protect:false t.control_mutex (fun () ->

     

       174
       174
       +
                         Hashtbl.replace t.control_responses request_id json;

     

       175
       175
       +
                         Eio.Condition.broadcast t.control_condition

     

       176
       176
       +
                       );

     

       170
       177
        
                       loop ()

     

       171
       178
        
       

     

       172
       179
        
                   | _ ->

     
···

       217
       224
        
           hook_callbacks;

     

       218
       225
        
           next_callback_id = 0;

     

       219
       226
        
           session_id = None;

     

       227
       227
       +
           control_responses = Hashtbl.create 16;

     

       228
       228
       +
           control_mutex = Eio.Mutex.create ();

     

       229
       229
       +
           control_condition = Eio.Condition.create ();

     

       220
       230
        
         } in

     

       221
       231
        
       

     

       222
       232
        
         (* Register hooks and send initialize if hooks are configured *)

     
···

       310
       320
        
       

     

       311
       321
        
       let with_permission_callback t callback =

     

       312
       322
        
         { t with permission_callback = Some callback }

     

       323
       323
       +
       

     

       324
       324
       +
       (* Helper to send a control request and wait for response *)

     

       325
       325
       +
       let send_control_request t ~request_id request =

     

       326
       326
       +
         let open Ezjsonm in

     

       327
       327
       +
         (* Send the control request *)

     

       328
       328
       +
         let control_msg = Sdk_control.create_request ~request_id ~request in

     

       329
       329
       +
         let json = Sdk_control.to_json control_msg in

     

       330
       330
       +
         Log.info (fun m -> m "Sending control request: %s" (value_to_string json));

     

       331
       331
       +
         Transport.send t.transport json;

     

       332
       332
       +
       

     

       333
       333
       +
         (* Wait for the response with timeout *)

     

       334
       334
       +
         let max_wait = 10.0 in (* 10 seconds timeout *)

     

       335
       335
       +
         let start_time = Unix.gettimeofday () in

     

       336
       336
       +
       

     

       337
       337
       +
         let rec wait_for_response () =

     

       338
       338
       +
           Eio.Mutex.use_rw ~protect:false t.control_mutex (fun () ->

     

       339
       339
       +
             match Hashtbl.find_opt t.control_responses request_id with

     

       340
       340
       +
             | Some response_json ->

     

       341
       341
       +
                 (* Remove it from the table *)

     

       342
       342
       +
                 Hashtbl.remove t.control_responses request_id;

     

       343
       343
       +
                 response_json

     

       344
       344
       +
             | None ->

     

       345
       345
       +
                 let elapsed = Unix.gettimeofday () -. start_time in

     

       346
       346
       +
                 if elapsed > max_wait then

     

       347
       347
       +
                   raise (Failure (Printf.sprintf "Timeout waiting for control response: %s" request_id))

     

       348
       348
       +
                 else (

     

       349
       349
       +
                   (* Release mutex and wait for signal *)

     

       350
       350
       +
                   Eio.Condition.await_no_mutex t.control_condition;

     

       351
       351
       +
                   wait_for_response ()

     

       352
       352
       +
                 )

     

       353
       353
       +
           )

     

       354
       354
       +
         in

     

       355
       355
       +
       

     

       356
       356
       +
         let response_json = wait_for_response () in

     

       357
       357
       +
         Log.debug (fun m -> m "Received control response: %s" (value_to_string response_json));

     

       358
       358
       +
       

     

       359
       359
       +
         (* Parse the response *)

     

       360
       360
       +
         let response = find response_json ["response"] |> Sdk_control.Response.of_json in

     

       361
       361
       +
         match response with

     

       362
       362
       +
         | Sdk_control.Response.Success s -> s.response

     

       363
       363
       +
         | Sdk_control.Response.Error e ->

     

       364
       364
       +
             raise (Failure (Printf.sprintf "Control request failed: %s" e.error))

     

       365
       365
       +
       

     

       366
       366
       +
       let set_permission_mode t mode =

     

       367
       367
       +
         let request_id = Printf.sprintf "set_perm_mode_%f" (Unix.gettimeofday ()) in

     

       368
       368
       +
         let request = Sdk_control.Request.set_permission_mode ~mode in

     

       369
       369
       +
         let _response = send_control_request t ~request_id request in

     

       370
       370
       +
         Log.info (fun m -> m "Permission mode set to: %a" Permissions.Mode.pp mode)

     

       371
       371
       +
       

     

       372
       372
       +
       let set_model t model =

     

       373
       373
       +
         let model_str = Model.to_string model in

     

       374
       374
       +
         let request_id = Printf.sprintf "set_model_%f" (Unix.gettimeofday ()) in

     

       375
       375
       +
         let request = Sdk_control.Request.set_model ~model:model_str in

     

       376
       376
       +
         let _response = send_control_request t ~request_id request in

     

       377
       377
       +
         Log.info (fun m -> m "Model set to: %a" Model.pp model)

     

       378
       378
       +
       

     

       379
       379
       +
       let set_model_string t model_str =

     

       380
       380
       +
         set_model t (Model.of_string model_str)

     

       381
       381
       +
       

     

       382
       382
       +
       let get_server_info t =

     

       383
       383
       +
         let request_id = Printf.sprintf "get_server_info_%f" (Unix.gettimeofday ()) in

     

       384
       384
       +
         let request = Sdk_control.Request.get_server_info () in

     

       385
       385
       +
         match send_control_request t ~request_id request with

     

       386
       386
       +
         | Some response_data ->

     

       387
       387
       +
             let server_info = Sdk_control.Server_info.of_json response_data in

     

       388
       388
       +
             Log.info (fun m -> m "Retrieved server info: %a" Sdk_control.Server_info.pp server_info);

     

       389
       389
       +
             server_info

     

       390
       390
       +
         | None ->

     

       391
       391
       +
             raise (Failure "No response data from get_server_info request")

+193 -3

claudeio/lib/client.mli

···

       1
       1
       +
       (** Client interface for interacting with Claude.

     

       2
       2
       +
       

     

       3
       3
       +
           This module provides the high-level client API for sending messages to

     

       4
       4
       +
           Claude and receiving responses. It handles the bidirectional streaming

     

       5
       5
       +
           protocol, permission callbacks, and hooks.

     

       6
       6
       +
       

     

       7
       7
       +
           {2 Basic Usage}

     

       8
       8
       +
       

     

       9
       9
       +
           {[

     

       10
       10
       +
             Eio.Switch.run @@ fun sw ->

     

       11
       11
       +
               let client = Client.create ~sw ~process_mgr () in

     

       12
       12
       +
               Client.query client "What is 2+2?";

     

       13
       13
       +
       

     

       14
       14
       +
               let messages = Client.receive_all client in

     

       15
       15
       +
               List.iter (function

     

       16
       16
       +
                 | Message.Assistant msg ->

     

       17
       17
       +
                     Printf.printf "Claude: %s\n" (Message.Assistant.text msg)

     

       18
       18
       +
                 | _ -> ()

     

       19
       19
       +
               ) messages

     

       20
       20
       +
           ]}

     

       21
       21
       +
       

     

       22
       22
       +
           {2 Features}

     

       23
       23
       +
       

     

       24
       24
       +
           - {b Message Streaming}: Messages are streamed lazily via {!Seq.t}

     

       25
       25
       +
           - {b Permission Control}: Custom permission callbacks for tool usage

     

       26
       26
       +
           - {b Hooks}: Intercept and modify tool execution

     

       27
       27
       +
           - {b Dynamic Control}: Change settings mid-conversation

     

       28
       28
       +
           - {b Resource Management}: Automatic cleanup via Eio switches

     

       29
       29
       +
       

     

       30
       30
       +
           {2 Message Flow}

     

       31
       31
       +
       

     

       32
       32
       +
           1. Create a client with {!create}

     

       33
       33
       +
           2. Send messages with {!query} or {!send_message}

     

       34
       34
       +
           3. Receive responses with {!receive} or {!receive_all}

     

       35
       35
       +
           4. Continue multi-turn conversations by sending more messages

     

       36
       36
       +
           5. Client automatically cleans up when the switch exits

     

       37
       37
       +
       

     

       38
       38
       +
           {2 Advanced Features}

     

       39
       39
       +
       

     

       40
       40
       +
           - Permission discovery mode for understanding required permissions

     

       41
       41
       +
           - Mid-conversation model switching and permission mode changes

     

       42
       42
       +
           - Server capability introspection *)

     

       43
       43
       +
       

     

       1
       44
        
       (** The log source for client operations *)

     

       2
       45
        
       val src : Logs.Src.t

     

       3
       46
        
       

     

       4
       47
        
       type t

     

       48
       48
       +
       (** The type of Claude clients. *)

     

       5
       49
        
       

     

       6
       6
       -
       val create : 

     

       7
       7
       -
         ?options:Options.t -> 

     

       8
       8
       -
         sw:Eio.Switch.t -> 

     

       50
       50
       +
       val create :

     

       51
       51
       +
         ?options:Options.t ->

     

       52
       52
       +
         sw:Eio.Switch.t ->

     

       9
       53
        
         process_mgr:_ Eio.Process.mgr ->

     

       10
       54
        
         unit -> t

     

       55
       55
       +
       (** [create ?options ~sw ~process_mgr ()] creates a new Claude client.

     

       56
       56
       +
       

     

       57
       57
       +
           @param options Configuration options (defaults to {!Options.default})

     

       58
       58
       +
           @param sw Eio switch for resource management

     

       59
       59
       +
           @param process_mgr Eio process manager for spawning the Claude CLI *)

     

       11
       60
        
       

     

       12
       61
        
       val query : t -> string -> unit

     

       62
       62
       +
       (** [query t prompt] sends a text message to Claude.

     

       63
       63
       +
       

     

       64
       64
       +
           This is a convenience function for simple string messages. For more

     

       65
       65
       +
           complex messages with tool results or multiple content blocks, use

     

       66
       66
       +
           {!send_message} instead. *)

     

       67
       67
       +
       

     

       13
       68
        
       val send_message : t -> Message.t -> unit

     

       69
       69
       +
       (** [send_message t msg] sends a message to Claude.

     

       70
       70
       +
       

     

       71
       71
       +
           Supports all message types including user messages with tool results. *)

     

       72
       72
       +
       

     

       14
       73
        
       val send_user_message : t -> Message.User.t -> unit

     

       74
       74
       +
       (** [send_user_message t msg] sends a user message to Claude. *)

     

       15
       75
        
       

     

       16
       76
        
       val receive : t -> Message.t Seq.t

     

       77
       77
       +
       (** [receive t] returns a lazy sequence of messages from Claude.

     

       78
       78
       +
       

     

       79
       79
       +
           The sequence yields messages as they arrive from Claude, including:

     

       80
       80
       +
           - {!Message.Assistant} - Claude's responses

     

       81
       81
       +
           - {!Message.System} - System notifications

     

       82
       82
       +
           - {!Message.Result} - Final result with usage statistics

     

       83
       83
       +
       

     

       84
       84
       +
           Control messages (permission requests, hook callbacks) are handled

     

       85
       85
       +
           internally and not yielded to the sequence. *)

     

       86
       86
       +
       

     

       17
       87
        
       val receive_all : t -> Message.t list

     

       88
       88
       +
       (** [receive_all t] collects all messages into a list.

     

       89
       89
       +
       

     

       90
       90
       +
           This is a convenience function that consumes the {!receive} sequence.

     

       91
       91
       +
           Use this when you want to process all messages at once rather than

     

       92
       92
       +
           streaming them. *)

     

       18
       93
        
       

     

       19
       94
        
       val interrupt : t -> unit

     

       95
       95
       +
       (** [interrupt t] sends an interrupt signal to stop Claude's execution. *)

     

       20
       96
        
       

     

       21
       97
        
       val discover_permissions : t -> t

     

       98
       98
       +
       (** [discover_permissions t] enables permission discovery mode.

     

       99
       99
       +
       

     

       100
       100
       +
           In discovery mode, all tool usage is logged but allowed. Use

     

       101
       101
       +
           {!get_discovered_permissions} to retrieve the list of permissions

     

       102
       102
       +
           that were requested during execution.

     

       103
       103
       +
       

     

       104
       104
       +
           This is useful for understanding what permissions your prompt requires. *)

     

       105
       105
       +
       

     

       22
       106
        
       val get_discovered_permissions : t -> Permissions.Rule.t list

     

       107
       107
       +
       (** [get_discovered_permissions t] returns permissions discovered during execution.

     

       108
       108
       +
       

     

       109
       109
       +
           Only useful after enabling {!discover_permissions}. *)

     

       110
       110
       +
       

     

       23
       111
        
       val with_permission_callback : t -> Permissions.callback -> t

     

       112
       112
       +
       (** [with_permission_callback t callback] updates the permission callback.

     

       113
       113
       +
       

     

       114
       114
       +
           Allows dynamically changing the permission callback without recreating

     

       115
       115
       +
           the client. *)

     

       116
       116
       +
       

     

       117
       117
       +
       (** {1 Dynamic Control Methods}

     

       118
       118
       +
       

     

       119
       119
       +
           These methods allow you to change Claude's behavior mid-conversation

     

       120
       120
       +
           without recreating the client. This is useful for:

     

       121
       121
       +
       

     

       122
       122
       +
           - Adjusting permission strictness based on user feedback

     

       123
       123
       +
           - Switching to faster/cheaper models for simple tasks

     

       124
       124
       +
           - Adapting to changing requirements during long conversations

     

       125
       125
       +
           - Introspecting server capabilities

     

       126
       126
       +
       

     

       127
       127
       +
           {2 Example: Adaptive Permission Control}

     

       128
       128
       +
       

     

       129
       129
       +
           {[

     

       130
       130
       +
             (* Start with strict permissions *)

     

       131
       131
       +
             let client = Client.create ~sw ~process_mgr

     

       132
       132
       +
               ~options:(Options.default

     

       133
       133
       +
                         |> Options.with_permission_mode Permissions.Mode.Default) ()

     

       134
       134
       +
             in

     

       135
       135
       +
       

     

       136
       136
       +
             Client.query client "Analyze this code";

     

       137
       137
       +
             let _ = Client.receive_all client in

     

       138
       138
       +
       

     

       139
       139
       +
             (* User approves, switch to auto-accept edits *)

     

       140
       140
       +
             Client.set_permission_mode client Permissions.Mode.Accept_edits;

     

       141
       141
       +
       

     

       142
       142
       +
             Client.query client "Now refactor it";

     

       143
       143
       +
             let _ = Client.receive_all client in

     

       144
       144
       +
           ]}

     

       145
       145
       +
       

     

       146
       146
       +
           {2 Example: Model Switching for Efficiency}

     

       147
       147
       +
       

     

       148
       148
       +
           {[

     

       149
       149
       +
             (* Use powerful model for complex analysis *)

     

       150
       150
       +
             let client = Client.create ~sw ~process_mgr

     

       151
       151
       +
               ~options:(Options.default |> Options.with_model "claude-sonnet-4-5") ()

     

       152
       152
       +
             in

     

       153
       153
       +
       

     

       154
       154
       +
             Client.query client "Design a new architecture for this system";

     

       155
       155
       +
             let _ = Client.receive_all client in

     

       156
       156
       +
       

     

       157
       157
       +
             (* Switch to faster model for simple tasks *)

     

       158
       158
       +
             Client.set_model client "claude-haiku-4";

     

       159
       159
       +
       

     

       160
       160
       +
             Client.query client "Now write a README";

     

       161
       161
       +
             let _ = Client.receive_all client in

     

       162
       162
       +
           ]}

     

       163
       163
       +
       

     

       164
       164
       +
           {2 Example: Server Introspection}

     

       165
       165
       +
       

     

       166
       166
       +
           {[

     

       167
       167
       +
             let info = Client.get_server_info client in

     

       168
       168
       +
             Printf.printf "Claude CLI version: %s\n"

     

       169
       169
       +
               (Sdk_control.Server_info.version info);

     

       170
       170
       +
             Printf.printf "Capabilities: %s\n"

     

       171
       171
       +
               (String.concat ", " (Sdk_control.Server_info.capabilities info));

     

       172
       172
       +
           ]} *)

     

       173
       173
       +
       

     

       174
       174
       +
       val set_permission_mode : t -> Permissions.Mode.t -> unit

     

       175
       175
       +
       (** [set_permission_mode t mode] changes the permission mode mid-conversation.

     

       176
       176
       +
       

     

       177
       177
       +
           This allows switching between permission modes without recreating the client:

     

       178
       178
       +
           - {!Permissions.Mode.Default} - Prompt for all permissions

     

       179
       179
       +
           - {!Permissions.Mode.Accept_edits} - Auto-accept file edits

     

       180
       180
       +
           - {!Permissions.Mode.Plan} - Planning mode with restricted execution

     

       181
       181
       +
           - {!Permissions.Mode.Bypass_permissions} - Skip all permission checks

     

       182
       182
       +
       

     

       183
       183
       +
           @raise Failure if the server returns an error *)

     

       184
       184
       +
       

     

       185
       185
       +
       val set_model : t -> Model.t -> unit

     

       186
       186
       +
       (** [set_model t model] switches to a different AI model mid-conversation.

     

       187
       187
       +
       

     

       188
       188
       +
           Common models:

     

       189
       189
       +
           - [`Sonnet_4_5] - Most capable, balanced performance

     

       190
       190
       +
           - [`Opus_4] - Maximum capability for complex tasks

     

       191
       191
       +
           - [`Haiku_4] - Fast and cost-effective

     

       192
       192
       +
       

     

       193
       193
       +
           @raise Failure if the model is invalid or unavailable *)

     

       194
       194
       +
       

     

       195
       195
       +
       val set_model_string : t -> string -> unit

     

       196
       196
       +
       (** [set_model_string t model] switches to a different AI model using a string.

     

       197
       197
       +
       

     

       198
       198
       +
           This is a convenience function that parses the string using {!Model.of_string}.

     

       199
       199
       +
       

     

       200
       200
       +
           @raise Failure if the model is invalid or unavailable *)

     

       201
       201
       +
       

     

       202
       202
       +
       val get_server_info : t -> Sdk_control.Server_info.t

     

       203
       203
       +
       (** [get_server_info t] retrieves server capabilities and metadata.

     

       204
       204
       +
       

     

       205
       205
       +
           Returns information about:

     

       206
       206
       +
           - Server version string

     

       207
       207
       +
           - Available capabilities

     

       208
       208
       +
           - Supported commands

     

       209
       209
       +
           - Available output styles

     

       210
       210
       +
       

     

       211
       211
       +
           Useful for feature detection and debugging.

     

       212
       212
       +
       

     

       213
       213
       +
           @raise Failure if the server returns an error *)

+1 -1

claudeio/lib/dune

···

       1
       1
        
       (library

     

       2
       2
        
        (public_name claude)

     

       3
       3
        
        (name claude)

     

       4
       4
       -
        (libraries eio eio.unix ezjsonm fmt logs))
     

       4
       4
       +
        (libraries eio eio.unix ezjsonm fmt logs jsont))

+65 -21

claudeio/lib/message.ml

···

       98
       98
        
       end

     

       99
       99
        
       

     

       100
       100
        
       module Assistant = struct

     

       101
       101
       +
         type error = [

     

       102
       102
       +
           | `Authentication_failed

     

       103
       103
       +
           | `Billing_error

     

       104
       104
       +
           | `Rate_limit

     

       105
       105
       +
           | `Invalid_request

     

       106
       106
       +
           | `Server_error

     

       107
       107
       +
           | `Unknown

     

       108
       108
       +
         ]

     

       109
       109
       +
       

     

       110
       110
       +
         let error_to_string = function

     

       111
       111
       +
           | `Authentication_failed -> "authentication_failed"

     

       112
       112
       +
           | `Billing_error -> "billing_error"

     

       113
       113
       +
           | `Rate_limit -> "rate_limit"

     

       114
       114
       +
           | `Invalid_request -> "invalid_request"

     

       115
       115
       +
           | `Server_error -> "server_error"

     

       116
       116
       +
           | `Unknown -> "unknown"

     

       117
       117
       +
       

     

       118
       118
       +
         let error_of_string = function

     

       119
       119
       +
           | "authentication_failed" -> `Authentication_failed

     

       120
       120
       +
           | "billing_error" -> `Billing_error

     

       121
       121
       +
           | "rate_limit" -> `Rate_limit

     

       122
       122
       +
           | "invalid_request" -> `Invalid_request

     

       123
       123
       +
           | "server_error" -> `Server_error

     

       124
       124
       +
           | "unknown" | _ -> `Unknown

     

       125
       125
       +
       

     

       101
       126
        
         type t = {

     

       102
       127
        
           content : Content_block.t list;

     

       103
       128
        
           model : string;

     

       129
       129
       +
           error : error option;

     

       104
       130
        
         }

     

       105
       105
       -
         

     

       106
       106
       -
         let create ~content ~model = { content; model }

     

       131
       131
       +
       

     

       132
       132
       +
         let create ~content ~model ?error () = { content; model; error }

     

       107
       133
        
         let content t = t.content

     

       108
       134
        
         let model t = t.model

     

       135
       135
       +
         let error t = t.error

     

       109
       136
        
         

     

       110
       137
        
         let get_text_blocks t =

     

       111
       138
        
           List.filter_map (function

     
···

       135
       162
        
           String.concat "\n" (get_text_blocks t)

     

       136
       163
        
         

     

       137
       164
        
         let to_json t =

     

       165
       165
       +
           let msg_fields = [

     

       166
       166
       +
             ("content", `A (List.map Content_block.to_json t.content));

     

       167
       167
       +
             ("model", `String t.model);

     

       168
       168
       +
           ] in

     

       169
       169
       +
           let msg_fields = match t.error with

     

       170
       170
       +
             | Some err -> ("error", `String (error_to_string err)) :: msg_fields

     

       171
       171
       +
             | None -> msg_fields

     

       172
       172
       +
           in

     

       138
       173
        
           `O [

     

       139
       174
        
             ("type", `String "assistant");

     

       140
       140
       -
             ("message", `O [

     

       141
       141
       -
               ("content", `A (List.map Content_block.to_json t.content));

     

       142
       142
       -
               ("model", `String t.model);

     

       143
       143
       -
             ]);

     

       175
       175
       +
             ("message", `O msg_fields);

     

       144
       176
        
           ]

     

       145
       177
        
         

     

       146
       178
        
         let of_json = function

     

       147
       179
        
           | `O fields ->

     

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

     

       149
       149
       -
               let content, model = match message with

     

       181
       181
       +
               let content, model, error = match message with

     

       150
       182
        
                 | `O msg_fields ->

     

       151
       151
       -
                     let content = 

     

       183
       183
       +
                     let content =

     

       152
       184
        
                       match List.assoc "content" msg_fields with

     

       153
       185
        
                       | `A blocks -> List.map Content_block.of_json blocks

     

       154
       186
        
                       | _ -> raise (Invalid_argument "Assistant.of_json: invalid content")

     

       155
       187
        
                     in

     

       156
       188
        
                     let model = JU.assoc_string "model" msg_fields in

     

       157
       157
       -
                     content, model

     

       189
       189
       +
                     let error =

     

       190
       190
       +
                       match JU.assoc_string_opt "error" msg_fields with

     

       191
       191
       +
                       | Some err_str -> Some (error_of_string err_str)

     

       192
       192
       +
                       | None -> None

     

       193
       193
       +
                     in

     

       194
       194
       +
                     content, model, error

     

       158
       195
        
                 | _ -> raise (Invalid_argument "Assistant.of_json: invalid message")

     

       159
       196
        
               in

     

       160
       160
       -
               { content; model }

     

       197
       197
       +
               { content; model; error }

     

       161
       198
        
           | _ -> raise (Invalid_argument "Assistant.of_json: expected object")

     

       162
       199
        
         

     

       163
       200
        
         let pp fmt t =

     
···

       341
       378
        
           total_cost_usd : float option;

     

       342
       379
        
           usage : Usage.t option;

     

       343
       380
        
           result : string option;

     

       381
       381
       +
           structured_output : value option;

     

       344
       382
        
         }

     

       345
       383
        
         

     

       346
       346
       -
         let create ~subtype ~duration_ms ~duration_api_ms ~is_error ~num_turns 

     

       347
       347
       -
             ~session_id ?total_cost_usd ?usage ?result () =

     

       384
       384
       +
         let create ~subtype ~duration_ms ~duration_api_ms ~is_error ~num_turns

     

       385
       385
       +
             ~session_id ?total_cost_usd ?usage ?result ?structured_output () =

     

       348
       386
        
           { subtype; duration_ms; duration_api_ms; is_error; num_turns;

     

       349
       349
       -
             session_id; total_cost_usd; usage; result }

     

       387
       387
       +
             session_id; total_cost_usd; usage; result; structured_output }

     

       350
       388
        
         

     

       351
       389
        
         let subtype t = t.subtype

     

       352
       390
        
         let duration_ms t = t.duration_ms

     
···

       357
       395
        
         let total_cost_usd t = t.total_cost_usd

     

       358
       396
        
         let usage t = t.usage

     

       359
       397
        
         let result t = t.result

     

       398
       398
       +
         let structured_output t = t.structured_output

     

       360
       399
        
         

     

       361
       400
        
         let to_json t =

     

       362
       401
        
           let fields = [

     
···

       380
       419
        
             | Some result -> ("result", `String result) :: fields

     

       381
       420
        
             | None -> fields

     

       382
       421
        
           in

     

       422
       422
       +
           let fields = match t.structured_output with

     

       423
       423
       +
             | Some output -> ("structured_output", output) :: fields

     

       424
       424
       +
             | None -> fields

     

       425
       425
       +
           in

     

       383
       426
        
           `O fields

     

       384
       427
        
         

     

       385
       428
        
         let of_json = function

     
···

       393
       436
        
               let total_cost_usd = JU.assoc_float_opt "total_cost_usd" fields in

     

       394
       437
        
               let usage = Option.map Usage.of_json (List.assoc_opt "usage" fields) in

     

       395
       438
        
               let result = JU.assoc_string_opt "result" fields in

     

       439
       439
       +
               let structured_output = List.assoc_opt "structured_output" fields in

     

       396
       440
        
               { subtype; duration_ms; duration_api_ms; is_error; num_turns;

     

       397
       397
       -
                 session_id; total_cost_usd; usage; result }

     

       441
       441
       +
                 session_id; total_cost_usd; usage; result; structured_output }

     

       398
       442
        
           | _ -> raise (Invalid_argument "Result.of_json: expected object")

     

       399
       443
        
         

     

       400
       444
        
         let pp fmt t =

     
···

       434
       478
        
       let user_with_tool_result ~tool_use_id ~content ?is_error () =

     

       435
       479
        
         User (User.create_with_tool_result ~tool_use_id ~content ?is_error ())

     

       436
       480
        
       

     

       437
       437
       -
       let assistant ~content ~model = Assistant (Assistant.create ~content ~model)

     

       438
       438
       -
       let assistant_text ~text ~model = 

     

       439
       439
       -
         Assistant (Assistant.create ~content:[Content_block.text text] ~model)

     

       481
       481
       +
       let assistant ~content ~model ?error () = Assistant (Assistant.create ~content ~model ?error ())

     

       482
       482
       +
       let assistant_text ~text ~model ?error () =

     

       483
       483
       +
         Assistant (Assistant.create ~content:[Content_block.text text] ~model ?error ())

     

       440
       484
        
       

     

       441
       485
        
       let system ~subtype ~data = System (System.create ~subtype ~data)

     

       442
       486
        
       let system_init ~session_id =

     
···

       446
       490
        
         let data = System.Data.of_assoc [("error", `String error)] in

     

       447
       491
        
         System (System.create ~subtype:"error" ~data)

     

       448
       492
        
       

     

       449
       449
       -
       let result ~subtype ~duration_ms ~duration_api_ms ~is_error ~num_turns 

     

       450
       450
       -
           ~session_id ?total_cost_usd ?usage ?result () =

     

       451
       451
       -
         Result (Result.create ~subtype ~duration_ms ~duration_api_ms ~is_error 

     

       452
       452
       -
           ~num_turns ~session_id ?total_cost_usd ?usage ?result ())

     

       493
       493
       +
       let result ~subtype ~duration_ms ~duration_api_ms ~is_error ~num_turns

     

       494
       494
       +
           ~session_id ?total_cost_usd ?usage ?result ?structured_output () =

     

       495
       495
       +
         Result (Result.create ~subtype ~duration_ms ~duration_api_ms ~is_error

     

       496
       496
       +
           ~num_turns ~session_id ?total_cost_usd ?usage ?result ?structured_output ())

     

       453
       497
        
       

     

       454
       498
        
       let to_json = function

     

       455
       499
        
         | User t -> User.to_json t

+59 -33

claudeio/lib/message.mli

···

       62
       62
        
       

     

       63
       63
        
       module Assistant : sig

     

       64
       64
        
         (** Messages from Claude assistant. *)

     

       65
       65
       -
         

     

       65
       65
       +
       

     

       66
       66
       +
         type error = [

     

       67
       67
       +
           | `Authentication_failed  (** Authentication with Claude API failed *)

     

       68
       68
       +
           | `Billing_error         (** Billing or account issue *)

     

       69
       69
       +
           | `Rate_limit            (** Rate limit exceeded *)

     

       70
       70
       +
           | `Invalid_request       (** Request was invalid *)

     

       71
       71
       +
           | `Server_error          (** Internal server error *)

     

       72
       72
       +
           | `Unknown               (** Unknown error type *)

     

       73
       73
       +
         ]

     

       74
       74
       +
         (** The type of assistant message errors based on Python SDK error types. *)

     

       75
       75
       +
       

     

       76
       76
       +
         val error_to_string : error -> string

     

       77
       77
       +
         (** [error_to_string err] converts an error to its string representation. *)

     

       78
       78
       +
       

     

       79
       79
       +
         val error_of_string : string -> error

     

       80
       80
       +
         (** [error_of_string s] parses an error string. Unknown strings become [`Unknown]. *)

     

       81
       81
       +
       

     

       66
       82
        
         type t

     

       67
       83
        
         (** The type of assistant messages. *)

     

       68
       68
       -
         

     

       69
       69
       -
         val create : content:Content_block.t list -> model:string -> t

     

       70
       70
       -
         (** [create ~content ~model] creates an assistant message.

     

       84
       84
       +
       

     

       85
       85
       +
         val create : content:Content_block.t list -> model:string -> ?error:error -> unit -> t

     

       86
       86
       +
         (** [create ~content ~model ?error ()] creates an assistant message.

     

       71
       87
        
             @param content List of content blocks in the response

     

       72
       72
       -
             @param model The model identifier used for the response *)

     

       73
       73
       -
         

     

       88
       88
       +
             @param model The model identifier used for the response

     

       89
       89
       +
             @param error Optional error that occurred during message generation *)

     

       90
       90
       +
       

     

       74
       91
        
         val content : t -> Content_block.t list

     

       75
       92
        
         (** [content t] returns the content blocks of the assistant message. *)

     

       76
       76
       -
         

     

       93
       93
       +
       

     

       77
       94
        
         val model : t -> string

     

       78
       95
        
         (** [model t] returns the model identifier. *)

     

       96
       96
       +
       

     

       97
       97
       +
         val error : t -> error option

     

       98
       98
       +
         (** [error t] returns the optional error that occurred during message generation. *)

     

       79
       99
        
         

     

       80
       100
        
         val get_text_blocks : t -> string list

     

       81
       101
        
         (** [get_text_blocks t] extracts all text content from the message. *)

     
···

       230
       250
        
         type t

     

       231
       251
        
         (** The type of result messages. *)

     

       232
       252
        
         

     

       233
       233
       -
         val create : 

     

       234
       234
       -
           subtype:string -> 

     

       235
       235
       -
           duration_ms:int -> 

     

       236
       236
       -
           duration_api_ms:int -> 

     

       237
       237
       -
           is_error:bool -> 

     

       238
       238
       -
           num_turns:int -> 

     

       239
       239
       -
           session_id:string -> 

     

       240
       240
       -
           ?total_cost_usd:float -> 

     

       241
       241
       -
           ?usage:Usage.t -> 

     

       242
       242
       -
           ?result:string -> 

     

       253
       253
       +
         val create :

     

       254
       254
       +
           subtype:string ->

     

       255
       255
       +
           duration_ms:int ->

     

       256
       256
       +
           duration_api_ms:int ->

     

       257
       257
       +
           is_error:bool ->

     

       258
       258
       +
           num_turns:int ->

     

       259
       259
       +
           session_id:string ->

     

       260
       260
       +
           ?total_cost_usd:float ->

     

       261
       261
       +
           ?usage:Usage.t ->

     

       262
       262
       +
           ?result:string ->

     

       263
       263
       +
           ?structured_output:Ezjsonm.value ->

     

       243
       264
        
           unit -> t

     

       244
       265
        
         (** [create ~subtype ~duration_ms ~duration_api_ms ~is_error ~num_turns 

     

       245
       266
        
             ~session_id ?total_cost_usd ?usage ?result ()] creates a result message.

     
···

       251
       272
        
             @param session_id Unique session identifier

     

       252
       273
        
             @param total_cost_usd Optional total cost in USD

     

       253
       274
        
             @param usage Optional usage statistics as JSON

     

       254
       254
       -
             @param result Optional result string *)

     

       275
       275
       +
             @param result Optional result string

     

       276
       276
       +
             @param structured_output Optional structured JSON output from Claude *)

     

       255
       277
        
         

     

       256
       278
        
         val subtype : t -> string

     

       257
       279
        
         (** [subtype t] returns the subtype of the result. *)

     
···

       279
       301
        
         

     

       280
       302
        
         val result : t -> string option

     

       281
       303
        
         (** [result t] returns the optional result string. *)

     

       282
       282
       -
         

     

       304
       304
       +
       

     

       305
       305
       +
         val structured_output : t -> Ezjsonm.value option

     

       306
       306
       +
         (** [structured_output t] returns the optional structured JSON output. *)

     

       307
       307
       +
       

     

       283
       308
        
         val to_json : t -> Ezjsonm.value

     

       284
       309
        
         (** [to_json t] converts the result message to its JSON representation. *)

     

       285
       310
        
         

     
···

       310
       335
        
       (** [user_with_tool_result ~tool_use_id ~content ?is_error ()] creates a user message 

     

       311
       336
        
           containing a tool result. *)

     

       312
       337
        
       

     

       313
       313
       -
       val assistant : content:Content_block.t list -> model:string -> t

     

       314
       314
       -
       (** [assistant ~content ~model] creates an assistant message. *)

     

       338
       338
       +
       val assistant : content:Content_block.t list -> model:string -> ?error:Assistant.error -> unit -> t

     

       339
       339
       +
       (** [assistant ~content ~model ?error ()] creates an assistant message. *)

     

       315
       340
        
       

     

       316
       316
       -
       val assistant_text : text:string -> model:string -> t

     

       317
       317
       -
       (** [assistant_text ~text ~model] creates an assistant message with only text content. *)

     

       341
       341
       +
       val assistant_text : text:string -> model:string -> ?error:Assistant.error -> unit -> t

     

       342
       342
       +
       (** [assistant_text ~text ~model ?error ()] creates an assistant message with only text content. *)

     

       318
       343
        
       

     

       319
       344
        
       val system : subtype:string -> data:System.Data.t -> t

     

       320
       345
        
       (** [system ~subtype ~data] creates a system message. *)

     
···

       325
       350
        
       val system_error : error:string -> t

     

       326
       351
        
       (** [system_error ~error] creates a system error message. *)

     

       327
       352
        
       

     

       328
       328
       -
       val result : 

     

       329
       329
       -
         subtype:string -> 

     

       330
       330
       -
         duration_ms:int -> 

     

       331
       331
       -
         duration_api_ms:int -> 

     

       332
       332
       -
         is_error:bool -> 

     

       333
       333
       -
         num_turns:int -> 

     

       334
       334
       -
         session_id:string -> 

     

       335
       335
       -
         ?total_cost_usd:float -> 

     

       336
       336
       -
         ?usage:Result.Usage.t -> 

     

       337
       337
       -
         ?result:string -> 

     

       353
       353
       +
       val result :

     

       354
       354
       +
         subtype:string ->

     

       355
       355
       +
         duration_ms:int ->

     

       356
       356
       +
         duration_api_ms:int ->

     

       357
       357
       +
         is_error:bool ->

     

       358
       358
       +
         num_turns:int ->

     

       359
       359
       +
         session_id:string ->

     

       360
       360
       +
         ?total_cost_usd:float ->

     

       361
       361
       +
         ?usage:Result.Usage.t ->

     

       362
       362
       +
         ?result:string ->

     

       363
       363
       +
         ?structured_output:Ezjsonm.value ->

     

       338
       364
        
         unit -> t

     

       339
       365
        
       (** [result ~subtype ~duration_ms ~duration_api_ms ~is_error ~num_turns 

     

       340
       366
        
           ~session_id ?total_cost_usd ?usage ?result ()] creates a result message. *)

+50 -7

claudeio/lib/options.ml

···

       3
       3
        
       let src = Logs.Src.create "claude.options" ~doc:"Claude configuration options"

     

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

     

       5
       5
        
       

     

       6
       6
       +
       type setting_source = User | Project | Local

     

       7
       7
       +
       

     

       6
       8
        
       type t = {

     

       7
       9
        
         allowed_tools : string list;

     

       8
       10
        
         disallowed_tools : string list;

     
···

       11
       13
        
         append_system_prompt : string option;

     

       12
       14
        
         permission_mode : Permissions.Mode.t option;

     

       13
       15
        
         permission_callback : Permissions.callback option;

     

       14
       14
       -
         model : string option;

     

       16
       16
       +
         model : Model.t option;

     

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

     

       16
       18
        
         env : (string * string) list;

     

       17
       19
        
         continue_conversation : bool;

     
···

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

     

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

     

       25
       27
        
         hooks : Hooks.config option;

     

       28
       28
       +
         max_budget_usd : float option;

     

       29
       29
       +
         fallback_model : Model.t option;

     

       30
       30
       +
         setting_sources : setting_source list option;

     

       31
       31
       +
         max_buffer_size : int option;

     

       32
       32
       +
         user : string option;

     

       33
       33
       +
         output_format : Structured_output.t option;

     

       26
       34
        
       }

     

       27
       35
        
       

     

       28
       36
        
       let default = {

     
···

       45
       53
        
         extra_args = [];

     

       46
       54
        
         debug_stderr = None;

     

       47
       55
        
         hooks = None;

     

       56
       56
       +
         max_budget_usd = None;

     

       57
       57
       +
         fallback_model = None;

     

       58
       58
       +
         setting_sources = None;

     

       59
       59
       +
         max_buffer_size = None;

     

       60
       60
       +
         user = None;

     

       61
       61
       +
         output_format = None;

     

       48
       62
        
       }

     

       49
       63
        
       

     

       50
       64
        
       let create

     
···

       67
       81
        
           ?(extra_args = [])

     

       68
       82
        
           ?debug_stderr

     

       69
       83
        
           ?hooks

     

       84
       84
       +
           ?max_budget_usd

     

       85
       85
       +
           ?fallback_model

     

       86
       86
       +
           ?setting_sources

     

       87
       87
       +
           ?max_buffer_size

     

       88
       88
       +
           ?user

     

       89
       89
       +
           ?output_format

     

       70
       90
        
           () =

     

       71
       91
        
         { allowed_tools; disallowed_tools; max_thinking_tokens;

     

       72
       92
        
           system_prompt; append_system_prompt; permission_mode;

     

       73
       93
        
           permission_callback; model; cwd; env;

     

       74
       94
        
           continue_conversation; resume; max_turns;

     

       75
       95
        
           permission_prompt_tool_name; settings; add_dirs;

     

       76
       76
       -
           extra_args; debug_stderr; hooks }

     

       96
       96
       +
           extra_args; debug_stderr; hooks;

     

       97
       97
       +
           max_budget_usd; fallback_model; setting_sources;

     

       98
       98
       +
           max_buffer_size; user; output_format }

     

       77
       99
        
       

     

       78
       100
        
       let allowed_tools t = t.allowed_tools

     

       79
       101
        
       let disallowed_tools t = t.disallowed_tools

     
···

       94
       116
        
       let extra_args t = t.extra_args

     

       95
       117
        
       let debug_stderr t = t.debug_stderr

     

       96
       118
        
       let hooks t = t.hooks

     

       119
       119
       +
       let max_budget_usd t = t.max_budget_usd

     

       120
       120
       +
       let fallback_model t = t.fallback_model

     

       121
       121
       +
       let setting_sources t = t.setting_sources

     

       122
       122
       +
       let max_buffer_size t = t.max_buffer_size

     

       123
       123
       +
       let user t = t.user

     

       124
       124
       +
       let output_format t = t.output_format

     

       97
       125
        
       

     

       98
       126
        
       let with_allowed_tools tools t = { t with allowed_tools = tools }

     

       99
       127
        
       let with_disallowed_tools tools t = { t with disallowed_tools = tools }

     
···

       103
       131
        
       let with_permission_mode mode t = { t with permission_mode = Some mode }

     

       104
       132
        
       let with_permission_callback callback t = { t with permission_callback = Some callback }

     

       105
       133
        
       let with_model model t = { t with model = Some model }

     

       134
       134
       +
       let with_model_string model t = { t with model = Some (Model.of_string model) }

     

       106
       135
        
       let with_cwd cwd t = { t with cwd = Some cwd }

     

       107
       136
        
       let with_env env t = { t with env }

     

       108
       137
        
       let with_continue_conversation continue t = { t with continue_conversation = continue }

     
···

       114
       143
        
       let with_extra_args args t = { t with extra_args = args }

     

       115
       144
        
       let with_debug_stderr sink t = { t with debug_stderr = Some sink }

     

       116
       145
        
       let with_hooks hooks t = { t with hooks = Some hooks }

     

       146
       146
       +
       let with_max_budget_usd budget t = { t with max_budget_usd = Some budget }

     

       147
       147
       +
       let with_fallback_model model t = { t with fallback_model = Some model }

     

       148
       148
       +
       let with_fallback_model_string model t = { t with fallback_model = Some (Model.of_string model) }

     

       149
       149
       +
       let with_setting_sources sources t = { t with setting_sources = Some sources }

     

       150
       150
       +
       let with_no_settings t = { t with setting_sources = Some [] }

     

       151
       151
       +
       let with_max_buffer_size size t = { t with max_buffer_size = Some size }

     

       152
       152
       +
       let with_user user t = { t with user = Some user }

     

       153
       153
       +
       let with_output_format format t = { t with output_format = Some format }

     

       117
       154
        
       

     

       118
       155
        
       let to_json t =

     

       119
       156
        
         let fields = [] in

     
···

       145
       182
        
           | None -> fields

     

       146
       183
        
         in

     

       147
       184
        
         let fields = match t.model with

     

       148
       148
       -
           | Some m -> ("model", `String m) :: fields

     

       185
       185
       +
           | Some m -> ("model", `String (Model.to_string m)) :: fields

     

       149
       186
        
           | None -> fields

     

       150
       187
        
         in

     

       151
       188
        
         let fields = 

     
···

       182
       219
        
               try Some (Permissions.Mode.of_json (List.assoc "permission_mode" fields))

     

       183
       220
        
               with Not_found -> None

     

       184
       221
        
             in

     

       185
       185
       -
             let model = 

     

       186
       186
       -
               try Some (get_string (List.assoc "model" fields))

     

       222
       222
       +
             let model =

     

       223
       223
       +
               try Some (Model.of_string (get_string (List.assoc "model" fields)))

     

       187
       224
        
               with Not_found -> None

     

       188
       225
        
             in

     

       189
       226
        
             let env = 

     
···

       205
       242
        
               add_dirs = [];

     

       206
       243
        
               extra_args = [];

     

       207
       244
        
               debug_stderr = None;

     

       208
       208
       -
               hooks = None; }

     

       245
       245
       +
               hooks = None;

     

       246
       246
       +
               max_budget_usd = None;

     

       247
       247
       +
               fallback_model = None;

     

       248
       248
       +
               setting_sources = None;

     

       249
       249
       +
               max_buffer_size = None;

     

       250
       250
       +
               user = None;

     

       251
       251
       +
               output_format = None; }

     

       209
       252
        
         | _ -> raise (Invalid_argument "Options.of_json: expected object")

     

       210
       253
        
       

     

       211
       254
        
       let pp fmt t =

     
···

       225
       268
        
           Fmt.(option string) t.system_prompt

     

       226
       269
        
           Fmt.(option string) t.append_system_prompt

     

       227
       270
        
           Fmt.(option Permissions.Mode.pp) t.permission_mode

     

       228
       228
       -
           Fmt.(option string) t.model

     

       271
       271
       +
           Fmt.(option Model.pp) t.model

     

       229
       272
        
           Fmt.(list (pair string string)) t.env

     

       230
       273
        
       

     

       231
       274
        
       let log_options t =

+177 -10

claudeio/lib/options.mli

···

       1
       1
        
       (** Configuration options for Claude sessions.

     

       2
       2
       -
           

     

       3
       3
       -
           This module provides configuration options for controlling Claude's

     

       4
       4
       -
           behavior, including tool permissions, system prompts, models, and

     

       5
       5
       -
           execution environment. *)

     

       2
       2
       +
       

     

       3
       3
       +
           This module provides comprehensive configuration options for controlling

     

       4
       4
       +
           Claude's behavior, including tool permissions, system prompts, models,

     

       5
       5
       +
           execution environment, cost controls, and structured outputs.

     

       6
       6
       +
       

     

       7
       7
       +
           {2 Overview}

     

       8
       8
       +
       

     

       9
       9
       +
           Options control all aspects of Claude's behavior:

     

       10
       10
       +
           - {b Permissions}: Which tools Claude can use and how permission is granted

     

       11
       11
       +
           - {b Models}: Which AI model to use and fallback options

     

       12
       12
       +
           - {b Environment}: Working directory, environment variables, settings

     

       13
       13
       +
           - {b Cost Control}: Budget limits to prevent runaway spending

     

       14
       14
       +
           - {b Hooks}: Intercept and modify tool execution

     

       15
       15
       +
           - {b Structured Output}: JSON schema validation for responses

     

       16
       16
       +
           - {b Session Management}: Continue or resume conversations

     

       17
       17
       +
       

     

       18
       18
       +
           {2 Builder Pattern}

     

       19
       19
       +
       

     

       20
       20
       +
           Options use a functional builder pattern - each [with_*] function returns

     

       21
       21
       +
           a new options value with the specified field updated:

     

       22
       22
       +
       

     

       23
       23
       +
           {[

     

       24
       24
       +
             let options = Options.default

     

       25
       25
       +
               |> Options.with_model "claude-sonnet-4-5"

     

       26
       26
       +
               |> Options.with_max_budget_usd 1.0

     

       27
       27
       +
               |> Options.with_permission_mode Permissions.Mode.Accept_edits

     

       28
       28
       +
           ]}

     

       29
       29
       +
       

     

       30
       30
       +
           {2 Common Configuration Scenarios}

     

       31
       31
       +
       

     

       32
       32
       +
           {3 CI/CD: Isolated, Reproducible Builds}

     

       33
       33
       +
       

     

       34
       34
       +
           {[

     

       35
       35
       +
             let ci_config = Options.default

     

       36
       36
       +
               |> Options.with_no_settings           (* Ignore user config *)

     

       37
       37
       +
               |> Options.with_max_budget_usd 0.50   (* 50 cent limit *)

     

       38
       38
       +
               |> Options.with_permission_mode

     

       39
       39
       +
                    Permissions.Mode.Bypass_permissions

     

       40
       40
       +
               |> Options.with_model "claude-haiku-4"

     

       41
       41
       +
           ]}

     

       42
       42
       +
       

     

       43
       43
       +
           {3 Production: Cost Control with Fallback}

     

       44
       44
       +
       

     

       45
       45
       +
           {[

     

       46
       46
       +
             let prod_config = Options.default

     

       47
       47
       +
               |> Options.with_model "claude-sonnet-4-5"

     

       48
       48
       +
               |> Options.with_fallback_model "claude-haiku-4"

     

       49
       49
       +
               |> Options.with_max_budget_usd 10.0   (* $10 daily limit *)

     

       50
       50
       +
               |> Options.with_max_buffer_size 5_000_000

     

       51
       51
       +
           ]}

     

       52
       52
       +
       

     

       53
       53
       +
           {3 Development: User Settings with Overrides}

     

       54
       54
       +
       

     

       55
       55
       +
           {[

     

       56
       56
       +
             let dev_config = Options.default

     

       57
       57
       +
               |> Options.with_setting_sources [User; Project]

     

       58
       58
       +
               |> Options.with_max_budget_usd 1.0

     

       59
       59
       +
               |> Options.with_permission_mode Permissions.Mode.Default

     

       60
       60
       +
           ]}

     

       61
       61
       +
       

     

       62
       62
       +
           {3 Structured Output: Type-Safe Responses}

     

       63
       63
       +
       

     

       64
       64
       +
           {[

     

       65
       65
       +
             let schema = Ezjsonm.(`O [

     

       66
       66
       +
               ("type", `String "object");

     

       67
       67
       +
               ("properties", `O [

     

       68
       68
       +
                 ("count", `O [("type", `String "integer")]);

     

       69
       69
       +
                 ("has_tests", `O [("type", `String "boolean")]);

     

       70
       70
       +
               ]);

     

       71
       71
       +
             ])

     

       72
       72
       +
             let format = Structured_output.of_json_schema schema

     

       73
       73
       +
       

     

       74
       74
       +
             let analysis_config = Options.default

     

       75
       75
       +
               |> Options.with_output_format format

     

       76
       76
       +
               |> Options.with_allowed_tools ["Read"; "Glob"; "Grep"]

     

       77
       77
       +
           ]}

     

       78
       78
       +
       

     

       79
       79
       +
           {2 Advanced Options}

     

       80
       80
       +
       

     

       81
       81
       +
           {3 Budget Control}

     

       82
       82
       +
       

     

       83
       83
       +
           Use {!with_max_budget_usd} to set hard spending limits. Claude will

     

       84
       84
       +
           terminate the session if the budget is exceeded, preventing runaway costs.

     

       85
       85
       +
       

     

       86
       86
       +
           {3 Settings Isolation}

     

       87
       87
       +
       

     

       88
       88
       +
           Use {!with_setting_sources} or {!with_no_settings} to control which

     

       89
       89
       +
           configuration files are loaded:

     

       90
       90
       +
           - [User] - ~/.claude/config

     

       91
       91
       +
           - [Project] - .claude/ in project root

     

       92
       92
       +
           - [Local] - Current directory settings

     

       93
       93
       +
           - [Some \[\]] (via {!with_no_settings}) - No settings, fully isolated

     

       94
       94
       +
       

     

       95
       95
       +
           This is critical for reproducible builds in CI/CD environments.

     

       96
       96
       +
       

     

       97
       97
       +
           {3 Model Fallback}

     

       98
       98
       +
       

     

       99
       99
       +
           Use {!with_fallback_model} to specify an alternative model when the

     

       100
       100
       +
           primary model is unavailable or overloaded. This improves reliability. *)

     

       6
       101
        
       

     

       7
       102
        
       open Ezjsonm

     

       8
       103
        
       

     

       9
       104
        
       (** The log source for options operations *)

     

       10
       105
        
       val src : Logs.Src.t

     

       11
       106
        
       

     

       107
       107
       +
       (** {1 Types} *)

     

       108
       108
       +
       

     

       109
       109
       +
       type setting_source = User | Project | Local

     

       110
       110
       +
       (** Setting source determines which configuration files to load.

     

       111
       111
       +
           - [User]: Load user-level settings from ~/.claude/config

     

       112
       112
       +
           - [Project]: Load project-level settings from .claude/ in project root

     

       113
       113
       +
           - [Local]: Load local settings from current directory *)

     

       114
       114
       +
       

     

       12
       115
        
       type t

     

       13
       116
        
       (** The type of configuration options. *)

     

       14
       117
        
       

     
···

       27
       130
        
         ?append_system_prompt:string ->

     

       28
       131
        
         ?permission_mode:Permissions.Mode.t ->

     

       29
       132
        
         ?permission_callback:Permissions.callback ->

     

       30
       30
       -
         ?model:string ->

     

       133
       133
       +
         ?model:Model.t ->

     

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

     

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

     

       33
       136
        
         ?continue_conversation:bool ->

     
···

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

     

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

     

       41
       144
        
         ?hooks:Hooks.config ->

     

       145
       145
       +
         ?max_budget_usd:float ->

     

       146
       146
       +
         ?fallback_model:Model.t ->

     

       147
       147
       +
         ?setting_sources:setting_source list ->

     

       148
       148
       +
         ?max_buffer_size:int ->

     

       149
       149
       +
         ?user:string ->

     

       150
       150
       +
         ?output_format:Structured_output.t ->

     

       42
       151
        
         unit -> t

     

       43
       152
        
       (** [create ?allowed_tools ?disallowed_tools ?max_thinking_tokens ?system_prompt

     

       44
       153
        
           ?append_system_prompt ?permission_mode ?permission_callback ?model ?cwd ?env

     

       45
       154
        
           ?continue_conversation ?resume ?max_turns ?permission_prompt_tool_name ?settings

     

       46
       46
       -
           ?add_dirs ?extra_args ?debug_stderr ()]

     

       155
       155
       +
           ?add_dirs ?extra_args ?debug_stderr ?hooks ?max_budget_usd ?fallback_model

     

       156
       156
       +
           ?setting_sources ?max_buffer_size ?user ()]

     

       47
       157
        
           creates a new configuration.

     

       48
       158
        
           @param allowed_tools List of explicitly allowed tool names

     

       49
       159
        
           @param disallowed_tools List of explicitly disallowed tool names

     
···

       62
       172
        
           @param settings Path to settings file

     

       63
       173
        
           @param add_dirs Additional directories to allow access to

     

       64
       174
        
           @param extra_args Additional CLI flags to pass through

     

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

     

       175
       175
       +
           @param debug_stderr Sink for debug output when debug-to-stderr is set

     

       176
       176
       +
           @param hooks Hooks configuration for event interception

     

       177
       177
       +
           @param max_budget_usd Hard spending limit in USD (terminates on exceed)

     

       178
       178
       +
           @param fallback_model Automatic fallback on primary model unavailability

     

       179
       179
       +
           @param setting_sources Control which settings load (user/project/local)

     

       180
       180
       +
           @param max_buffer_size Control for stdout buffer size in bytes

     

       181
       181
       +
           @param user Unix user for subprocess execution

     

       182
       182
       +
           @param output_format Optional structured output format specification *)

     

       66
       183
        
       

     

       67
       184
        
       (** {1 Accessors} *)

     

       68
       185
        
       

     
···

       87
       204
        
       val permission_callback : t -> Permissions.callback option

     

       88
       205
        
       (** [permission_callback t] returns the optional permission callback. *)

     

       89
       206
        
       

     

       90
       90
       -
       val model : t -> string option

     

       207
       207
       +
       val model : t -> Model.t option

     

       91
       208
        
       (** [model t] returns the optional model override. *)

     

       92
       209
        
       

     

       93
       210
        
       val cwd : t -> Eio.Fs.dir_ty Eio.Path.t option

     
···

       123
       240
        
       val hooks : t -> Hooks.config option

     

       124
       241
        
       (** [hooks t] returns the optional hooks configuration. *)

     

       125
       242
        
       

     

       243
       243
       +
       val max_budget_usd : t -> float option

     

       244
       244
       +
       (** [max_budget_usd t] returns the optional spending limit in USD. *)

     

       245
       245
       +
       

     

       246
       246
       +
       val fallback_model : t -> Model.t option

     

       247
       247
       +
       (** [fallback_model t] returns the optional fallback model. *)

     

       248
       248
       +
       

     

       249
       249
       +
       val setting_sources : t -> setting_source list option

     

       250
       250
       +
       (** [setting_sources t] returns the optional list of setting sources to load. *)

     

       251
       251
       +
       

     

       252
       252
       +
       val max_buffer_size : t -> int option

     

       253
       253
       +
       (** [max_buffer_size t] returns the optional stdout buffer size in bytes. *)

     

       254
       254
       +
       

     

       255
       255
       +
       val user : t -> string option

     

       256
       256
       +
       (** [user t] returns the optional Unix user for subprocess execution. *)

     

       257
       257
       +
       

     

       258
       258
       +
       val output_format : t -> Structured_output.t option

     

       259
       259
       +
       (** [output_format t] returns the optional structured output format. *)

     

       260
       260
       +
       

     

       126
       261
        
       (** {1 Builders} *)

     

       127
       262
        
       

     

       128
       263
        
       val with_allowed_tools : string list -> t -> t

     
···

       146
       281
        
       val with_permission_callback : Permissions.callback -> t -> t

     

       147
       282
        
       (** [with_permission_callback callback t] sets the permission callback. *)

     

       148
       283
        
       

     

       149
       149
       -
       val with_model : string -> t -> t

     

       150
       150
       -
       (** [with_model model t] sets the model override. *)

     

       284
       284
       +
       val with_model : Model.t -> t -> t

     

       285
       285
       +
       (** [with_model model t] sets the model override using a typed Model.t. *)

     

       286
       286
       +
       

     

       287
       287
       +
       val with_model_string : string -> t -> t

     

       288
       288
       +
       (** [with_model_string model t] sets the model override from a string.

     

       289
       289
       +
           The string is parsed using {!Model.of_string}. *)

     

       151
       290
        
       

     

       152
       291
        
       val with_cwd : Eio.Fs.dir_ty Eio.Path.t -> t -> t

     

       153
       292
        
       (** [with_cwd cwd t] sets the working directory. *)

     
···

       181
       320
        
       

     

       182
       321
        
       val with_hooks : Hooks.config -> t -> t

     

       183
       322
        
       (** [with_hooks hooks t] sets the hooks configuration. *)

     

       323
       323
       +
       

     

       324
       324
       +
       val with_max_budget_usd : float -> t -> t

     

       325
       325
       +
       (** [with_max_budget_usd budget t] sets the maximum spending limit in USD.

     

       326
       326
       +
           The session will terminate if this limit is exceeded. *)

     

       327
       327
       +
       

     

       328
       328
       +
       val with_fallback_model : Model.t -> t -> t

     

       329
       329
       +
       (** [with_fallback_model model t] sets the fallback model using a typed Model.t. *)

     

       330
       330
       +
       

     

       331
       331
       +
       val with_fallback_model_string : string -> t -> t

     

       332
       332
       +
       (** [with_fallback_model_string model t] sets the fallback model from a string.

     

       333
       333
       +
           The string is parsed using {!Model.of_string}. *)

     

       334
       334
       +
       

     

       335
       335
       +
       val with_setting_sources : setting_source list -> t -> t

     

       336
       336
       +
       (** [with_setting_sources sources t] sets which configuration sources to load.

     

       337
       337
       +
           Use empty list for isolated environments (e.g., CI/CD). *)

     

       338
       338
       +
       

     

       339
       339
       +
       val with_no_settings : t -> t

     

       340
       340
       +
       (** [with_no_settings t] disables all settings loading (user, project, local).

     

       341
       341
       +
           Useful for CI/CD environments where you want isolated, reproducible behavior. *)

     

       342
       342
       +
       

     

       343
       343
       +
       val with_max_buffer_size : int -> t -> t

     

       344
       344
       +
       (** [with_max_buffer_size size t] sets the maximum stdout buffer size in bytes. *)

     

       345
       345
       +
       

     

       346
       346
       +
       val with_user : string -> t -> t

     

       347
       347
       +
       (** [with_user user t] sets the Unix user for subprocess execution. *)

     

       348
       348
       +
       

     

       349
       349
       +
       val with_output_format : Structured_output.t -> t -> t

     

       350
       350
       +
       (** [with_output_format format t] sets the structured output format. *)

     

       184
       351
        
       

     

       185
       352
        
       (** {1 Serialization} *)

     

       186
       353

+91 -4

claudeio/lib/sdk_control.ml

···

       40
       40
        
           server_name : string;

     

       41
       41
        
           message : value;

     

       42
       42
        
         }

     

       43
       43
       -
         

     

       43
       43
       +
       

     

       44
       44
       +
         type set_model = {

     

       45
       45
       +
           subtype : [`Set_model];

     

       46
       46
       +
           model : string;

     

       47
       47
       +
         }

     

       48
       48
       +
       

     

       49
       49
       +
         type get_server_info = {

     

       50
       50
       +
           subtype : [`Get_server_info];

     

       51
       51
       +
         }

     

       52
       52
       +
       

     

       44
       53
        
         type t =

     

       45
       54
        
           | Interrupt of interrupt

     

       46
       55
        
           | Permission of permission

     
···

       48
       57
        
           | Set_permission_mode of set_permission_mode

     

       49
       58
        
           | Hook_callback of hook_callback

     

       50
       59
        
           | Mcp_message of mcp_message

     

       60
       60
       +
           | Set_model of set_model

     

       61
       61
       +
           | Get_server_info of get_server_info

     

       51
       62
        
         

     

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

     

       53
       64
        
         

     
···

       80
       91
        
             server_name;

     

       81
       92
        
             message;

     

       82
       93
        
           }

     

       83
       83
       -
         

     

       94
       94
       +
       

     

       95
       95
       +
         let set_model ~model =

     

       96
       96
       +
           Set_model { subtype = `Set_model; model }

     

       97
       97
       +
       

     

       98
       98
       +
         let get_server_info () =

     

       99
       99
       +
           Get_server_info { subtype = `Get_server_info }

     

       100
       100
       +
       

     

       84
       101
        
         let to_json = function

     

       85
       102
        
           | Interrupt _ ->

     

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

     
···

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

     

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

     

       133
       150
        
               ]

     

       134
       134
       -
         

     

       151
       151
       +
           | Set_model s ->

     

       152
       152
       +
               `O [

     

       153
       153
       +
                 ("subtype", `String "set_model");

     

       154
       154
       +
                 ("model", `String s.model);

     

       155
       155
       +
               ]

     

       156
       156
       +
           | Get_server_info _ ->

     

       157
       157
       +
               `O [("subtype", `String "get_server_info")]

     

       158
       158
       +
       

     

       135
       159
        
         let of_json = function

     

       136
       160
        
           | `O fields ->

     

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

     
···

       183
       207
        
                     server_name;

     

       184
       208
        
                     message;

     

       185
       209
        
                   }

     

       210
       210
       +
               | "set_model" ->

     

       211
       211
       +
                   let model = JU.assoc_string "model" fields in

     

       212
       212
       +
                   Set_model { subtype = `Set_model; model }

     

       213
       213
       +
               | "get_server_info" ->

     

       214
       214
       +
                   Get_server_info { subtype = `Get_server_info }

     

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

     

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

     

       188
       217
        
         

     
···

       204
       233
        
           | Mcp_message m ->

     

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

     

       206
       235
        
                 m.server_name

     

       236
       236
       +
           | Set_model s ->

     

       237
       237
       +
               Fmt.pf fmt "@[<2>SetModel@ { model = %S }@]" s.model

     

       238
       238
       +
           | Get_server_info _ ->

     

       239
       239
       +
               Fmt.pf fmt "@[<2>GetServerInfo@]"

     

       207
       240
        
       end

     

       208
       241
        
       

     

       209
       242
        
       module Response = struct

     
···

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

     

       361
       394
        
       

     

       362
       395
        
       let log_response resp =

     

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

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

     

       397
       397
       +
       

     

       398
       398
       +
       (** Server information *)

     

       399
       399
       +
       module Server_info = struct

     

       400
       400
       +
         type t = {

     

       401
       401
       +
           version : string;

     

       402
       402
       +
           capabilities : string list;

     

       403
       403
       +
           commands : string list;

     

       404
       404
       +
           output_styles : string list;

     

       405
       405
       +
         }

     

       406
       406
       +
       

     

       407
       407
       +
         let create ~version ~capabilities ~commands ~output_styles =

     

       408
       408
       +
           { version; capabilities; commands; output_styles }

     

       409
       409
       +
       

     

       410
       410
       +
         let version t = t.version

     

       411
       411
       +
         let capabilities t = t.capabilities

     

       412
       412
       +
         let commands t = t.commands

     

       413
       413
       +
         let output_styles t = t.output_styles

     

       414
       414
       +
       

     

       415
       415
       +
         let of_json = function

     

       416
       416
       +
           | `O fields ->

     

       417
       417
       +
               let version = JU.assoc_string "version" fields in

     

       418
       418
       +
               let capabilities =

     

       419
       419
       +
                 match List.assoc_opt "capabilities" fields with

     

       420
       420
       +
                 | Some (`A lst) -> List.map Ezjsonm.get_string lst

     

       421
       421
       +
                 | _ -> []

     

       422
       422
       +
               in

     

       423
       423
       +
               let commands =

     

       424
       424
       +
                 match List.assoc_opt "commands" fields with

     

       425
       425
       +
                 | Some (`A lst) -> List.map Ezjsonm.get_string lst

     

       426
       426
       +
                 | _ -> []

     

       427
       427
       +
               in

     

       428
       428
       +
               let output_styles =

     

       429
       429
       +
                 match List.assoc_opt "outputStyles" fields with

     

       430
       430
       +
                 | Some (`A lst) -> List.map Ezjsonm.get_string lst

     

       431
       431
       +
                 | _ -> []

     

       432
       432
       +
               in

     

       433
       433
       +
               { version; capabilities; commands; output_styles }

     

       434
       434
       +
           | _ -> raise (Invalid_argument "Server_info.of_json: expected object")

     

       435
       435
       +
       

     

       436
       436
       +
         let to_json t =

     

       437
       437
       +
           `O [

     

       438
       438
       +
             ("version", `String t.version);

     

       439
       439
       +
             ("capabilities", `A (List.map (fun s -> `String s) t.capabilities));

     

       440
       440
       +
             ("commands", `A (List.map (fun s -> `String s) t.commands));

     

       441
       441
       +
             ("outputStyles", `A (List.map (fun s -> `String s) t.output_styles));

     

       442
       442
       +
           ]

     

       443
       443
       +
       

     

       444
       444
       +
         let pp fmt t =

     

       445
       445
       +
           Fmt.pf fmt "@[<2>ServerInfo@ { version = %S;@ capabilities = [%a];@ commands = [%a];@ output_styles = [%a] }@]"

     

       446
       446
       +
             t.version

     

       447
       447
       +
             Fmt.(list ~sep:(any ", ") (quote string)) t.capabilities

     

       448
       448
       +
             Fmt.(list ~sep:(any ", ") (quote string)) t.commands

     

       449
       449
       +
             Fmt.(list ~sep:(any ", ") (quote string)) t.output_styles

     

       450
       450
       +
       end

+149 -6

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. *)

     

       2
       2
       +
       

     

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

     

       4
       4
       +
           communication between the SDK and the Claude CLI. It handles:

     

       5
       5
       +
       

     

       6
       6
       +
           - Permission requests (tool usage authorization)

     

       7
       7
       +
           - Hook callbacks (intercepting and modifying tool execution)

     

       8
       8
       +
           - Dynamic control (changing settings mid-conversation)

     

       9
       9
       +
           - Server introspection (querying capabilities)

     

       10
       10
       +
       

     

       11
       11
       +
           {2 Protocol Overview}

     

       12
       12
       +
       

     

       13
       13
       +
           The SDK control protocol is a JSON-based request/response protocol that

     

       14
       14
       +
           runs alongside the main message stream. It enables:

     

       15
       15
       +
       

     

       16
       16
       +
           1. {b Callbacks}: Claude asks the SDK for permission or hook execution

     

       17
       17
       +
           2. {b Control}: SDK changes Claude's behavior dynamically

     

       18
       18
       +
           3. {b Introspection}: SDK queries server metadata

     

       19
       19
       +
       

     

       20
       20
       +
           {2 Request/Response Flow}

     

       21
       21
       +
       

     

       22
       22
       +
           {v

     

       23
       23
       +
             SDK                          Claude CLI

     

       24
       24
       +
              |                               |

     

       25
       25
       +
              |-- Initialize (with hooks) --> |

     

       26
       26
       +
              |<-- Permission Request --------|  (for tool usage)

     

       27
       27
       +
              |-- Allow/Deny Response ------> |

     

       28
       28
       +
              |                               |

     

       29
       29
       +
              |<-- Hook Callback -------------|  (pre/post tool)

     

       30
       30
       +
              |-- Hook Result -------------> |

     

       31
       31
       +
              |                               |

     

       32
       32
       +
              |-- Set Model ---------------> |  (dynamic control)

     

       33
       33
       +
              |<-- Success Response ----------|

     

       34
       34
       +
              |                               |

     

       35
       35
       +
              |-- Get Server Info ----------> |

     

       36
       36
       +
              |<-- Server Info Response ------|

     

       37
       37
       +
           v}

     

       38
       38
       +
       

     

       39
       39
       +
           {2 Usage}

     

       40
       40
       +
       

     

       41
       41
       +
           Most users won't interact with this module directly. The {!Client} module

     

       42
       42
       +
           handles the protocol automatically. However, this module is exposed for:

     

       43
       43
       +
       

     

       44
       44
       +
           - Understanding the control protocol

     

       45
       45
       +
           - Implementing custom control logic

     

       46
       46
       +
           - Debugging control message flow

     

       47
       47
       +
           - Advanced SDK extensions

     

       48
       48
       +
       

     

       49
       49
       +
           {2 Dynamic Control Examples}

     

       50
       50
       +
       

     

       51
       51
       +
           See {!Client.set_permission_mode}, {!Client.set_model}, and

     

       52
       52
       +
           {!Client.get_server_info} for high-level APIs that use this protocol. *)

     

       5
       53
        
       

     

       6
       54
        
       open Ezjsonm

     

       7
       55
        
       

     
···

       53
       101
        
           message : value;

     

       54
       102
        
         }

     

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

     

       56
       56
       -
         

     

       104
       104
       +
       

     

       105
       105
       +
         type set_model = {

     

       106
       106
       +
           subtype : [`Set_model];

     

       107
       107
       +
           model : string;

     

       108
       108
       +
         }

     

       109
       109
       +
         (** Request to change the AI model. *)

     

       110
       110
       +
       

     

       111
       111
       +
         type get_server_info = {

     

       112
       112
       +
           subtype : [`Get_server_info];

     

       113
       113
       +
         }

     

       114
       114
       +
         (** Request to get server information. *)

     

       115
       115
       +
       

     

       57
       116
        
         type t =

     

       58
       117
        
           | Interrupt of interrupt

     

       59
       118
        
           | Permission of permission

     
···

       61
       120
        
           | Set_permission_mode of set_permission_mode

     

       62
       121
        
           | Hook_callback of hook_callback

     

       63
       122
        
           | Mcp_message of mcp_message

     

       123
       123
       +
           | Set_model of set_model

     

       124
       124
       +
           | Get_server_info of get_server_info

     

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

     

       65
       126
        
         

     

       66
       127
        
         val interrupt : unit -> t

     
···

       90
       151
        
         

     

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

     

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

     

       93
       93
       -
         

     

       154
       154
       +
       

     

       155
       155
       +
         val set_model : model:string -> t

     

       156
       156
       +
         (** [set_model ~model] creates a model change request. *)

     

       157
       157
       +
       

     

       158
       158
       +
         val get_server_info : unit -> t

     

       159
       159
       +
         (** [get_server_info ()] creates a server info request. *)

     

       160
       160
       +
       

     

       94
       161
        
         val to_json : t -> value

     

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

     

       96
       163
        
         

     
···

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

     

       186
       253
        
       

     

       187
       254
        
       val log_response : Response.t -> unit

     

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

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

     

       256
       256
       +
       

     

       257
       257
       +
       (** {1 Server Information}

     

       258
       258
       +
       

     

       259
       259
       +
           Server information provides metadata about the Claude CLI server,

     

       260
       260
       +
           including version, capabilities, available commands, and output styles.

     

       261
       261
       +
       

     

       262
       262
       +
           {2 Use Cases}

     

       263
       263
       +
       

     

       264
       264
       +
           - Feature detection: Check if specific capabilities are available

     

       265
       265
       +
           - Version compatibility: Ensure minimum version requirements

     

       266
       266
       +
           - Debugging: Log server information for troubleshooting

     

       267
       267
       +
           - Dynamic adaptation: Adjust SDK behavior based on capabilities

     

       268
       268
       +
       

     

       269
       269
       +
           {2 Example}

     

       270
       270
       +
       

     

       271
       271
       +
           {[

     

       272
       272
       +
             let info = Client.get_server_info client in

     

       273
       273
       +
             Printf.printf "Claude CLI version: %s\n"

     

       274
       274
       +
               (Server_info.version info);

     

       275
       275
       +
       

     

       276
       276
       +
             if List.mem "structured-output" (Server_info.capabilities info) then

     

       277
       277
       +
               Printf.printf "Structured output is supported\n"

     

       278
       278
       +
             else

     

       279
       279
       +
               Printf.printf "Structured output not available\n";

     

       280
       280
       +
           ]} *)

     

       281
       281
       +
       

     

       282
       282
       +
       module Server_info : sig

     

       283
       283
       +
         (** Server information and capabilities. *)

     

       284
       284
       +
       

     

       285
       285
       +
         type t = {

     

       286
       286
       +
           version : string;

     

       287
       287
       +
           (** Server version string (e.g., "2.0.0") *)

     

       288
       288
       +
       

     

       289
       289
       +
           capabilities : string list;

     

       290
       290
       +
           (** Available server capabilities (e.g., "hooks", "structured-output") *)

     

       291
       291
       +
       

     

       292
       292
       +
           commands : string list;

     

       293
       293
       +
           (** Available CLI commands *)

     

       294
       294
       +
       

     

       295
       295
       +
           output_styles : string list;

     

       296
       296
       +
           (** Supported output formats (e.g., "json", "stream-json") *)

     

       297
       297
       +
         }

     

       298
       298
       +
         (** Server metadata and capabilities.

     

       299
       299
       +
       

     

       300
       300
       +
             This information is useful for feature detection and debugging. *)

     

       301
       301
       +
       

     

       302
       302
       +
         val create :

     

       303
       303
       +
           version:string ->

     

       304
       304
       +
           capabilities:string list ->

     

       305
       305
       +
           commands:string list ->

     

       306
       306
       +
           output_styles:string list ->

     

       307
       307
       +
           t

     

       308
       308
       +
         (** [create ~version ~capabilities ~commands ~output_styles] creates server info. *)

     

       309
       309
       +
       

     

       310
       310
       +
         val version : t -> string

     

       311
       311
       +
         (** [version t] returns the server version. *)

     

       312
       312
       +
       

     

       313
       313
       +
         val capabilities : t -> string list

     

       314
       314
       +
         (** [capabilities t] returns the server capabilities. *)

     

       315
       315
       +
       

     

       316
       316
       +
         val commands : t -> string list

     

       317
       317
       +
         (** [commands t] returns available commands. *)

     

       318
       318
       +
       

     

       319
       319
       +
         val output_styles : t -> string list

     

       320
       320
       +
         (** [output_styles t] returns available output styles. *)

     

       321
       321
       +
       

     

       322
       322
       +
         val of_json : value -> t

     

       323
       323
       +
         (** [of_json json] parses server info from JSON.

     

       324
       324
       +
             @raise Invalid_argument if the JSON is not valid server info. *)

     

       325
       325
       +
       

     

       326
       326
       +
         val to_json : t -> value

     

       327
       327
       +
         (** [to_json t] converts server info to JSON. *)

     

       328
       328
       +
       

     

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

     

       330
       330
       +
         (** [pp fmt t] pretty-prints the server info. *)

     

       331
       331
       +
       end

+45 -9

claudeio/lib/transport.ml

···

       17
       17
        
         sw : Switch.t;

     

       18
       18
        
       }

     

       19
       19
        
       

     

       20
       20
       +
       let setting_source_to_string = function

     

       21
       21
       +
         | Options.User -> "user"

     

       22
       22
       +
         | Options.Project -> "project"

     

       23
       23
       +
         | Options.Local -> "local"

     

       24
       24
       +
       

     

       20
       25
        
       let build_command ~claude_path ~options =

     

       21
       26
        
         let cmd = [claude_path; "--output-format"; "stream-json"; "--verbose"] in

     

       22
       22
       -
         

     

       27
       27
       +
       

     

       23
       28
        
         let cmd = match Options.system_prompt options with

     

       24
       29
        
           | Some prompt -> cmd @ ["--system-prompt"; prompt]

     

       25
       30
        
           | None -> cmd

     

       26
       31
        
         in

     

       27
       27
       -
         

     

       32
       32
       +
       

     

       28
       33
        
         let cmd = match Options.append_system_prompt options with

     

       29
       34
        
           | Some prompt -> cmd @ ["--append-system-prompt"; prompt]

     

       30
       35
        
           | None -> cmd

     

       31
       36
        
         in

     

       32
       32
       -
         

     

       37
       37
       +
       

     

       33
       38
        
         let cmd = match Options.allowed_tools options with

     

       34
       39
        
           | [] -> cmd

     

       35
       40
        
           | tools -> cmd @ ["--allowedTools"; String.concat "," tools]

     

       36
       41
        
         in

     

       37
       37
       -
         

     

       42
       42
       +
       

     

       38
       43
        
         let cmd = match Options.disallowed_tools options with

     

       39
       44
        
           | [] -> cmd

     

       40
       45
        
           | tools -> cmd @ ["--disallowedTools"; String.concat "," tools]

     

       41
       46
        
         in

     

       42
       42
       -
         

     

       47
       47
       +
       

     

       43
       48
        
         let cmd = match Options.model options with

     

       44
       44
       -
           | Some model -> cmd @ ["--model"; model]

     

       49
       49
       +
           | Some model -> cmd @ ["--model"; Model.to_string model]

     

       45
       50
        
           | None -> cmd

     

       46
       51
        
         in

     

       47
       47
       -
         

     

       52
       52
       +
       

     

       48
       53
        
         let cmd = match Options.permission_mode options with

     

       49
       54
        
           | Some mode ->

     

       50
       55
        
               let mode_str = Permissions.Mode.to_string mode in

     
···

       57
       62
        
           | None -> cmd

     

       58
       63
        
         in

     

       59
       64
        
       

     

       65
       65
       +
         (* Advanced configuration options *)

     

       66
       66
       +
         let cmd = match Options.max_budget_usd options with

     

       67
       67
       +
           | Some budget -> cmd @ ["--max-budget-usd"; Float.to_string budget]

     

       68
       68
       +
           | None -> cmd

     

       69
       69
       +
         in

     

       70
       70
       +
       

     

       71
       71
       +
         let cmd = match Options.fallback_model options with

     

       72
       72
       +
           | Some model -> cmd @ ["--fallback-model"; Model.to_string model]

     

       73
       73
       +
           | None -> cmd

     

       74
       74
       +
         in

     

       75
       75
       +
       

     

       76
       76
       +
         let cmd = match Options.setting_sources options with

     

       77
       77
       +
           | Some sources ->

     

       78
       78
       +
               let sources_str = String.concat "," (List.map setting_source_to_string sources) in

     

       79
       79
       +
               cmd @ ["--setting-sources"; sources_str]

     

       80
       80
       +
           | None -> cmd

     

       81
       81
       +
         in

     

       82
       82
       +
       

     

       83
       83
       +
         (* Add JSON Schema if specified *)

     

       84
       84
       +
         let cmd = match Options.output_format options with

     

       85
       85
       +
           | Some format ->

     

       86
       86
       +
               let schema = Structured_output.json_schema format in

     

       87
       87
       +
               let schema_str = Ezjsonm.value_to_string schema in

     

       88
       88
       +
               cmd @ ["--json-schema"; schema_str]

     

       89
       89
       +
           | None -> cmd

     

       90
       90
       +
         in

     

       91
       91
       +
       

     

       60
       92
        
         (* Use streaming input mode *)

     

       61
       93
        
         cmd @ ["--input-format"; "stream-json"]

     

       62
       94
        
       

     
···

       121
       153
        
         

     

       122
       154
        
         let stdin = (stdin_w :> Eio.Flow.sink_ty r) in

     

       123
       155
        
         let stdin_close = (stdin_w :> [`Close | `Flow] r) in

     

       124
       124
       -
         let stdout = Eio.Buf_read.of_flow ~max_size:1_000_000 (stdout_r :> Eio.Flow.source_ty r) in

     

       125
       125
       -
         

     

       156
       156
       +
         let max_size = match Options.max_buffer_size options with

     

       157
       157
       +
           | Some size -> size

     

       158
       158
       +
           | None -> 1_000_000  (* Default 1MB *)

     

       159
       159
       +
         in

     

       160
       160
       +
         let stdout = Eio.Buf_read.of_flow ~max_size (stdout_r :> Eio.Flow.source_ty r) in

     

       161
       161
       +
       

     

       126
       162
        
         { process = P process; stdin; stdin_close; stdout; sw }

     

       127
       163
        
       

     

       128
       164
        
       let send t json =

+1 -1

claudeio/test/camel_jokes.ml

···

       45
       45
        
       

     

       46
       46
        
       let run_claude ~sw ~env name prompt =

     

       47
       47
        
         Log.info (fun m -> m "🐪 Starting %s..." name);

     

       48
       48
       -
         let options = Claude.Options.create ~model:"sonnet" ~allowed_tools:[] () in

     

       48
       48
       +
         let options = Claude.Options.create ~model:(Claude.Model.of_string "sonnet") ~allowed_tools:[] () in

     

       49
       49
        
         

     

       50
       50
        
         let client = Claude.Client.create ~options ~sw 

     

       51
       51
        
           ~process_mgr:env#process_mgr

+1 -1

claudeio/test/discovery_demo.ml

···

       37
       37
        
         Log.app (fun m -> m "This will discover what permissions Claude needs.\n");

     

       38
       38
        
         

     

       39
       39
        
         (* Create client with discovery mode *)

     

       40
       40
       -
         let options = Claude.Options.create ~model:"sonnet" () in

     

       40
       40
       +
         let options = Claude.Options.create ~model:(Claude.Model.of_string "sonnet") () in

     

       41
       41
        
         let client = Claude.Client.discover_permissions 

     

       42
       42
        
           (Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr ()) in

     

       43
       43

+27 -1

claudeio/test/dune

···

       38
       38
        
        (public_name hooks_example)

     

       39
       39
        
        (name hooks_example)

     

       40
       40
        
        (modules hooks_example)

     

       41
       41
       -
        (libraries claude eio_main cmdliner logs logs.fmt fmt.tty fmt.cli logs.cli))
     

       41
       41
       +
        (libraries claude eio_main cmdliner logs logs.fmt fmt.tty fmt.cli logs.cli))

     

       42
       42
       +
       

     

       43
       43
       +
       (executable

     

       44
       44
       +
        (public_name dynamic_control_demo)

     

       45
       45
       +
        (name dynamic_control_demo)

     

       46
       46
       +
        (modules dynamic_control_demo)

     

       47
       47
       +
        (libraries claude eio_main cmdliner logs logs.fmt fmt.tty fmt.cli logs.cli))

     

       48
       48
       +
       

     

       49
       49
       +
       (executable

     

       50
       50
       +
        (public_name advanced_config_demo)

     

       51
       51
       +
        (name advanced_config_demo)

     

       52
       52
       +
        (modules advanced_config_demo)

     

       53
       53
       +
        (libraries claude eio_main logs logs.fmt fmt.tty))

     

       54
       54
       +
       

     

       55
       55
       +
       (executable

     

       56
       56
       +
        (public_name structured_output_demo)

     

       57
       57
       +
        (name structured_output_demo)

     

       58
       58
       +
        (modules structured_output_demo)

     

       59
       59
       +
        (flags (:standard -w -33))

     

       60
       60
       +
        (libraries claude eio_main logs logs.fmt fmt.tty))

     

       61
       61
       +
       

     

       62
       62
       +
       (executable

     

       63
       63
       +
        (public_name structured_output_simple)

     

       64
       64
       +
        (name structured_output_simple)

     

       65
       65
       +
        (modules structured_output_simple)

     

       66
       66
       +
        (flags (:standard -w -33))

     

       67
       67
       +
        (libraries claude eio_main logs logs.fmt fmt.tty))

+1 -1

claudeio/test/hooks_example.ml

···

       51
       51
        
         in

     

       52
       52
        
       

     

       53
       53
        
         let options = Claude.Options.create

     

       54
       54
       -
           ~model:"sonnet"

     

       54
       54
       +
           ~model:(Claude.Model.of_string "sonnet")

     

       55
       55
        
           ~hooks

     

       56
       56
        
           () in

     

       57
       57

+1 -1

claudeio/test/permission_demo.ml

···

       131
       131
        
         (* DON'T specify allowed_tools - let the permission callback handle everything.

     

       132
       132
        
            The Default permission mode with a callback should send requests for all tools. *)

     

       133
       133
        
         let options = Claude.Options.create 

     

       134
       134
       -
           ~model:"sonnet"

     

       134
       134
       +
           ~model:(Claude.Model.of_string "sonnet")

     

       135
       135
        
           ~permission_mode:Claude.Permissions.Mode.Default

     

       136
       136
        
           ~permission_callback:interactive_permission_callback

     

       137
       137
        
           () in

+1 -1

claudeio/test/simple_permission_test.ml

···

       17
       17
        
       

     

       18
       18
        
         (* Create options with permission callback *)

     

       19
       19
        
         let options = Claude.Options.create

     

       20
       20
       -
           ~model:"sonnet"

     

       20
       20
       +
           ~model:(Claude.Model.of_string "sonnet")

     

       21
       21
        
           ~permission_callback:auto_allow_callback

     

       22
       22
        
           () in

     

       23
       23

+1 -1

claudeio/test/test_permissions.ml

···

       14
       14
        
       

     

       15
       15
        
         (* Create options with custom permission callback *)

     

       16
       16
        
         let options = Claude.Options.create

     

       17
       17
       -
           ~model:"sonnet"

     

       17
       17
       +
           ~model:(Claude.Model.of_string "sonnet")

     

       18
       18
        
           ~permission_callback:auto_allow_callback

     

       19
       19
        
           () in

     

       20
       20

+2 -4

stack/immich/immich.ml

···

       4
       4
        
       

     

       5
       5
        
       (** {1 Types} *)

     

       6
       6
        
       

     

       7
       7
       -
       type 'net t_internal = {

     

       7
       7
       +
       type t = {

     

       8
       8
        
         base_url: string;

     

       9
       9
        
         api_key: string;

     

       10
       10
       -
         requests_session: (float Eio.Time.clock_ty Eio.Resource.t, 'net Eio.Net.ty Eio.Resource.t) Requests.t;

     

       10
       10
       +
         requests_session: Requests.t;

     

       11
       11
        
       }

     

       12
       12
       -
       

     

       13
       13
       -
       type t = [`Generic | `Unix] t_internal

     

       14
       12
        
       

     

       15
       13
        
       type person = {

     

       16
       14
        
         id: string;

+1 -1

stack/immich/immich.mli

···

       37
       37
        
           @return An Immich client configured for the specified instance

     

       38
       38
        
       *)

     

       39
       39
        
       val create :

     

       40
       40
       -
         requests_session:(float Eio.Time.clock_ty Eio.Resource.t, [`Generic | `Unix] Eio.Net.ty Eio.Resource.t) Requests.t ->

     

       40
       40
       +
         requests_session:Requests.t ->

     

       41
       41
        
         base_url:string ->

     

       42
       42
        
         api_key:string ->

     

       43
       43
        
         t

+2 -4

stack/karakeep/karakeep.ml

···

       27
       27
        
       let json_mems_empty = Jsont.Object ([], Jsont.Meta.none)

     

       28
       28
        
       

     

       29
       29
        
       (** Type representing a Karakeep client session *)

     

       30
       30
       -
       type 'net t_internal = {

     

       30
       30
       +
       type t = {

     

       31
       31
        
         api_key: string;

     

       32
       32
        
         base_url: string;

     

       33
       33
       -
         http_client: (float Eio.Time.clock_ty Eio.Resource.t, 'net Eio.Net.ty Eio.Resource.t) Requests.t;

     

       33
       33
       +
         http_client: Requests.t;

     

       34
       34
        
       }

     

       35
       35
       -
       

     

       36
       36
       -
       type t = [`Generic | `Unix] t_internal

     

       37
       35
        
       

     

       38
       36
        
       (** Create a new Karakeep client *)

     

       39
       37
        
       let create ~sw ~env ~api_key ~base_url : t =

+2 -4

stack/peertubee/peertubee.ml

···

       1
       1
        
       (** PeerTube API client implementation (Eio version) *)

     

       2
       2
        
       

     

       3
       3
        
       (** Type representing a PeerTube client *)

     

       4
       4
       -
       type 'net t_internal = {

     

       4
       4
       +
       type t = {

     

       5
       5
        
         base_url: string;

     

       6
       6
       -
         requests_session: (float Eio.Time.clock_ty Eio.Resource.t, 'net Eio.Net.ty Eio.Resource.t) Requests.t;

     

       6
       6
       +
         requests_session: Requests.t;

     

       7
       7
        
       }

     

       8
       8
       -
       

     

       9
       9
       -
       type t = [`Generic | `Unix] t_internal

     

       10
       8
        
       

     

       11
       9
        
       (** Create a new PeerTube client *)

     

       12
       10
        
       let create ~requests_session ~base_url : t =

+1 -1

stack/peertubee/peertubee.mli

···

       8
       8
        
           @param base_url Base URL of the PeerTube instance

     

       9
       9
        
           @return A PeerTube client configured for the specified instance *)

     

       10
       10
        
       val create :

     

       11
       11
       -
         requests_session:(float Eio.Time.clock_ty Eio.Resource.t, [`Generic | `Unix] Eio.Net.ty Eio.Resource.t) Requests.t ->

     

       11
       11
       +
         requests_session:Requests.t ->

     

       12
       12
        
         base_url:string ->

     

       13
       13
        
         t

     

       14
       14

+5 -13

stack/requests/bin/ocurl.ml

···

       51
       51
        
         let doc = "Show progress bar for downloads" in

     

       52
       52
        
         Arg.(value & flag & info ["progress-bar"] ~doc)

     

       53
       53
        
       

     

       54
       54
       -
       let enable_cache =

     

       55
       55
       -
         let doc = "Enable HTTP response caching for GET and HEAD requests" in

     

       56
       56
       -
         let env_info = Cmdliner.Cmd.Env.info "OCURL_ENABLE_CACHE" in

     

       57
       57
       -
         Arg.(value & flag & info ["enable-cache"] ~env:env_info ~doc)

     

       58
       58
       -
       

     

       59
       54
        
       (* Logging setup *)

     

       60
       55
        
       (* Setup logging using Logs_cli for standard logging options *)

     

       61
       56
        
       let setup_log =

     
···

       223
       218
        
             Error (url_str, exn)

     

       224
       219
        
       

     

       225
       220
        
       (* Main function using Requests with concurrent fetching *)

     

       226
       226
       -
       let run_request env sw persist_cookies verify_tls enable_cache timeout follow_redirects max_redirects

     

       221
       221
       +
       let run_request env sw persist_cookies verify_tls timeout follow_redirects max_redirects

     

       227
       222
        
           method_ urls headers data json_data output include_headers

     

       228
       223
        
           auth _show_progress () =

     

       229
       224
        
       

     
···

       234
       229
        
       

     

       235
       230
        
         (* Create requests instance with configuration *)

     

       236
       231
        
         let timeout_obj = Option.map (fun t -> Requests.Timeout.create ~total:t ()) timeout in

     

       237
       237
       -
         let req = Requests.create ~sw ~xdg ~persist_cookies ~verify_tls ~enable_cache

     

       232
       232
       +
         let req = Requests.create ~sw ~xdg ~persist_cookies ~verify_tls

     

       238
       233
        
           ~follow_redirects ~max_redirects ?timeout:timeout_obj env in

     

       239
       234
        
       

     

       240
       235
        
         (* Set authentication if provided *)

     
···

       315
       310
        
       

     

       316
       311
        
       (* Main entry point *)

     

       317
       312
        
       let main method_ urls headers data json_data output include_headers

     

       318
       318
       -
           auth show_progress persist_cookies verify_tls enable_cache

     

       313
       313
       +
           auth show_progress persist_cookies verify_tls

     

       319
       314
        
           timeout follow_redirects max_redirects () =

     

       320
       315
        
       

     

       321
       316
        
         Eio_main.run @@ fun env ->

     

       322
       317
        
         Mirage_crypto_rng_unix.use_default ();

     

       323
       318
        
         Switch.run @@ fun sw ->

     

       324
       319
        
       

     

       325
       325
       -
         run_request env sw persist_cookies verify_tls enable_cache timeout follow_redirects max_redirects

     

       320
       320
       +
         run_request env sw persist_cookies verify_tls timeout follow_redirects max_redirects

     

       326
       321
        
           method_ urls headers data json_data output include_headers auth

     

       327
       322
        
           show_progress ()

     

       328
       323
        
       

     
···

       351
       346
        
           `P "Custom headers:";

     

       352
       347
        
           `Pre "  $(tname) -H 'Accept: application/json' -H 'X-Api-Key: secret' https://api.example.com";

     

       353
       348
        
           `P "With persistent cookies:";

     

       354
       354
       -
           `Pre "  $(tname) --persist-cookies --cache-dir ~/.ocurl https://example.com";

     

       355
       355
       -
           `P "Enable response caching:";

     

       356
       356
       -
           `Pre "  $(tname) --enable-cache https://api.example.com";

     

       349
       349
       +
           `Pre "  $(tname) --persist-cookies https://example.com";

     

       357
       350
        
           `P "Disable TLS verification (insecure):";

     

       358
       351
        
           `Pre "  $(tname) --no-verify-tls https://self-signed.example.com";

     

       359
       352
        
           `S "LOGGING OPTIONS";

     
···

       383
       376
        
                 show_progress $

     

       384
       377
        
                 Requests.Cmd.persist_cookies_term app_name $

     

       385
       378
        
                 Requests.Cmd.verify_tls_term app_name $

     

       386
       386
       -
                 enable_cache $

     

       387
       379
        
                 Requests.Cmd.timeout_term app_name $

     

       388
       380
        
                 Requests.Cmd.follow_redirects_term app_name $

     

       389
       381
        
                 Requests.Cmd.max_redirects_term app_name $

-488

stack/requests/lib/cache.ml

···

       1
       1
       -
       let src = Logs.Src.create "requests.cache" ~doc:"HTTP cache with cacheio"

     

       2
       2
       -
       module Log = (val Logs.src_log src : Logs.LOG)

     

       3
       3
       -
       

     

       4
       4
       -
       type cached_response = {

     

       5
       5
       -
         status : Cohttp.Code.status_code;

     

       6
       6
       -
         headers : Cohttp.Header.t;

     

       7
       7
       -
         body : string;

     

       8
       8
       -
       }

     

       9
       9
       -
       

     

       10
       10
       -
       type t = {

     

       11
       11
       -
         sw : Eio.Switch.t;

     

       12
       12
       -
         enabled : bool;

     

       13
       13
       -
         cache_get_requests : bool;

     

       14
       14
       -
         cache_range_requests : bool;

     

       15
       15
       -
         cacheio : Cacheio.t option;

     

       16
       16
       -
         memory_cache : (string, cached_response * float) Hashtbl.t;

     

       17
       17
       -
       }

     

       18
       18
       -
       

     

       19
       19
       -
       let create ~sw ~enabled ?(cache_get_requests=true) ?(cache_range_requests=true) ~cache_dir () =

     

       20
       20
       -
         let cacheio =

     

       21
       21
       -
           match cache_dir with

     

       22
       22
       -
           | Some dir when enabled ->

     

       23
       23
       -
               (try

     

       24
       24
       -
                 Some (Cacheio.create ~base_dir:dir)

     

       25
       25
       -
               with e ->

     

       26
       26
       -
                 Log.warn (fun m -> m "Failed to create cacheio backend: %s. Using memory cache only."

     

       27
       27
       -
                   (Printexc.to_string e));

     

       28
       28
       -
                 None)

     

       29
       29
       -
           | _ -> None

     

       30
       30
       -
         in

     

       31
       31
       -
         { sw; enabled; cache_get_requests; cache_range_requests; cacheio;

     

       32
       32
       -
           memory_cache = Hashtbl.create 100 }

     

       33
       33
       -
       

     

       34
       34
       -
       let make_cache_key ~method_ ~url ~headers =

     

       35
       35
       -
         let method_str = match method_ with

     

       36
       36
       -
           | `GET -> "GET" | `HEAD -> "HEAD"

     

       37
       37
       -
           | _ -> "OTHER"

     

       38
       38
       -
         in

     

       39
       39
       -
         let url_str = Uri.to_string url in

     

       40
       40
       -
         let range_str = match Cohttp.Header.get headers "range" with

     

       41
       41
       -
           | Some r -> "_range:" ^ r

     

       42
       42
       -
           | None -> ""

     

       43
       43
       -
         in

     

       44
       44
       -
         Printf.sprintf "%s_%s%s" method_str url_str range_str

     

       45
       45
       -
       

     

       46
       46
       -
       let is_cacheable ~method_ ~status ~headers =

     

       47
       47
       -
         match method_ with

     

       48
       48
       -
         | `GET | `HEAD ->

     

       49
       49
       -
             let code = Cohttp.Code.code_of_status status in

     

       50
       50
       -
             if code >= 200 && code < 300 then

     

       51
       51
       -
               match Cohttp.Header.get headers "cache-control" with

     

       52
       52
       -
               | Some cc ->

     

       53
       53
       -
                   let cc_lower = String.lowercase_ascii cc in

     

       54
       54
       -
                   let rec contains s sub pos =

     

       55
       55
       -
                     if pos + String.length sub > String.length s then false

     

       56
       56
       -
                     else if String.sub s pos (String.length sub) = sub then true

     

       57
       57
       -
                     else contains s sub (pos + 1)

     

       58
       58
       -
                   in

     

       59
       59
       -
                   not (contains cc_lower "no-store" 0 ||

     

       60
       60
       -
                        contains cc_lower "no-cache" 0 ||

     

       61
       61
       -
                        contains cc_lower "private" 0)

     

       62
       62
       -
               | None -> true

     

       63
       63
       -
             else

     

       64
       64
       -
               code = 301 || code = 308

     

       65
       65
       -
         | _ -> false

     

       66
       66
       -
       

     

       67
       67
       -
       let parse_max_age headers =

     

       68
       68
       -
         match Cohttp.Header.get headers "cache-control" with

     

       69
       69
       -
         | Some cc ->

     

       70
       70
       -
             let parts = String.split_on_char ',' cc |> List.map String.trim in

     

       71
       71
       -
             List.find_map (fun part ->

     

       72
       72
       -
               let prefix = "max-age=" in

     

       73
       73
       -
               if String.starts_with ~prefix part then

     

       74
       74
       -
                 let value = String.sub part (String.length prefix)

     

       75
       75
       -
                               (String.length part - String.length prefix) in

     

       76
       76
       -
                 try Some (float_of_string value) with _ -> None

     

       77
       77
       -
               else None

     

       78
       78
       -
             ) parts

     

       79
       79
       -
         | None -> None

     

       80
       80
       -
       

     

       81
       81
       -
       (* JSON codec for cache metadata *)

     

       82
       82
       -
       module Metadata = struct

     

       83
       83
       -
         type t = {

     

       84
       84
       -
           status_code : int;

     

       85
       85
       -
           headers : (string * string) list;

     

       86
       86
       -
         }

     

       87
       87
       -
       

     

       88
       88
       -
         let make status_code headers = { status_code; headers }

     

       89
       89
       -
         let status_code t = t.status_code

     

       90
       90
       -
         let headers t = t.headers

     

       91
       91
       -
       

     

       92
       92
       -
         let t_jsont =

     

       93
       93
       -
           let header_pair_jsont =

     

       94
       94
       -
             let dec x y = (x, y) in

     

       95
       95
       -
             let enc (x, y) i = if i = 0 then x else y in

     

       96
       96
       -
             Jsont.t2 ~dec ~enc Jsont.string

     

       97
       97
       -
           in

     

       98
       98
       -
           Jsont.Object.map ~kind:"CacheMetadata" make

     

       99
       99
       -
           |> Jsont.Object.mem "status_code" Jsont.int ~enc:status_code

     

       100
       100
       -
           |> Jsont.Object.mem "headers" (Jsont.list header_pair_jsont) ~enc:headers

     

       101
       101
       -
           |> Jsont.Object.finish

     

       102
       102
       -
       end

     

       103
       103
       -
       

     

       104
       104
       -
       let serialize_metadata ~status ~headers =

     

       105
       105
       -
         let status_code = Cohttp.Code.code_of_status status in

     

       106
       106
       -
         let headers_assoc = Cohttp.Header.to_list headers in

     

       107
       107
       -
         let metadata = Metadata.make status_code headers_assoc in

     

       108
       108
       -
         match Jsont_bytesrw.encode_string' Metadata.t_jsont metadata with

     

       109
       109
       -
         | Ok s -> s

     

       110
       110
       -
         | Error e -> failwith (Fmt.str "Failed to serialize metadata: %s" (Jsont.Error.to_string e))

     

       111
       111
       -
       

     

       112
       112
       -
       let deserialize_metadata json_str =

     

       113
       113
       -
         try

     

       114
       114
       -
           match Jsont_bytesrw.decode_string' Metadata.t_jsont json_str with

     

       115
       115
       -
           | Ok metadata ->

     

       116
       116
       -
               let status = Cohttp.Code.status_of_code (Metadata.status_code metadata) in

     

       117
       117
       -
               let headers = Cohttp.Header.of_list (Metadata.headers metadata) in

     

       118
       118
       -
               Some (status, headers)

     

       119
       119
       -
           | Error _ -> None

     

       120
       120
       -
         with _ -> None

     

       121
       121
       -
       

     

       122
       122
       -
       let get t ~method_ ~url ~headers =

     

       123
       123
       -
         if not t.enabled then None

     

       124
       124
       -
         else if method_ = `GET && not t.cache_get_requests then None

     

       125
       125
       -
         else

     

       126
       126
       -
           let key = make_cache_key ~method_ ~url ~headers in

     

       127
       127
       -
       

     

       128
       128
       -
           (* Try cacheio first *)

     

       129
       129
       -
           match t.cacheio with

     

       130
       130
       -
           | Some cache ->

     

       131
       131
       -
               (* Check for metadata entry *)

     

       132
       132
       -
               let metadata_key = key ^ ".meta" in

     

       133
       133
       -
               let body_key = key ^ ".body" in

     

       134
       134
       -
       

     

       135
       135
       -
               if Cacheio.exists cache ~key:metadata_key && Cacheio.exists cache ~key:body_key then

     

       136
       136
       -
                 Eio.Switch.run @@ fun sw ->

     

       137
       137
       -
                 (* Read metadata *)

     

       138
       138
       -
                 let metadata_opt = match Cacheio.get cache ~key:metadata_key ~sw with

     

       139
       139
       -
                   | Some source ->

     

       140
       140
       -
                       let buf = Buffer.create 256 in

     

       141
       141
       -
                       Eio.Flow.copy source (Eio.Flow.buffer_sink buf);

     

       142
       142
       -
                       deserialize_metadata (Buffer.contents buf)

     

       143
       143
       -
                   | None -> None

     

       144
       144
       -
                 in

     

       145
       145
       -
       

     

       146
       146
       -
                 (match metadata_opt with

     

       147
       147
       -
                  | Some (status, resp_headers) ->

     

       148
       148
       -
                      (* Read body *)

     

       149
       149
       -
                      (match Cacheio.get cache ~key:body_key ~sw with

     

       150
       150
       -
                       | Some source ->

     

       151
       151
       -
                           let buf = Buffer.create 4096 in

     

       152
       152
       -
                           Eio.Flow.copy source (Eio.Flow.buffer_sink buf);

     

       153
       153
       -
                           let body = Buffer.contents buf in

     

       154
       154
       -
                           Log.debug (fun m -> m "Cache hit for %s" (Uri.to_string url));

     

       155
       155
       -
                           Some { status; headers = resp_headers; body }

     

       156
       156
       -
                       | None ->

     

       157
       157
       -
                           Log.debug (fun m -> m "Cache body missing for %s" (Uri.to_string url));

     

       158
       158
       -
                           None)

     

       159
       159
       -
                  | None ->

     

       160
       160
       -
                      Log.debug (fun m -> m "Cache metadata missing for %s" (Uri.to_string url));

     

       161
       161
       -
                      None)

     

       162
       162
       -
               else

     

       163
       163
       -
                 (Log.debug (fun m -> m "Cache miss for %s" (Uri.to_string url));

     

       164
       164
       -
                  None)

     

       165
       165
       -
           | None ->

     

       166
       166
       -
               (* Fall back to memory cache *)

     

       167
       167
       -
               match Hashtbl.find_opt t.memory_cache key with

     

       168
       168
       -
               | Some (response, expiry) when expiry > Unix.gettimeofday () ->

     

       169
       169
       -
                   Log.debug (fun m -> m "Memory cache hit for %s" (Uri.to_string url));

     

       170
       170
       -
                   Some response

     

       171
       171
       -
               | _ ->

     

       172
       172
       -
                   Log.debug (fun m -> m "Cache miss for %s" (Uri.to_string url));

     

       173
       173
       -
                   None

     

       174
       174
       -
       

     

       175
       175
       -
       let get_stream t ~method_ ~url ~headers ~sw =

     

       176
       176
       -
         if not t.enabled then None

     

       177
       177
       -
         else if method_ = `GET && not t.cache_get_requests then None

     

       178
       178
       -
         else

     

       179
       179
       -
           let key = make_cache_key ~method_ ~url ~headers in

     

       180
       180
       -
       

     

       181
       181
       -
           match t.cacheio with

     

       182
       182
       -
           | Some cache ->

     

       183
       183
       -
               let metadata_key = key ^ ".meta" in

     

       184
       184
       -
               let body_key = key ^ ".body" in

     

       185
       185
       -
       

     

       186
       186
       -
               if Cacheio.exists cache ~key:metadata_key && Cacheio.exists cache ~key:body_key then

     

       187
       187
       -
                 (* Read metadata first *)

     

       188
       188
       -
                 let metadata_opt =

     

       189
       189
       -
                   match Cacheio.get cache ~key:metadata_key ~sw with

     

       190
       190
       -
                   | Some source ->

     

       191
       191
       -
                       let buf = Buffer.create 256 in

     

       192
       192
       -
                       Eio.Flow.copy source (Eio.Flow.buffer_sink buf);

     

       193
       193
       -
                       deserialize_metadata (Buffer.contents buf)

     

       194
       194
       -
                   | None -> None

     

       195
       195
       -
                 in

     

       196
       196
       -
       

     

       197
       197
       -
                 (match metadata_opt with

     

       198
       198
       -
                  | Some (status, resp_headers) ->

     

       199
       199
       -
                      (* Return body stream directly *)

     

       200
       200
       -
                      (match Cacheio.get cache ~key:body_key ~sw with

     

       201
       201
       -
                       | Some source ->

     

       202
       202
       -
                           Log.debug (fun m -> m "Streaming cache hit for %s" (Uri.to_string url));

     

       203
       203
       -
                           Some (status, resp_headers, source)

     

       204
       204
       -
                       | None -> None)

     

       205
       205
       -
                  | None -> None)

     

       206
       206
       -
               else None

     

       207
       207
       -
           | None -> None

     

       208
       208
       -
       

     

       209
       209
       -
       let put t ~method_ ~url ~request_headers ~status ~headers ~body =

     

       210
       210
       -
         if not t.enabled then ()

     

       211
       211
       -
         else if is_cacheable ~method_ ~status ~headers then

     

       212
       212
       -
           let key = make_cache_key ~method_ ~url ~headers:request_headers in

     

       213
       213
       -
           let ttl = parse_max_age headers in

     

       214
       214
       -
       

     

       215
       215
       -
           Log.debug (fun m -> m "Caching response for %s (ttl: %s)"

     

       216
       216
       -
             (Uri.to_string url)

     

       217
       217
       -
             (match ttl with Some t -> Printf.sprintf "%.0fs" t | None -> "3600s"));

     

       218
       218
       -
       

     

       219
       219
       -
           (match t.cacheio with

     

       220
       220
       -
            | Some cache ->

     

       221
       221
       -
                Eio.Switch.run @@ fun _sw ->

     

       222
       222
       -
                let metadata_key = key ^ ".meta" in

     

       223
       223
       -
                let metadata = serialize_metadata ~status ~headers in

     

       224
       224
       -
                let metadata_source = Eio.Flow.string_source metadata in

     

       225
       225
       -
                Cacheio.put cache ~key:metadata_key ~source:metadata_source ~ttl ();

     

       226
       226
       -
       

     

       227
       227
       -
                let body_key = key ^ ".body" in

     

       228
       228
       -
                let body_source = Eio.Flow.string_source body in

     

       229
       229
       -
                Cacheio.put cache ~key:body_key ~source:body_source ~ttl ()

     

       230
       230
       -
            | None -> ());

     

       231
       231
       -
       

     

       232
       232
       -
           let cached_resp = { status; headers; body } in

     

       233
       233
       -
           let expiry = Unix.gettimeofday () +. Option.value ttl ~default:3600.0 in

     

       234
       234
       -
           Hashtbl.replace t.memory_cache key (cached_resp, expiry)

     

       235
       235
       -
       

     

       236
       236
       -
       let put_stream t ~method_ ~url ~request_headers ~status ~headers ~body_source ~ttl =

     

       237
       237
       -
         if not t.enabled then ()

     

       238
       238
       -
         else if is_cacheable ~method_ ~status ~headers then

     

       239
       239
       -
           let key = make_cache_key ~method_ ~url ~headers:request_headers in

     

       240
       240
       -
       

     

       241
       241
       -
           Log.debug (fun m -> m "Caching streamed response for %s (ttl: %s)"

     

       242
       242
       -
             (Uri.to_string url)

     

       243
       243
       -
             (match ttl with Some t -> Printf.sprintf "%.0fs" t | None -> "3600s"));

     

       244
       244
       -
       

     

       245
       245
       -
           match t.cacheio with

     

       246
       246
       -
           | Some cache ->

     

       247
       247
       -
               Eio.Switch.run @@ fun _sw ->

     

       248
       248
       -
       

     

       249
       249
       -
               (* Store metadata *)

     

       250
       250
       -
               let metadata_key = key ^ ".meta" in

     

       251
       251
       -
               let metadata = serialize_metadata ~status ~headers in

     

       252
       252
       -
               let metadata_source = Eio.Flow.string_source metadata in

     

       253
       253
       -
               Cacheio.put cache ~key:metadata_key ~source:metadata_source ~ttl ();

     

       254
       254
       -
       

     

       255
       255
       -
               (* Store body directly from source *)

     

       256
       256
       -
               let body_key = key ^ ".body" in

     

       257
       257
       -
               Cacheio.put cache ~key:body_key ~source:body_source ~ttl ()

     

       258
       258
       -
           | None -> ()

     

       259
       259
       -
       

     

       260
       260
       -
       module Range = struct

     

       261
       261
       -
         type t = {

     

       262
       262
       -
           start : int64;

     

       263
       263
       -
           end_ : int64 option;  (* None means to end of file *)

     

       264
       264
       -
         }

     

       265
       265
       -
       

     

       266
       266
       -
         let of_header header =

     

       267
       267
       -
           (* Parse Range: bytes=start-end *)

     

       268
       268
       -
           let prefix = "bytes=" in

     

       269
       269
       -
           let prefix_len = String.length prefix in

     

       270
       270
       -
           if String.length header >= prefix_len &&

     

       271
       271
       -
              String.sub header 0 prefix_len = prefix then

     

       272
       272
       -
             let range_str = String.sub header prefix_len (String.length header - prefix_len) in

     

       273
       273
       -
             match String.split_on_char '-' range_str with

     

       274
       274
       -
             | [start; ""] ->

     

       275
       275
       -
                 (* bytes=N- means from N to end *)

     

       276
       276
       -
                 (try Some { start = Int64.of_string start; end_ = None }

     

       277
       277
       -
                  with _ -> None)

     

       278
       278
       -
             | [start; end_] ->

     

       279
       279
       -
                 (* bytes=N-M *)

     

       280
       280
       -
                 (try Some {

     

       281
       281
       -
                   start = Int64.of_string start;

     

       282
       282
       -
                   end_ = Some (Int64.of_string end_)

     

       283
       283
       -
                 }

     

       284
       284
       -
                  with _ -> None)

     

       285
       285
       -
             | _ -> None

     

       286
       286
       -
           else None

     

       287
       287
       -
       

     

       288
       288
       -
         let to_header t =

     

       289
       289
       -
           match t.end_ with

     

       290
       290
       -
           | None -> Printf.sprintf "bytes=%Ld-" t.start

     

       291
       291
       -
           | Some e -> Printf.sprintf "bytes=%Ld-%Ld" t.start e

     

       292
       292
       -
       

     

       293
       293
       -
         let to_cacheio_range t ~total_size =

     

       294
       294
       -
           let end_ = match t.end_ with

     

       295
       295
       -
             | None -> Int64.pred total_size

     

       296
       296
       -
             | Some e -> min e (Int64.pred total_size)

     

       297
       297
       -
           in

     

       298
       298
       -
           (* Convert to Cacheio.Range.t *)

     

       299
       299
       -
           Cacheio.Range.create ~start:t.start ~end_

     

       300
       300
       -
       end

     

       301
       301
       -
       

     

       302
       302
       -
       let download_range t ~sw ~url ~range ~on_chunk =

     

       303
       303
       -
         let range_header = Range.to_header range in

     

       304
       304
       -
         Log.debug (fun m -> m "Range request for %s: %s"

     

       305
       305
       -
           (Uri.to_string url) range_header);

     

       306
       306
       -
       

     

       307
       307
       -
         match t.cacheio with

     

       308
       308
       -
         | Some cache ->

     

       309
       309
       -
             let key = Uri.to_string url in

     

       310
       310
       -
             let cacheio_range = Range.to_cacheio_range range ~total_size:Int64.max_int in

     

       311
       311
       -
       

     

       312
       312
       -
             (match Cacheio.get_range cache ~key ~range:cacheio_range ~sw with

     

       313
       313
       -
              | `Complete source ->

     

       314
       314
       -
                  let rec read_chunks () =

     

       315
       315
       -
                    let chunk = Cstruct.create 8192 in

     

       316
       316
       -
                    try

     

       317
       317
       -
                      let n = Eio.Flow.single_read source chunk in

     

       318
       318
       -
                      if n > 0 then begin

     

       319
       319
       -
                        on_chunk (Cstruct.to_string ~off:0 ~len:n chunk);

     

       320
       320
       -
                        read_chunks ()

     

       321
       321
       -
                      end

     

       322
       322
       -
                    with End_of_file -> ()

     

       323
       323
       -
                  in

     

       324
       324
       -
                  read_chunks ();

     

       325
       325
       -
                  Some true

     

       326
       326
       -
              | `Chunks chunk_sources ->

     

       327
       327
       -
                  List.iter (fun (_range, source) ->

     

       328
       328
       -
                    let rec read_chunk () =

     

       329
       329
       -
                      let chunk = Cstruct.create 8192 in

     

       330
       330
       -
                      try

     

       331
       331
       -
                        let n = Eio.Flow.single_read source chunk in

     

       332
       332
       -
                        if n > 0 then begin

     

       333
       333
       -
                          on_chunk (Cstruct.to_string ~off:0 ~len:n chunk);

     

       334
       334
       -
                          read_chunk ()

     

       335
       335
       -
                        end

     

       336
       336
       -
                      with End_of_file -> ()

     

       337
       337
       -
                    in

     

       338
       338
       -
                    read_chunk ()

     

       339
       339
       -
                  ) chunk_sources;

     

       340
       340
       -
                  Some true

     

       341
       341
       -
              | `Not_found -> None)

     

       342
       342
       -
         | None -> None

     

       343
       343
       -
       

     

       344
       344
       -
       let put_chunk t ~url ~range ~data =

     

       345
       345
       -
         if not t.enabled || not t.cache_range_requests then ()

     

       346
       346
       -
         else

     

       347
       347
       -
           match t.cacheio with

     

       348
       348
       -
           | Some cache ->

     

       349
       349
       -
               let key = Uri.to_string url in

     

       350
       350
       -
               let cacheio_range = Range.to_cacheio_range range ~total_size:Int64.max_int in

     

       351
       351
       -
               Eio.Switch.run @@ fun _sw ->

     

       352
       352
       -
               let source = Eio.Flow.string_source data in

     

       353
       353
       -
               Cacheio.put_chunk cache ~key ~range:cacheio_range ~source ()

     

       354
       354
       -
           | None ->

     

       355
       355
       -
               Log.debug (fun m -> m "Cannot cache chunk for %s: no cacheio backend"

     

       356
       356
       -
                 (Uri.to_string url))

     

       357
       357
       -
       

     

       358
       358
       -
       let has_complete t ~url ~total_size =

     

       359
       359
       -
         if not t.enabled then false

     

       360
       360
       -
         else

     

       361
       361
       -
           match t.cacheio with

     

       362
       362
       -
           | Some cache ->

     

       363
       363
       -
               let key = Uri.to_string url in

     

       364
       364
       -
               Cacheio.has_complete_chunks cache ~key ~total_size

     

       365
       365
       -
           | None -> false

     

       366
       366
       -
       

     

       367
       367
       -
       let missing_ranges t ~url ~total_size =

     

       368
       368
       -
         if not t.enabled then

     

       369
       369
       -
           [{ Range.start = 0L; end_ = Some (Int64.pred total_size) }]

     

       370
       370
       -
         else

     

       371
       371
       -
           match t.cacheio with

     

       372
       372
       -
           | Some cache ->

     

       373
       373
       -
               let key = Uri.to_string url in

     

       374
       374
       -
               let cacheio_ranges = Cacheio.missing_ranges cache ~key ~total_size in

     

       375
       375
       -
               List.map (fun r ->

     

       376
       376
       -
                 { Range.start = Cacheio.Range.start r;

     

       377
       377
       -
                   end_ = Some (Cacheio.Range.end_ r) }

     

       378
       378
       -
               ) cacheio_ranges

     

       379
       379
       -
           | None ->

     

       380
       380
       -
               [{ Range.start = 0L; end_ = Some (Int64.pred total_size) }]

     

       381
       381
       -
       

     

       382
       382
       -
       let coalesce_chunks t ~url =

     

       383
       383
       -
         if not t.enabled then false

     

       384
       384
       -
         else

     

       385
       385
       -
           match t.cacheio with

     

       386
       386
       -
           | Some cache ->

     

       387
       387
       -
               let key = Uri.to_string url in

     

       388
       388
       -
               let promise = Cacheio.coalesce_chunks cache ~key ~verify:true () in

     

       389
       389
       -
               (match Eio.Promise.await promise with

     

       390
       390
       -
                | Ok () ->

     

       391
       391
       -
                    Log.info (fun m -> m "Successfully coalesced chunks for %s" key);

     

       392
       392
       -
                    true

     

       393
       393
       -
                | Error exn ->

     

       394
       394
       -
                    Log.warn (fun m -> m "Failed to coalesce chunks for %s: %s"

     

       395
       395
       -
                      key (Printexc.to_string exn));

     

       396
       396
       -
                    false)

     

       397
       397
       -
           | None -> false

     

       398
       398
       -
       

     

       399
       399
       -
       let evict t ~url =

     

       400
       400
       -
         if not t.enabled then ()

     

       401
       401
       -
         else

     

       402
       402
       -
           let key = make_cache_key ~method_:`GET ~url ~headers:(Cohttp.Header.init ()) in

     

       403
       403
       -
           (match t.cacheio with

     

       404
       404
       -
            | Some cache ->

     

       405
       405
       -
                Cacheio.delete cache ~key:(key ^ ".meta");

     

       406
       406
       -
                Cacheio.delete cache ~key:(key ^ ".body")

     

       407
       407
       -
            | None -> ());

     

       408
       408
       -
           Log.debug (fun m -> m "Evicting cache for %s" (Uri.to_string url));

     

       409
       409
       -
           Hashtbl.remove t.memory_cache key

     

       410
       410
       -
       

     

       411
       411
       -
       let clear t =

     

       412
       412
       -
         Log.info (fun m -> m "Clearing entire cache");

     

       413
       413
       -
         (match t.cacheio with

     

       414
       414
       -
          | Some cache -> Cacheio.clear cache

     

       415
       415
       -
          | None -> ());

     

       416
       416
       -
         Hashtbl.clear t.memory_cache

     

       417
       417
       -
       

     

       418
       418
       -
       module Stats = struct

     

       419
       419
       -
         type cacheio_stats = {

     

       420
       420
       -
           total_entries : int;

     

       421
       421
       -
           total_bytes : int;

     

       422
       422
       -
           expired_entries : int;

     

       423
       423
       -
           pinned_entries : int;

     

       424
       424
       -
           temporary_entries : int;

     

       425
       425
       -
         }

     

       426
       426
       -
       

     

       427
       427
       -
         type t = {

     

       428
       428
       -
           memory_cache_entries : int;

     

       429
       429
       -
           cache_backend : string;

     

       430
       430
       -
           enabled : bool;

     

       431
       431
       -
           cache_get_requests : bool;

     

       432
       432
       -
           cache_range_requests : bool;

     

       433
       433
       -
           cacheio_stats : cacheio_stats option;

     

       434
       434
       -
         }

     

       435
       435
       -
       

     

       436
       436
       -
         let make_cacheio_stats total_entries total_bytes expired_entries pinned_entries temporary_entries =

     

       437
       437
       -
           { total_entries; total_bytes; expired_entries; pinned_entries; temporary_entries }

     

       438
       438
       -
       

     

       439
       439
       -
         let make memory_cache_entries cache_backend enabled cache_get_requests cache_range_requests cacheio_stats =

     

       440
       440
       -
           { memory_cache_entries; cache_backend; enabled; cache_get_requests; cache_range_requests; cacheio_stats }

     

       441
       441
       -
       

     

       442
       442
       -
         let cacheio_stats_jsont =

     

       443
       443
       -
           Jsont.Object.map ~kind:"CacheioStats" make_cacheio_stats

     

       444
       444
       -
           |> Jsont.Object.mem "total_entries" Jsont.int ~enc:(fun t -> t.total_entries)

     

       445
       445
       -
           |> Jsont.Object.mem "total_bytes" Jsont.int ~enc:(fun t -> t.total_bytes)

     

       446
       446
       -
           |> Jsont.Object.mem "expired_entries" Jsont.int ~enc:(fun t -> t.expired_entries)

     

       447
       447
       -
           |> Jsont.Object.mem "pinned_entries" Jsont.int ~enc:(fun t -> t.pinned_entries)

     

       448
       448
       -
           |> Jsont.Object.mem "temporary_entries" Jsont.int ~enc:(fun t -> t.temporary_entries)

     

       449
       449
       -
           |> Jsont.Object.finish

     

       450
       450
       -
       

     

       451
       451
       -
         let t_jsont =

     

       452
       452
       -
           Jsont.Object.map ~kind:"CacheStats" make

     

       453
       453
       -
           |> Jsont.Object.mem "memory_cache_entries" Jsont.int ~enc:(fun t -> t.memory_cache_entries)

     

       454
       454
       -
           |> Jsont.Object.mem "cache_backend" Jsont.string ~enc:(fun t -> t.cache_backend)

     

       455
       455
       -
           |> Jsont.Object.mem "enabled" Jsont.bool ~enc:(fun t -> t.enabled)

     

       456
       456
       -
           |> Jsont.Object.mem "cache_get_requests" Jsont.bool ~enc:(fun t -> t.cache_get_requests)

     

       457
       457
       -
           |> Jsont.Object.mem "cache_range_requests" Jsont.bool ~enc:(fun t -> t.cache_range_requests)

     

       458
       458
       -
           |> Jsont.Object.opt_mem "cacheio_stats" cacheio_stats_jsont ~enc:(fun t -> t.cacheio_stats)

     

       459
       459
       -
           |> Jsont.Object.finish

     

       460
       460
       -
       

     

       461
       461
       -
         let to_string t =

     

       462
       462
       -
           match Jsont_bytesrw.encode_string' ~format:Jsont.Indent t_jsont t with

     

       463
       463
       -
           | Ok s -> s

     

       464
       464
       -
           | Error e ->

     

       465
       465
       -
               let msg = Jsont.Error.to_string e in

     

       466
       466
       -
               failwith (Printf.sprintf "Failed to encode stats: %s" msg)

     

       467
       467
       -
       end

     

       468
       468
       -
       

     

       469
       469
       -
       let stats t =

     

       470
       470
       -
         let cacheio_stats =

     

       471
       471
       -
           match t.cacheio with

     

       472
       472
       -
           | Some cache ->

     

       473
       473
       -
               let stats = Cacheio.stats cache in

     

       474
       474
       -
               Some (Stats.make_cacheio_stats

     

       475
       475
       -
                 (Cacheio.Stats.entry_count stats)

     

       476
       476
       -
                 (Int64.to_int (Cacheio.Stats.total_size stats))

     

       477
       477
       -
                 (Cacheio.Stats.expired_count stats)

     

       478
       478
       -
                 (Cacheio.Stats.pinned_count stats)

     

       479
       479
       -
                 (Cacheio.Stats.temporary_count stats))

     

       480
       480
       -
           | None -> None

     

       481
       481
       -
         in

     

       482
       482
       -
         Stats.make

     

       483
       483
       -
           (Hashtbl.length t.memory_cache)

     

       484
       484
       -
           (if Option.is_some t.cacheio then "cacheio" else "memory")

     

       485
       485
       -
           t.enabled

     

       486
       486
       -
           t.cache_get_requests

     

       487
       487
       -
           t.cache_range_requests

     

       488
       488
       -
           cacheio_stats

-1

stack/requests/lib/dune

···

       11
       11
        
         jsont

     

       12
       12
        
         jsont.bytesrw

     

       13
       13
        
         base64

     

       14
       14
       -
         cacheio

     

       15
       14
        
         cookeio

     

       16
       15
        
         xdge

     

       17
       16
        
         logs

+41 -76

stack/requests/lib/requests.ml

···

       14
       14
        
       module Status = Status

     

       15
       15
        
       module Error = Error

     

       16
       16
        
       module Retry = Retry

     

       17
       17
       -
       module Cache = Cache

     

       18
       17
        
       

     

       19
       18
        
       (* Note: RNG initialization should be done by the application using

     

       20
       19
        
          Mirage_crypto_rng_unix.initialize before calling Eio_main.run.

     
···

       23
       22
        
       

     

       24
       23
        
       (* Main API - Session functionality with connection pooling *)

     

       25
       24
        
       

     

       26
       26
       -
       type ('clock, 'net) t = {

     

       25
       25
       +
       (* Internal session type with existential type parameters *)

     

       26
       26
       +
       type ('clock, 'net) session = {

     

       27
       27
        
         sw : Eio.Switch.t;

     

       28
       28
        
         clock : 'clock;

     

       29
       29
        
         net : 'net;

     
···

       41
       41
        
         retry : Retry.config option;

     

       42
       42
        
         persist_cookies : bool;

     

       43
       43
        
         xdg : Xdge.t option;

     

       44
       44
       -
         cache : Cache.t option;

     

       45
       44
        
       

     

       46
       45
        
         (* Statistics - mutable for tracking across all derived sessions *)

     

       47
       46
        
         mutable requests_made : int;

     
···

       49
       48
        
         mutable retries_count : int;

     

       50
       49
        
       }

     

       51
       50
        
       

     

       51
       51
       +
       (* Public type that hides the existential type parameters.

     

       52
       52
       +
          We constrain the existentials to ensure they satisfy the requirements

     

       53
       53
       +
          of the internal functions. *)

     

       54
       54
       +
       type t = T : ([> float Eio.Time.clock_ty] Eio.Resource.t,

     

       55
       55
       +
                      [> [> `Generic] Eio.Net.ty] Eio.Resource.t) session -> t

     

       56
       56
       +
       

     

       52
       57
        
       let create

     

       53
       58
        
           ~sw

     

       54
       59
        
           ?http_pool

     
···

       66
       71
        
           ?(connection_lifetime = 300.0)

     

       67
       72
        
           ?retry

     

       68
       73
        
           ?(persist_cookies = false)

     

       69
       69
       -
           ?(enable_cache = false)

     

       70
       74
        
           ?xdg

     

       71
       75
        
           env =

     

       72
       76
        
       

     

       73
       77
        
         let clock = env#clock in

     

       74
       78
        
         let net = env#net in

     

       75
       79
        
       

     

       76
       76
       -
         let xdg = match xdg, persist_cookies || enable_cache with

     

       80
       80
       +
         let xdg = match xdg, persist_cookies with

     

       77
       81
        
           | Some x, _ -> Some x

     

       78
       82
        
           | None, true -> Some (Xdge.create env#fs "requests")

     

       79
       83
        
           | None, false -> None

     
···

       135
       139
        
               Cookeio.create ()

     

       136
       140
        
         in

     

       137
       141
        
       

     

       138
       138
       -
         let cache = match enable_cache, xdg with

     

       139
       139
       -
           | true, Some xdg_ctx ->

     

       140
       140
       -
               let cache_dir = Xdge.cache_dir xdg_ctx in

     

       141
       141
       -
               Some (Cache.create ~sw ~enabled:true ~cache_dir:(Some cache_dir) ())

     

       142
       142
       -
           | true, None ->

     

       143
       143
       -
               (* Memory-only cache when no XDG available *)

     

       144
       144
       -
               Some (Cache.create ~sw ~enabled:true ~cache_dir:None ())

     

       145
       145
       -
           | false, _ -> None

     

       146
       146
       -
         in

     

       147
       147
       -
       

     

       148
       148
       -
         {

     

       142
       142
       +
         T {

     

       149
       143
        
           sw;

     

       150
       144
        
           clock;

     

       151
       145
        
           net;

     
···

       163
       157
        
           retry;

     

       164
       158
        
           persist_cookies;

     

       165
       159
        
           xdg;

     

       166
       166
       -
           cache;

     

       167
       160
        
           requests_made = 0;

     

       168
       161
        
           total_time = 0.0;

     

       169
       162
        
           retries_count = 0;

     

       170
       163
        
         }

     

       171
       164
        
       

     

       172
       172
       -
       let set_default_header t key value =

     

       173
       173
       -
         { t with default_headers = Headers.set key value t.default_headers }

     

       165
       165
       +
       let set_default_header (T t) key value =

     

       166
       166
       +
         T { t with default_headers = Headers.set key value t.default_headers }

     

       174
       167
        
       

     

       175
       175
       -
       let remove_default_header t key =

     

       176
       176
       -
         { t with default_headers = Headers.remove key t.default_headers }

     

       168
       168
       +
       let remove_default_header (T t) key =

     

       169
       169
       +
         T { t with default_headers = Headers.remove key t.default_headers }

     

       177
       170
        
       

     

       178
       178
       -
       let set_auth t auth =

     

       171
       171
       +
       let set_auth (T t) auth =

     

       179
       172
        
         Log.debug (fun m -> m "Setting authentication method");

     

       180
       180
       -
         { t with auth = Some auth }

     

       173
       173
       +
         T { t with auth = Some auth }

     

       181
       174
        
       

     

       182
       182
       -
       let clear_auth t =

     

       175
       175
       +
       let clear_auth (T t) =

     

       183
       176
        
         Log.debug (fun m -> m "Clearing authentication");

     

       184
       184
       -
         { t with auth = None }

     

       177
       177
       +
         T { t with auth = None }

     

       185
       178
        
       

     

       186
       186
       -
       let set_timeout t timeout =

     

       179
       179
       +
       let set_timeout (T t) timeout =

     

       187
       180
        
         Log.debug (fun m -> m "Setting timeout: %a" Timeout.pp timeout);

     

       188
       188
       -
         { t with timeout }

     

       181
       181
       +
         T { t with timeout }

     

       189
       182
        
       

     

       190
       190
       -
       let set_retry t config =

     

       183
       183
       +
       let set_retry (T t) config =

     

       191
       184
        
         Log.debug (fun m -> m "Setting retry config: max_retries=%d" config.Retry.max_retries);

     

       192
       192
       -
         { t with retry = Some config }

     

       185
       185
       +
         T { t with retry = Some config }

     

       193
       186
        
       

     

       194
       194
       -
       let cookies t = t.cookie_jar

     

       195
       195
       -
       let clear_cookies t = Cookeio.clear t.cookie_jar

     

       187
       187
       +
       let cookies (T t) = t.cookie_jar

     

       188
       188
       +
       let clear_cookies (T t) = Cookeio.clear t.cookie_jar

     

       196
       189
        
       

     

       197
       190
        
       (* Internal request function using connection pools *)

     

       198
       191
        
       let make_request_internal t ?headers ?body ?auth ?timeout ?follow_redirects ?max_redirects ~method_ url =

     
···

       254
       247
        
           | Some b -> Body.Private.to_string b

     

       255
       248
        
         in

     

       256
       249
        
       

     

       257
       257
       -
         (* Check cache for GET and HEAD requests when body is not present *)

     

       258
       258
       -
         let cached_response = match t.cache, method_, body with

     

       259
       259
       -
           | Some cache, (`GET | `HEAD), None ->

     

       260
       260
       -
               Log.debug (fun m -> m "Checking cache for %s request to %s" method_str url);

     

       261
       261
       -
               let headers_cohttp = Cohttp.Header.of_list (Headers.to_list headers) in

     

       262
       262
       -
               Cache.get cache ~method_ ~url:uri ~headers:headers_cohttp

     

       263
       263
       -
           | _ -> None

     

       264
       264
       -
         in

     

       265
       265
       -
       

     

       266
       266
       -
         let response = match cached_response with

     

       267
       267
       -
           | Some cached ->

     

       268
       268
       -
               Log.info (fun m -> m "Cache HIT for %s request to %s" method_str url);

     

       269
       269
       -
               (* Convert cached response to Response.t *)

     

       270
       270
       -
               let status = Cohttp.Code.code_of_status cached.Cache.status in

     

       271
       271
       -
               let resp_headers = Headers.of_list (Cohttp.Header.to_list cached.Cache.headers) in

     

       272
       272
       -
               let body_flow = Eio.Flow.string_source cached.Cache.body in

     

       273
       273
       -
               Response.Private.make ~sw:t.sw ~status ~headers:resp_headers ~body:body_flow ~url ~elapsed:0.0

     

       274
       274
       -
           | None ->

     

       275
       275
       -
               Log.info (fun m -> m "Cache MISS or not applicable for %s request to %s" method_str url);

     

       250
       250
       +
         let response =

     

       276
       251
        
       

     

       277
       252
        
               (* Execute request with redirect handling *)

     

       278
       253
        
               let rec make_with_redirects url_to_fetch redirects_left =

     
···

       354
       329
        
               let elapsed = Unix.gettimeofday () -. start_time in

     

       355
       330
        
               Log.info (fun m -> m "Request completed in %.3f seconds" elapsed);

     

       356
       331
        
       

     

       357
       357
       -
               (* Store in cache if successful and caching enabled *)

     

       358
       358
       -
               (match t.cache with

     

       359
       359
       -
                | Some cache when final_status >= 200 && final_status < 300 ->

     

       360
       360
       -
                    Log.debug (fun m -> m "Storing response in cache for %s" url);

     

       361
       361
       -
                    let status = Cohttp.Code.status_of_code final_status in

     

       362
       362
       -
                    let resp_headers_cohttp = Cohttp.Header.of_list (Headers.to_list final_headers) in

     

       363
       363
       -
                    let headers_cohttp = Cohttp.Header.of_list (Headers.to_list headers) in

     

       364
       364
       -
                    Cache.put cache ~method_ ~url:uri ~request_headers:headers_cohttp

     

       365
       365
       -
                      ~status ~headers:resp_headers_cohttp ~body:final_body_str

     

       366
       366
       -
                | _ -> ());

     

       367
       367
       -
       

     

       368
       332
        
               (* Create a flow from the body string *)

     

       369
       333
        
               let body_flow = Eio.Flow.string_source final_body_str in

     

       370
       334
        
       

     
···

       403
       367
        
         response

     

       404
       368
        
       

     

       405
       369
        
       (* Public request function - executes synchronously *)

     

       406
       406
       -
       let request t ?headers ?body ?auth ?timeout ?follow_redirects ?max_redirects ~method_ url =

     

       370
       370
       +
       let request (T t) ?headers ?body ?auth ?timeout ?follow_redirects ?max_redirects ~method_ url =

     

       371
       371
       +
         (* Keep t in scope to preserve existential types *)

     

       407
       372
        
         make_request_internal t ?headers ?body ?auth ?timeout

     

       408
       373
        
           ?follow_redirects ?max_redirects ~method_ url

     

       409
       374
        
       

     

       410
       375
        
       (* Convenience methods *)

     

       411
       411
       -
       let get t ?headers ?auth ?timeout ?params url =

     

       376
       376
       +
       let get (T t) ?headers ?auth ?timeout ?params url =

     

       412
       377
        
         let url = match params with

     

       413
       378
        
           | Some p ->

     

       414
       379
        
               let uri = Uri.of_string url in

     
···

       416
       381
        
               Uri.to_string uri

     

       417
       382
        
           | None -> url

     

       418
       383
        
         in

     

       419
       419
       -
         request t ?headers ?auth ?timeout ~method_:`GET url

     

       384
       384
       +
         make_request_internal t ?headers ?auth ?timeout ~method_:`GET url

     

       420
       385
        
       

     

       421
       421
       -
       let post t ?headers ?body ?auth ?timeout url =

     

       422
       422
       -
         request t ?headers ?body ?auth ?timeout ~method_:`POST url

     

       386
       386
       +
       let post (T t) ?headers ?body ?auth ?timeout url =

     

       387
       387
       +
         make_request_internal t ?headers ?body ?auth ?timeout ~method_:`POST url

     

       423
       388
        
       

     

       424
       424
       -
       let put t ?headers ?body ?auth ?timeout url =

     

       425
       425
       -
         request t ?headers ?body ?auth ?timeout ~method_:`PUT url

     

       389
       389
       +
       let put (T t) ?headers ?body ?auth ?timeout url =

     

       390
       390
       +
         make_request_internal t ?headers ?body ?auth ?timeout ~method_:`PUT url

     

       426
       391
        
       

     

       427
       427
       -
       let patch t ?headers ?body ?auth ?timeout url =

     

       428
       428
       -
         request t ?headers ?body ?auth ?timeout ~method_:`PATCH url

     

       392
       392
       +
       let patch (T t) ?headers ?body ?auth ?timeout url =

     

       393
       393
       +
         make_request_internal t ?headers ?body ?auth ?timeout ~method_:`PATCH url

     

       429
       394
        
       

     

       430
       430
       -
       let delete t ?headers ?auth ?timeout url =

     

       431
       431
       -
         request t ?headers ?auth ?timeout ~method_:`DELETE url

     

       395
       395
       +
       let delete (T t) ?headers ?auth ?timeout url =

     

       396
       396
       +
         make_request_internal t ?headers ?auth ?timeout ~method_:`DELETE url

     

       432
       397
        
       

     

       433
       433
       -
       let head t ?headers ?auth ?timeout url =

     

       434
       434
       -
         request t ?headers ?auth ?timeout ~method_:`HEAD url

     

       398
       398
       +
       let head (T t) ?headers ?auth ?timeout url =

     

       399
       399
       +
         make_request_internal t ?headers ?auth ?timeout ~method_:`HEAD url

     

       435
       400
        
       

     

       436
       436
       -
       let options t ?headers ?auth ?timeout url =

     

       437
       437
       -
         request t ?headers ?auth ?timeout ~method_:`OPTIONS url

     

       401
       401
       +
       let options (T t) ?headers ?auth ?timeout url =

     

       402
       402
       +
         make_request_internal t ?headers ?auth ?timeout ~method_:`OPTIONS url

     

       438
       403
        
       

     

       439
       404
        
       (* Cmdliner integration module *)

     

       440
       405
        
       module Cmd = struct

+37 -29

stack/requests/lib/requests.mli

···

       132
       132
        
           Use Eio.Fiber.both or Eio.Fiber.all for concurrent execution.

     

       133
       133
        
       *)

     

       134
       134
        
       

     

       135
       135
       -
       type ('clock, 'net) t

     

       135
       135
       +
       type t

     

       136
       136
        
       (** A stateful HTTP client that maintains cookies, auth, configuration, and

     

       137
       137
       -
           connection pools across requests. *)

     

       137
       137
       +
           connection pools across requests. The internal clock and network types are

     

       138
       138
       +
           hidden from external users. *)

     

       138
       139
        
       

     

       139
       140
        
       (** {2 Creation and Configuration} *)

     

       140
       141
        
       

     

       141
       142
        
       val create :

     

       142
       143
        
         sw:Eio.Switch.t ->

     

       143
       143
       -
         ?http_pool:('clock Eio.Time.clock, 'net Eio.Net.t) Conpool.t ->

     

       144
       144
       -
         ?https_pool:('clock Eio.Time.clock, 'net Eio.Net.t) Conpool.t ->

     

       144
       144
       +
         ?http_pool:(([> float Eio.Time.clock_ty] as 'clock) Eio.Resource.t,

     

       145
       145
       +
                     ([> [> `Generic] Eio.Net.ty] as 'net) Eio.Resource.t) Conpool.t ->

     

       146
       146
       +
         ?https_pool:('clock Eio.Resource.t, 'net Eio.Resource.t) Conpool.t ->

     

       145
       147
        
         ?cookie_jar:Cookeio.jar ->

     

       146
       148
        
         ?default_headers:Headers.t ->

     

       147
       149
        
         ?auth:Auth.t ->

     
···

       155
       157
        
         ?connection_lifetime:float ->

     

       156
       158
        
         ?retry:Retry.config ->

     

       157
       159
        
         ?persist_cookies:bool ->

     

       158
       158
       -
         ?enable_cache:bool ->

     

       159
       160
        
         ?xdg:Xdge.t ->

     

       160
       161
        
         < clock: 'clock Eio.Resource.t; net: 'net Eio.Resource.t; fs: Eio.Fs.dir_ty Eio.Path.t; .. > ->

     

       161
       161
       -
         ('clock Eio.Resource.t, 'net Eio.Resource.t) t

     

       162
       162
       +
         t

     

       162
       163
        
       (** Create a new requests instance with persistent state and connection pooling.

     

       163
       164
        
           All resources are bound to the provided switch and will be cleaned up automatically.

     

       164
       165
        
       

     
···

       178
       179
        
           @param connection_lifetime Max lifetime of any pooled connection (default: 300s)

     

       179
       180
        
           @param retry Retry configuration for failed requests

     

       180
       181
        
           @param persist_cookies Whether to persist cookies to disk (default: false)

     

       181
       181
       -
           @param enable_cache Whether to enable HTTP caching (default: false)

     

       182
       182
       -
           @param xdg XDG directory context for cookies/cache (required if persist_cookies or enable_cache)

     

       182
       182
       +
           @param xdg XDG directory context for cookies (required if persist_cookies=true)

     

       183
       183
       +
       

     

       184
       184
       +
           {b Note:} HTTP caching has been disabled for simplicity. See CACHEIO.md for integration notes

     

       185
       185
       +
           if you need to restore caching functionality in the future.

     

       183
       186
        
       *)

     

       184
       187
        
       

     

       185
       188
        
       (** {2 Configuration Management} *)

     

       186
       189
        
       

     

       187
       187
       -
       val set_default_header : ('clock, 'net) t -> string -> string -> ('clock, 'net) t

     

       190
       190
       +
       val set_default_header : t -> string -> string -> t

     

       188
       191
        
       (** Add or update a default header. Returns a new session with the updated header.

     

       189
       192
        
           The original session's connection pools are shared. *)

     

       190
       193
        
       

     

       191
       191
       -
       val remove_default_header : ('clock, 'net) t -> string -> ('clock, 'net) t

     

       194
       194
       +
       val remove_default_header : t -> string -> t

     

       192
       195
        
       (** Remove a default header. Returns a new session without the header. *)

     

       193
       196
        
       

     

       194
       194
       -
       val set_auth : ('clock, 'net) t -> Auth.t -> ('clock, 'net) t

     

       197
       197
       +
       val set_auth : t -> Auth.t -> t

     

       195
       198
        
       (** Set default authentication. Returns a new session with auth configured. *)

     

       196
       199
        
       

     

       197
       197
       -
       val clear_auth : ('clock, 'net) t -> ('clock, 'net) t

     

       200
       200
       +
       val clear_auth : t -> t

     

       198
       201
        
       (** Clear authentication. Returns a new session without auth. *)

     

       199
       202
        
       

     

       200
       200
       -
       val set_timeout : ('clock, 'net) t -> Timeout.t -> ('clock, 'net) t

     

       203
       203
       +
       val set_timeout : t -> Timeout.t -> t

     

       201
       204
        
       (** Set default timeout. Returns a new session with the timeout configured. *)

     

       202
       205
        
       

     

       203
       203
       -
       val set_retry : ('clock, 'net) t -> Retry.config -> ('clock, 'net) t

     

       206
       206
       +
       val set_retry : t -> Retry.config -> t

     

       204
       207
        
       (** Set retry configuration. Returns a new session with retry configured. *)

     

       205
       208
        
       

     

       206
       209
        
       (** {2 Request Methods}

     
···

       281
       284
        
       *)

     

       282
       285
        
       

     

       283
       286
        
       val request :

     

       284
       284
       -
         (_ Eio.Time.clock, _ Eio.Net.t) t ->

     

       287
       287
       +
         t ->

     

       285
       288
        
         ?headers:Headers.t ->

     

       286
       289
        
         ?body:Body.t ->

     

       287
       290
        
         ?auth:Auth.t ->

     
···

       294
       297
        
       (** Make a concurrent HTTP request *)

     

       295
       298
        
       

     

       296
       299
        
       val get :

     

       297
       297
       -
         (_ Eio.Time.clock, _ Eio.Net.t) t ->

     

       300
       300
       +
         t ->

     

       298
       301
        
         ?headers:Headers.t ->

     

       299
       302
        
         ?auth:Auth.t ->

     

       300
       303
        
         ?timeout:Timeout.t ->

     
···

       304
       307
        
       (** Concurrent GET request *)

     

       305
       308
        
       

     

       306
       309
        
       val post :

     

       307
       307
       -
         (_ Eio.Time.clock, _ Eio.Net.t) t ->

     

       310
       310
       +
         t ->

     

       308
       311
        
         ?headers:Headers.t ->

     

       309
       312
        
         ?body:Body.t ->

     

       310
       313
        
         ?auth:Auth.t ->

     
···

       314
       317
        
       (** Concurrent POST request *)

     

       315
       318
        
       

     

       316
       319
        
       val put :

     

       317
       317
       -
         (_ Eio.Time.clock, _ Eio.Net.t) t ->

     

       320
       320
       +
         t ->

     

       318
       321
        
         ?headers:Headers.t ->

     

       319
       322
        
         ?body:Body.t ->

     

       320
       323
        
         ?auth:Auth.t ->

     
···

       324
       327
        
       (** Concurrent PUT request *)

     

       325
       328
        
       

     

       326
       329
        
       val patch :

     

       327
       327
       -
         (_ Eio.Time.clock, _ Eio.Net.t) t ->

     

       330
       330
       +
         t ->

     

       328
       331
        
         ?headers:Headers.t ->

     

       329
       332
        
         ?body:Body.t ->

     

       330
       333
        
         ?auth:Auth.t ->

     
···

       334
       337
        
       (** Concurrent PATCH request *)

     

       335
       338
        
       

     

       336
       339
        
       val delete :

     

       337
       337
       -
         (_ Eio.Time.clock, _ Eio.Net.t) t ->

     

       340
       340
       +
         t ->

     

       338
       341
        
         ?headers:Headers.t ->

     

       339
       342
        
         ?auth:Auth.t ->

     

       340
       343
        
         ?timeout:Timeout.t ->

     
···

       343
       346
        
       (** Concurrent DELETE request *)

     

       344
       347
        
       

     

       345
       348
        
       val head :

     

       346
       346
       -
         (_ Eio.Time.clock, _ Eio.Net.t) t ->

     

       349
       349
       +
         t ->

     

       347
       350
        
         ?headers:Headers.t ->

     

       348
       351
        
         ?auth:Auth.t ->

     

       349
       352
        
         ?timeout:Timeout.t ->

     
···

       352
       355
        
       (** Concurrent HEAD request *)

     

       353
       356
        
       

     

       354
       357
        
       val options :

     

       355
       355
       -
         (_ Eio.Time.clock, _ Eio.Net.t) t ->

     

       358
       358
       +
         t ->

     

       356
       359
        
         ?headers:Headers.t ->

     

       357
       360
        
         ?auth:Auth.t ->

     

       358
       361
        
         ?timeout:Timeout.t ->

     
···

       362
       365
        
       

     

       363
       366
        
       (** {2 Cookie Management} *)

     

       364
       367
        
       

     

       365
       365
       -
       val cookies : ('clock, 'net) t -> Cookeio.jar

     

       368
       368
       +
       val cookies : t -> Cookeio.jar

     

       366
       369
        
       (** Get the cookie jar for direct manipulation *)

     

       367
       370
        
       

     

       368
       368
       -
       val clear_cookies : ('clock, 'net) t -> unit

     

       371
       371
       +
       val clear_cookies : t -> unit

     

       369
       372
        
       (** Clear all cookies *)

     

       370
       373
        
       

     

       371
       374
        
       (** {1 Cmdliner Integration} *)

     
···

       390
       393
        
           user_agent : string option;  (** User-Agent header *)

     

       391
       394
        
         }

     

       392
       395
        
       

     

       393
       393
       -
         val create : config -> < clock: ([> float Eio.Time.clock_ty ] as 'clock) Eio.Resource.t; net: ([> [>`Generic] Eio.Net.ty ] as 'net) Eio.Resource.t; fs: Eio.Fs.dir_ty Eio.Path.t; .. > -> Eio.Switch.t -> ('clock Eio.Resource.t, 'net Eio.Resource.t) t

     

       396
       396
       +
         val create : config ->

     

       397
       397
       +
           < clock: [> float Eio.Time.clock_ty] Eio.Resource.t;

     

       398
       398
       +
             net: [> [> `Generic] Eio.Net.ty] Eio.Resource.t;

     

       399
       399
       +
             fs: Eio.Fs.dir_ty Eio.Path.t; .. > ->

     

       400
       400
       +
           Eio.Switch.t -> t

     

       394
       401
        
         (** [create config env sw] creates a requests instance from command-line configuration *)

     

       395
       402
        
       

     

       396
       403
        
         (** {2 Individual Terms} *)

     
···

       453
       460
        
               Cmd.eval cmd

     

       454
       461
        
             ]} *)

     

       455
       462
        
       

     

       456
       456
       -
         val requests_term : string -> < clock: ([> float Eio.Time.clock_ty ] as 'clock) Eio.Resource.t; net: ([> [>`Generic] Eio.Net.ty ] as 'net) Eio.Resource.t; fs: Eio.Fs.dir_ty Eio.Path.t; .. > -> Eio.Switch.t -> ('clock Eio.Resource.t, 'net Eio.Resource.t) t Cmdliner.Term.t

     

       463
       463
       +
         val requests_term : string ->

     

       464
       464
       +
           < clock: [> float Eio.Time.clock_ty] Eio.Resource.t;

     

       465
       465
       +
             net: [> [> `Generic] Eio.Net.ty] Eio.Resource.t;

     

       466
       466
       +
             fs: Eio.Fs.dir_ty Eio.Path.t; .. > ->

     

       467
       467
       +
           Eio.Switch.t -> t Cmdliner.Term.t

     

       457
       468
        
         (** [requests_term app_name env sw] creates a term that directly produces a requests instance.

     

       458
       469
        
       

     

       459
       470
        
             This is a convenience function that combines configuration parsing

     
···

       569
       580
        
       

     

       570
       581
        
       (** Timeout configuration for requests *)

     

       571
       582
        
       module Timeout = Timeout

     

       572
       572
       -
       

     

       573
       573
       -
       (** HTTP caching with cache control and range request support *)

     

       574
       574
       -
       module Cache = Cache

     

       575
       583
        
       

     

       576
       584
        
       (** {2 Logging} *)

     

       577
       585

+12 -12

stack/requests_json_api/lib/requests_json_api.mli

···

       26
       26
        
       

     

       27
       27
        
       (** {1 JSON Request Helpers} *)

     

       28
       28
        
       

     

       29
       29
       -
       val get_json_exn : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string -> 'a Jsont.t -> 'a

     

       29
       29
       +
       val get_json_exn : Requests.t -> string -> 'a Jsont.t -> 'a

     

       30
       30
        
       (** [get_json_exn session url decoder] makes a GET request, checks status is 2xx,

     

       31
       31
        
           reads and parses JSON body using the provided Jsont decoder.

     

       32
       32
        
           Raises [Failure] on any error (HTTP, network, or JSON parse). *)

     

       33
       33
        
       

     

       34
       34
       -
       val get_json : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string -> 'a Jsont.t ->

     

       34
       34
       +
       val get_json : Requests.t -> string -> 'a Jsont.t ->

     

       35
       35
        
         ('a, [> `Http of int * string | `Json_error of string]) result

     

       36
       36
        
       (** Like [get_json_exn] but returns [Result] instead of raising exceptions.

     

       37
       37
        
           Returns [Ok parsed_value] on success, or [Error] with details on failure. *)

     

       38
       38
        
       

     

       39
       39
       -
       val post_json : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string -> 'a Jsont.t -> 'a -> Requests.Response.t

     

       39
       39
       +
       val post_json : Requests.t -> string -> 'a Jsont.t -> 'a -> Requests.Response.t

     

       40
       40
        
       (** [post_json session url codec value] encodes [value] using the Jsont codec and POSTs it to the URL.

     

       41
       41
        
           Returns the raw response for custom handling. *)

     

       42
       42
        
       

     

       43
       43
       -
       val post_json_exn : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string -> 'a Jsont.t -> 'a -> string

     

       43
       43
       +
       val post_json_exn : Requests.t -> string -> 'a Jsont.t -> 'a -> string

     

       44
       44
        
       (** Like [post_json] but checks status is 2xx and returns the response body as a string.

     

       45
       45
        
           Raises [Failure] on non-2xx status. *)

     

       46
       46
        
       

     

       47
       47
       -
       val post_json_result : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string -> 'a Jsont.t -> 'a ->

     

       47
       47
       +
       val post_json_result : Requests.t -> string -> 'a Jsont.t -> 'a ->

     

       48
       48
        
         (string, int * string) result

     

       49
       49
        
       (** Like [post_json_exn] but returns [Result] instead of raising.

     

       50
       50
        
           [Ok body] on 2xx status, [Error (status, body)] otherwise. *)

     

       51
       51
        
       

     

       52
       52
       -
       val post_json_decode_exn : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string ->

     

       52
       52
       +
       val post_json_decode_exn : Requests.t -> string ->

     

       53
       53
        
         req:'a Jsont.t -> 'a -> resp:'b Jsont.t -> 'b

     

       54
       54
        
       (** [post_json_decode_exn session url ~req req_value ~resp] encodes [req_value] using the [req] codec,

     

       55
       55
        
           POSTs it to the URL, checks status is 2xx, and decodes the response using the [resp] codec.

     

       56
       56
        
           Raises [Failure] on any error. *)

     

       57
       57
        
       

     

       58
       58
       -
       val post_json_decode : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string ->

     

       58
       58
       +
       val post_json_decode : Requests.t -> string ->

     

       59
       59
        
         req:'a Jsont.t -> 'a -> resp:'b Jsont.t ->

     

       60
       60
        
         ('b, [> `Http of int * string | `Json_error of string]) result

     

       61
       61
        
       (** Like [post_json_decode_exn] but returns [Result] instead of raising. *)

     

       62
       62
        
       

     

       63
       63
       -
       val put_json_exn : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string -> 'a Jsont.t -> 'a -> string

     

       63
       63
       +
       val put_json_exn : Requests.t -> string -> 'a Jsont.t -> 'a -> string

     

       64
       64
        
       (** [put_json_exn session url codec value] encodes [value] and PUTs it to the URL.

     

       65
       65
        
           Returns response body. Raises [Failure] on non-2xx status. *)

     

       66
       66
        
       

     

       67
       67
       -
       val put_json_decode_exn : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string ->

     

       67
       67
       +
       val put_json_decode_exn : Requests.t -> string ->

     

       68
       68
        
         req:'a Jsont.t -> 'a -> resp:'b Jsont.t -> 'b

     

       69
       69
        
       (** Like [post_json_decode_exn] but uses PUT method. *)

     

       70
       70
        
       

     

       71
       71
       -
       val patch_json_exn : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string -> 'a Jsont.t -> 'a -> string

     

       71
       71
       +
       val patch_json_exn : Requests.t -> string -> 'a Jsont.t -> 'a -> string

     

       72
       72
        
       (** [patch_json_exn session url codec value] encodes [value] and PATCHes it to the URL.

     

       73
       73
        
           Returns response body. Raises [Failure] on non-2xx status. *)

     

       74
       74
        
       

     

       75
       75
       -
       val delete_json_exn : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string -> string

     

       75
       75
       +
       val delete_json_exn : Requests.t -> string -> string

     

       76
       76
        
       (** [delete_json_exn session url] makes a DELETE request.

     

       77
       77
        
           Returns response body. Raises [Failure] on non-2xx status. *)

     

       78
       78
        
       

     
···

       91
       91
        
       (** [read_body response] reads the entire response body as a string.

     

       92
       92
        
           Equivalent to [Requests.Response.body response |> Eio.Flow.read_all] *)

     

       93
       93
        
       

     

       94
       94
       -
       val get_result : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string -> (string, int * string) result

     

       94
       94
       +
       val get_result : Requests.t -> string -> (string, int * string) result

     

       95
       95
        
       (** [get_result session url] makes a GET request and returns the result.

     

       96
       96
        
           Returns [Ok body] on 2xx status, [Error (status, body)] otherwise. *)

     

       97
       97

+1 -2

stack/river/lib/client.ml

···

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

     

       22
       22
        
       

     

       23
       23
        
       type t = {

     

       24
       24
       -
         session : (float Eio.Time.clock_ty Eio.Resource.t,

     

       25
       25
       -
                    [`Generic | `Unix] Eio.Net.ty Eio.Resource.t) Requests.t;

     

       24
       24
       +
         session : Requests.t;

     

       26
       25
        
       }

     

       27
       26
        
       

     

       28
       27
        
       let create ~sw (env : _ ) =

+1 -2

stack/river/lib/client.mli

···

       54
       54
        
       (** [session t] returns the underlying Requests session.

     

       55
       55
        
       

     

       56
       56
        
           This is used internally by River's HTTP functions. *)

     

       57
       57
       -
       val session : t -> (float Eio.Time.clock_ty Eio.Resource.t,

     

       58
       58
       -
                           [`Generic | `Unix] Eio.Net.ty Eio.Resource.t) Requests.t

     

       57
       57
       +
       val session : t -> Requests.t

+3 -6

stack/typesense-client/typesense_client.ml

···

       6
       6
        
         api_key : string;

     

       7
       7
        
       }

     

       8
       8
        
       

     

       9
       9
       -
       (** Internal polymorphic type for the client *)

     

       10
       10
       -
       type 'net t_internal = {

     

       9
       9
       +
       (** Client type *)

     

       10
       10
       +
       type t = {

     

       11
       11
        
         config: config;

     

       12
       12
       -
         requests_session: (float Eio.Time.clock_ty Eio.Resource.t, 'net Eio.Net.ty Eio.Resource.t) Requests.t;

     

       12
       12
       +
         requests_session: Requests.t;

     

       13
       13
        
       }

     

       14
       14
       -
       

     

       15
       15
       -
       (** Public client type *)

     

       16
       16
       -
       type t = [`Generic | `Unix] t_internal

     

       17
       14
        
       

     

       18
       15
        
       (** Create a new Typesense client *)

     

       19
       16
        
       let create ~requests_session ~config : t =

+1 -1

stack/typesense-client/typesense_client.mli

···

       14
       14
        
           @param config Configuration with endpoint and API key

     

       15
       15
        
           @return A client instance *)

     

       16
       16
        
       val create :

     

       17
       17
       -
         requests_session:(float Eio.Time.clock_ty Eio.Resource.t, [`Generic | `Unix] Eio.Net.ty Eio.Resource.t) Requests.t ->

     

       17
       17
       +
         requests_session:Requests.t ->

     

       18
       18
        
         config:config ->

     

       19
       19
        
         t

     

       20
       20

+2 -2

stack/zotero-translation/zotero_translation.ml

···

       97
       97
        
         | true -> Uri.of_string (base_uri ^ "import")

     

       98
       98
        
         | false -> Uri.of_string (base_uri ^ "/import")

     

       99
       99
        
       

     

       100
       100
       -
       type ('clock, 'net) t = {

     

       100
       100
       +
       type t = {

     

       101
       101
        
         base_uri: string;

     

       102
       102
       -
         requests_session: ('clock, 'net) Requests.t;

     

       102
       102
       +
         requests_session: Requests.t;

     

       103
       103
        
       }

     

       104
       104
        
       

     

       105
       105
        
       let create ~requests_session base_uri =

+8 -8

stack/zotero-translation/zotero_translation.mli

···

       1
       1
        
       (** {1 Interface to the Zotero Translation Server} *)

     

       2
       2
        
       

     

       3
       3
       -
       type ('clock, 'net) t

     

       3
       3
       +
       type t

     

       4
       4
        
       

     

       5
       5
        
       type format =

     

       6
       6
        
         | Bibtex

     
···

       28
       28
        
           @param requests_session Shared Requests session for connection pooling.

     

       29
       29
        
           @param base_uri Base URI of the Zotero translation server (e.g., "http://localhost:1969"). *)

     

       30
       30
        
       val create :

     

       31
       31
       -
         requests_session:('clock Eio.Resource.t, 'net Eio.Resource.t) Requests.t ->

     

       32
       32
       -
         string -> ('clock Eio.Resource.t, 'net Eio.Resource.t) t

     

       31
       31
       +
         requests_session:Requests.t ->

     

       32
       32
       +
         string -> t

     

       33
       33
        
       

     

       34
       34
       -
       val resolve_doi: ([> float Eio.Time.clock_ty ] Eio.Resource.t, [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t) t ->

     

       34
       34
       +
       val resolve_doi: t ->

     

       35
       35
        
         string -> (Jsont.json, [>`Msg of string]) result

     

       36
       36
        
       

     

       37
       37
       -
       val resolve_url: ([> float Eio.Time.clock_ty ] Eio.Resource.t, [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t) t ->

     

       37
       37
       +
       val resolve_url: t ->

     

       38
       38
        
         string -> (Jsont.json, [>`Msg of string]) result

     

       39
       39
        
       

     

       40
       40
       -
       val search_id: ([> float Eio.Time.clock_ty ] Eio.Resource.t, [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t) t ->

     

       40
       40
       +
       val search_id: t ->

     

       41
       41
        
         string -> (Jsont.json, [>`Msg of string]) result

     

       42
       42
        
       

     

       43
       43
       -
       val export: ([> float Eio.Time.clock_ty ] Eio.Resource.t, [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t) t ->

     

       43
       43
       +
       val export: t ->

     

       44
       44
        
         format -> Jsont.json -> (string, [>`Msg of string]) result

     

       45
       45
        
       

     

       46
       46
       -
       val json_of_doi : ([> float Eio.Time.clock_ty ] Eio.Resource.t, [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t) t ->

     

       46
       46
       +
       val json_of_doi : t ->

     

       47
       47
        
         slug:string -> string -> Jsont.object'

+1 -2

stack/zulip/lib/zulip/lib/client.ml

···

       4
       4
        
       

     

       5
       5
        
       type t = {

     

       6
       6
        
         auth : Auth.t;

     

       7
       7
       -
         session : (float Eio.Time.clock_ty Eio.Resource.t,

     

       8
       8
       -
                    [`Generic | `Unix] Eio.Net.ty Eio.Resource.t) Requests.t;

     

       7
       7
       +
         session : Requests.t;

     

       9
       8
        
       }

     

       10
       9
        
       

     

       11
       10
        
       let create ~sw env auth =

+16 -19

stack/zulip/lib/zulip/lib/event_queue.ml

···

       52
       52
        
       module Events_response = struct

     

       53
       53
        
         type t = { events : Event.t list }

     

       54
       54
        
       

     

       55
       55
       -
         (* Custom codec that handles Event.t which has its own of_json *)

     

       56
       55
        
         let codec =

     

       57
       57
       -
           let kind = "EventsResponse" in

     

       58
       58
       -
           let of_string s =

     

       59
       59
       -
             match Jsont_bytesrw.decode_string' Jsont.json s with

     

       60
       60
       -
             | Error e -> Error (Jsont.Error.to_string e)

     

       61
       61
       -
             | Ok (Jsont.Object (fields, _)) ->

     

       56
       56
       +
           (* Use keep_unknown pattern to handle the whole object and extract events manually *)

     

       57
       57
       +
           let make raw_json =

     

       58
       58
       +
             match raw_json with

     

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

     

       62
       60
        
                 let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in

     

       63
       61
        
                 (match List.assoc_opt "events" assoc with

     

       64
       64
       -
                  | Some (Jsont.Array (event_list, _)) ->

     

       65
       65
       -
                      let events = List.fold_left (fun acc event_json ->

     

       66
       66
       -
                        match Event.of_json event_json with

     

       62
       62
       +
                  | Some (Jsont.Array (items, _)) ->

     

       63
       63
       +
                      (* Parse each event, skipping failures *)

     

       64
       64
       +
                      let events = List.fold_left (fun acc item ->

     

       65
       65
       +
                        match Event.of_json item with

     

       67
       66
        
                        | Ok event -> event :: acc

     

       68
       67
        
                        | Error _ -> acc

     

       69
       69
       -
                      ) [] event_list in

     

       70
       70
       -
                      Ok { events = List.rev events }

     

       71
       71
       -
                  | None -> Ok { events = [] }

     

       72
       72
       -
                  | _ -> Error "events field is not an array")

     

       73
       73
       -
             | Ok _ -> Error "Expected JSON object"

     

       68
       68
       +
                      ) [] items |> List.rev in

     

       69
       69
       +
                      { events }

     

       70
       70
       +
                  | Some _ -> { events = [] }

     

       71
       71
       +
                  | None -> { events = [] })

     

       72
       72
       +
             | _ -> { events = [] }

     

       74
       73
        
           in

     

       75
       75
       -
           let enc _t =

     

       76
       76
       -
             (* Not used for responses, but required by codec *)

     

       77
       77
       -
             Fmt.str "{\"events\": []}"

     

       78
       78
       -
           in

     

       79
       79
       -
           Jsont.of_of_string ~kind of_string ~enc

     

       74
       74
       +
           Jsont.Object.map ~kind:"EventsResponse" make

     

       75
       75
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun _ -> Jsont.Object ([], Jsont.Meta.none))

     

       76
       76
       +
           |> Jsont.Object.finish

     

       80
       77
        
       end

     

       81
       78
        
       

     

       82
       79
        
       let get_events t client ?last_event_id () =

+18 -46

stack/zulip/lib/zulip_bot/lib/bot_storage.ml

···

       11
       11
        
       

     

       12
       12
        
       (** {1 JSON Codecs for Bot Storage} *)

     

       13
       13
        
       

     

       14
       14
       +
       (* String map for storage values *)

     

       15
       15
       +
       module String_map = Map.Make (String)

     

       16
       16
       +
       

     

       14
       17
        
       (* Storage response type - {"storage": {...}} *)

     

       15
       18
        
       type storage_response = {

     

       16
       16
       -
         storage : (string * string) list;

     

       19
       19
       +
         storage : string String_map.t;

     

       17
       20
        
         unknown : Jsont.json;  (** Unknown/extra JSON fields preserved during parsing *)

     

       18
       21
        
       }

     

       19
       22
        
       

     

       20
       20
       -
       (* Custom codec for storage_response that handles the dictionary *)

     

       23
       23
       +
       (* Codec for storage response using Jsont.Object with keep_unknown *)

     

       21
       24
        
       let storage_response_jsont : storage_response Jsont.t =

     

       22
       22
       -
         let of_string s =

     

       23
       23
       -
           match Jsont_bytesrw.decode_string' Jsont.json s with

     

       24
       24
       -
           | Error _ -> Error "Failed to decode JSON"

     

       25
       25
       -
           | Ok json ->

     

       26
       26
       -
               match json with

     

       27
       27
       -
               | Jsont.Object (fields, _) ->

     

       28
       28
       -
                   let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in

     

       29
       29
       -
                   (match List.assoc_opt "storage" assoc with

     

       30
       30
       -
                    | Some (Jsont.Object (storage_fields, _)) ->

     

       31
       31
       -
                        let storage = List.filter_map (fun ((k, _), v) ->

     

       32
       32
       -
                          match v with

     

       33
       33
       -
                          | Jsont.String (s, _) -> Some (k, s)

     

       34
       34
       -
                          | _ -> None

     

       35
       35
       -
                        ) storage_fields in

     

       36
       36
       -
                        (* Keep unknown fields *)

     

       37
       37
       -
                        let unknown_fields = List.filter (fun (k, _) -> k <> "storage") assoc in

     

       38
       38
       -
                        let unknown_mems = List.map (fun (k, v) -> ((k, Jsont.Meta.none), v)) unknown_fields in

     

       39
       39
       -
                        let unknown = Jsont.Object (unknown_mems, Jsont.Meta.none) in

     

       40
       40
       -
                        Ok { storage; unknown }

     

       41
       41
       -
                    | Some _ -> Error "Expected 'storage' field to be an object"

     

       42
       42
       -
                    | None -> Ok { storage = []; unknown = Jsont.Object ([], Jsont.Meta.none) })

     

       43
       43
       -
               | _ -> Error "Expected JSON object for storage response"

     

       44
       44
       -
         in

     

       45
       45
       -
         let to_string { storage; unknown } =

     

       46
       46
       -
           (* Create storage object *)

     

       47
       47
       -
           let storage_fields = List.map (fun (k, v) ->

     

       48
       48
       -
             ((k, Jsont.Meta.none), Jsont.String (v, Jsont.Meta.none))

     

       49
       49
       -
           ) storage in

     

       50
       50
       -
           let storage_obj = Jsont.Object (storage_fields, Jsont.Meta.none) in

     

       51
       51
       -
       

     

       52
       52
       -
           (* Merge with unknown fields *)

     

       53
       53
       -
           let storage_mem = (("storage", Jsont.Meta.none), storage_obj) in

     

       54
       54
       -
           let unknown_mems = match unknown with

     

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

     

       56
       56
       -
             | _ -> []

     

       57
       57
       -
           in

     

       58
       58
       -
           let json = Jsont.Object (storage_mem :: unknown_mems, Jsont.Meta.none) in

     

       59
       59
       -
           match Jsont_bytesrw.encode_string' Jsont.json json with

     

       60
       60
       -
           | Ok s -> s

     

       61
       61
       -
           | Error e -> failwith ("Failed to encode storage response: " ^ Jsont.Error.to_string e)

     

       25
       25
       +
         let make storage unknown = { storage; unknown } in

     

       26
       26
       +
         let storage_map_jsont =

     

       27
       27
       +
           Jsont.Object.map ~kind:"StorageMap" Fun.id

     

       28
       28
       +
           |> Jsont.Object.keep_unknown (Jsont.Object.Mems.string_map Jsont.string) ~enc:Fun.id

     

       29
       29
       +
           |> Jsont.Object.finish

     

       62
       30
        
         in

     

       63
       63
       -
         Jsont.of_of_string ~kind:"StorageResponse" of_string ~enc:to_string

     

       31
       31
       +
         Jsont.Object.map ~kind:"StorageResponse" make

     

       32
       32
       +
         |> Jsont.Object.mem "storage" storage_map_jsont ~enc:(fun r -> r.storage)

     

       33
       33
       +
           ~dec_absent:String_map.empty

     

       34
       34
       +
         |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       35
       35
       +
         |> Jsont.Object.finish

     

       64
       36
        
       

     

       65
       37
        
       let create client ~bot_email =

     

       66
       38
        
         Log.info (fun m -> m "Creating bot storage for %s" bot_email);

     
···

       74
       46
        
         | Ok json ->

     

       75
       47
        
             (match Zulip.Encode.from_json storage_response_jsont json with

     

       76
       48
        
              | Ok response ->

     

       77
       77
       -
                  List.iter (fun (k, v) ->

     

       49
       49
       +
                  String_map.iter (fun k v ->

     

       78
       50
        
                    Log.debug (fun m -> m "Loaded key from server: %s" k);

     

       79
       51
        
                    Hashtbl.add cache k v

     

       80
       52
        
                  ) response.storage

     
···

       121
       93
        
             | Ok json ->

     

       122
       94
        
                 (match Zulip.Encode.from_json storage_response_jsont json with

     

       123
       95
        
                  | Ok response ->

     

       124
       124
       -
                      (match List.assoc_opt key response.storage with

     

       96
       96
       +
                      (match String_map.find_opt key response.storage with

     

       125
       97
        
                       | Some value ->

     

       126
       98
        
                           (* Cache the value *)

     

       127
       99
        
                           Log.debug (fun m -> m "Retrieved key from API: %s" key);

     
···

       195
       167
        
         | Ok json ->

     

       196
       168
        
             (match Zulip.Encode.from_json storage_response_jsont json with

     

       197
       169
        
              | Ok response ->

     

       198
       198
       -
                  let api_keys = List.map fst response.storage in

     

       170
       170
       +
                  let api_keys = String_map.fold (fun k _ acc -> k :: acc) response.storage [] in

     

       199
       171
        
                  (* Merge with cache keys *)

     

       200
       172
        
                  let cache_keys = Hashtbl.fold (fun k _ acc -> k :: acc) t.cache [] in

     

       201
       173
        
                  let all_keys = List.sort_uniq String.compare (api_keys @ cache_keys) in

+38 -123

stack/zulip/lib/zulip_bot/lib/message.ml

···

       20
       20
        
       

     

       21
       21
        
         (* Jsont codec for User - handles both user_id and id fields *)

     

       22
       22
        
         let jsont : t Jsont.t =

     

       23
       23
       -
           let of_string s =

     

       24
       24
       -
             match Jsont_bytesrw.decode_string' Jsont.json s with

     

       25
       25
       -
             | Error _ -> Error "Failed to decode JSON"

     

       26
       26
       -
             | Ok json ->

     

       27
       27
       -
                 match json with

     

       28
       28
       -
                 | Jsont.Object (fields, _) ->

     

       29
       29
       -
                     let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in

     

       30
       30
       -
                     let user_id =

     

       31
       31
       -
                       match List.assoc_opt "user_id" assoc with

     

       32
       32
       -
                       | Some (Jsont.Number (f, _)) -> Some (int_of_float f)

     

       33
       33
       -
                       | _ ->

     

       34
       34
       -
                           match List.assoc_opt "id" assoc with

     

       35
       35
       -
                           | Some (Jsont.Number (f, _)) -> Some (int_of_float f)

     

       36
       36
       -
                           | _ -> None

     

       37
       37
       -
                     in

     

       38
       38
       -
                     let email =

     

       39
       39
       -
                       match List.assoc_opt "email" assoc with

     

       40
       40
       -
                       | Some (Jsont.String (s, _)) -> Some s

     

       41
       41
       -
                       | _ -> None

     

       42
       42
       -
                     in

     

       43
       43
       -
                     let full_name =

     

       44
       44
       -
                       match List.assoc_opt "full_name" assoc with

     

       45
       45
       -
                       | Some (Jsont.String (s, _)) -> Some s

     

       46
       46
       -
                       | _ -> None

     

       47
       47
       -
                     in

     

       48
       48
       -
                     let short_name =

     

       49
       49
       -
                       match List.assoc_opt "short_name" assoc with

     

       50
       50
       -
                       | Some (Jsont.String (s, _)) -> Some s

     

       51
       51
       -
                       | _ -> None

     

       52
       52
       -
                     in

     

       53
       53
       -
                     (match (user_id, email, full_name) with

     

       54
       54
       -
                      | (Some user_id, Some email, Some full_name) ->

     

       55
       55
       -
                          (* Keep unknown fields *)

     

       56
       56
       -
                          let unknown_fields = List.filter (fun (k, _) ->

     

       57
       57
       -
                            k <> "user_id" && k <> "id" && k <> "email" && k <> "full_name" && k <> "short_name"

     

       58
       58
       -
                          ) assoc in

     

       59
       59
       -
                          let unknown_mems = List.map (fun (k, v) -> ((k, Jsont.Meta.none), v)) unknown_fields in

     

       60
       60
       -
                          let unknown = Jsont.Object (unknown_mems, Jsont.Meta.none) in

     

       61
       61
       -
                          Ok { user_id; email; full_name; short_name; unknown }

     

       62
       62
       -
                      | _ -> Error "Missing required user fields")

     

       63
       63
       -
                 | _ -> Error "Expected JSON object for user"

     

       23
       23
       +
           let make email full_name short_name unknown =

     

       24
       24
       +
             (* user_id will be extracted in a custom way from the object *)

     

       25
       25
       +
             fun user_id_opt id_opt ->

     

       26
       26
       +
               let user_id = match user_id_opt, id_opt with

     

       27
       27
       +
                 | Some uid, _ -> uid

     

       28
       28
       +
                 | None, Some id -> id

     

       29
       29
       +
                 | None, None -> Jsont.Error.msgf Jsont.Meta.none "Missing user_id or id field"

     

       30
       30
       +
               in

     

       31
       31
       +
               { user_id; email; full_name; short_name; unknown }

     

       64
       32
        
           in

     

       65
       65
       -
           let to_string { user_id; email; full_name; short_name; unknown } =

     

       66
       66
       -
             let fields = [

     

       67
       67
       -
               (("user_id", Jsont.Meta.none), Jsont.Number (float_of_int user_id, Jsont.Meta.none));

     

       68
       68
       -
               (("email", Jsont.Meta.none), Jsont.String (email, Jsont.Meta.none));

     

       69
       69
       -
               (("full_name", Jsont.Meta.none), Jsont.String (full_name, Jsont.Meta.none));

     

       70
       70
       -
             ] in

     

       71
       71
       -
             let fields = match short_name with

     

       72
       72
       -
               | Some sn -> (("short_name", Jsont.Meta.none), Jsont.String (sn, Jsont.Meta.none)) :: fields

     

       73
       73
       -
               | None -> fields

     

       74
       74
       -
             in

     

       75
       75
       -
             let unknown_mems = match unknown with

     

       76
       76
       -
               | Jsont.Object (mems, _) -> mems

     

       77
       77
       -
               | _ -> []

     

       78
       78
       -
             in

     

       79
       79
       -
             let json = Jsont.Object (fields @ unknown_mems, Jsont.Meta.none) in

     

       80
       80
       -
             match Jsont_bytesrw.encode_string' Jsont.json json with

     

       81
       81
       -
             | Ok s -> s

     

       82
       82
       -
             | Error e -> failwith ("Failed to encode user: " ^ Jsont.Error.to_string e)

     

       83
       83
       -
           in

     

       84
       84
       -
           Jsont.of_of_string ~kind:"User" of_string ~enc:to_string

     

       33
       33
       +
           Jsont.Object.map ~kind:"User" make

     

       34
       34
       +
           |> Jsont.Object.mem "email" Jsont.string ~enc:email

     

       35
       35
       +
           |> Jsont.Object.mem "full_name" Jsont.string ~enc:full_name

     

       36
       36
       +
           |> Jsont.Object.opt_mem "short_name" Jsont.string ~enc:short_name

     

       37
       37
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun t -> t.unknown)

     

       38
       38
       +
           |> Jsont.Object.opt_mem "user_id" Jsont.int ~enc:(fun t -> Some t.user_id)

     

       39
       39
       +
           |> Jsont.Object.opt_mem "id" Jsont.int ~enc:(fun _ -> None)

     

       40
       40
       +
           |> Jsont.Object.finish

     

       85
       41
        
       

     

       86
       42
        
         let of_json (json : Zulip.json) : (t, Zulip.zerror) result =

     

       87
       43
        
           match Zulip.Encode.from_json jsont json with

     
···

       106
       62
        
       

     

       107
       63
        
         (* Jsont codec for Reaction - handles user_id in different locations *)

     

       108
       64
        
         let jsont : t Jsont.t =

     

       109
       109
       -
           let of_string s =

     

       110
       110
       -
             match Jsont_bytesrw.decode_string' Jsont.json s with

     

       111
       111
       -
             | Error _ -> Error "Failed to decode JSON"

     

       112
       112
       -
             | Ok json ->

     

       113
       113
       -
                 match json with

     

       114
       114
       -
                 | Jsont.Object (fields, _) ->

     

       115
       115
       -
                     let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in

     

       116
       116
       -
                     let emoji_name =

     

       117
       117
       -
                       match List.assoc_opt "emoji_name" assoc with

     

       118
       118
       -
                       | Some (Jsont.String (s, _)) -> Some s

     

       119
       119
       -
                       | _ -> None

     

       120
       120
       -
                     in

     

       121
       121
       -
                     let emoji_code =

     

       122
       122
       -
                       match List.assoc_opt "emoji_code" assoc with

     

       123
       123
       -
                       | Some (Jsont.String (s, _)) -> Some s

     

       124
       124
       -
                       | _ -> None

     

       125
       125
       -
                     in

     

       126
       126
       -
                     let reaction_type =

     

       127
       127
       -
                       match List.assoc_opt "reaction_type" assoc with

     

       128
       128
       -
                       | Some (Jsont.String (s, _)) -> Some s

     

       129
       129
       -
                       | _ -> None

     

       130
       130
       -
                     in

     

       131
       131
       -
                     (* user_id can be either directly in the object or nested in a "user" field *)

     

       132
       132
       -
                     let user_id =

     

       133
       133
       -
                       match List.assoc_opt "user_id" assoc with

     

       134
       134
       -
                       | Some (Jsont.Number (f, _)) -> Some (int_of_float f)

     

       135
       135
       -
                       | _ ->

     

       136
       136
       -
                           match List.assoc_opt "user" assoc with

     

       137
       137
       -
                           | Some (Jsont.Object (user_fields, _)) ->

     

       138
       138
       -
                               let user_assoc = List.map (fun ((k, _), v) -> (k, v)) user_fields in

     

       139
       139
       -
                               (match List.assoc_opt "user_id" user_assoc with

     

       140
       140
       -
                                | Some (Jsont.Number (f, _)) -> Some (int_of_float f)

     

       141
       141
       -
                                | _ -> None)

     

       142
       142
       -
                           | _ -> None

     

       143
       143
       -
                     in

     

       144
       144
       -
                     (match (emoji_name, emoji_code, reaction_type, user_id) with

     

       145
       145
       -
                      | (Some emoji_name, Some emoji_code, Some reaction_type, Some user_id) ->

     

       146
       146
       -
                          (* Keep unknown fields *)

     

       147
       147
       -
                          let unknown_fields = List.filter (fun (k, _) ->

     

       148
       148
       -
                            k <> "emoji_name" && k <> "emoji_code" && k <> "reaction_type" && k <> "user_id" && k <> "user"

     

       149
       149
       -
                          ) assoc in

     

       150
       150
       -
                          let unknown_mems = List.map (fun (k, v) -> ((k, Jsont.Meta.none), v)) unknown_fields in

     

       151
       151
       -
                          let unknown = Jsont.Object (unknown_mems, Jsont.Meta.none) in

     

       152
       152
       -
                          Ok { emoji_name; emoji_code; reaction_type; user_id; unknown }

     

       153
       153
       -
                      | _ -> Error "Missing required reaction fields")

     

       154
       154
       -
                 | _ -> Error "Expected JSON object for reaction"

     

       65
       65
       +
           (* Helper codec for nested user object - extracts just the user_id *)

     

       66
       66
       +
           let user_obj_codec =

     

       67
       67
       +
             Jsont.Object.map ~kind:"ReactionUser" Fun.id

     

       68
       68
       +
             |> Jsont.Object.mem "user_id" Jsont.int ~enc:Fun.id

     

       69
       69
       +
             |> Jsont.Object.finish

     

       155
       70
        
           in

     

       156
       156
       -
           let to_string { emoji_name; emoji_code; reaction_type; user_id; unknown } =

     

       157
       157
       -
             let fields = [

     

       158
       158
       -
               (("emoji_name", Jsont.Meta.none), Jsont.String (emoji_name, Jsont.Meta.none));

     

       159
       159
       -
               (("emoji_code", Jsont.Meta.none), Jsont.String (emoji_code, Jsont.Meta.none));

     

       160
       160
       -
               (("reaction_type", Jsont.Meta.none), Jsont.String (reaction_type, Jsont.Meta.none));

     

       161
       161
       -
               (("user_id", Jsont.Meta.none), Jsont.Number (float_of_int user_id, Jsont.Meta.none));

     

       162
       162
       -
             ] in

     

       163
       163
       -
             let unknown_mems = match unknown with

     

       164
       164
       -
               | Jsont.Object (mems, _) -> mems

     

       165
       165
       -
               | _ -> []

     

       166
       166
       -
             in

     

       167
       167
       -
             let json = Jsont.Object (fields @ unknown_mems, Jsont.Meta.none) in

     

       168
       168
       -
             match Jsont_bytesrw.encode_string' Jsont.json json with

     

       169
       169
       -
             | Ok s -> s

     

       170
       170
       -
             | Error e -> failwith ("Failed to encode reaction: " ^ Jsont.Error.to_string e)

     

       71
       71
       +
           let make emoji_name emoji_code reaction_type unknown =

     

       72
       72
       +
             fun user_id_direct user_obj_nested ->

     

       73
       73
       +
               let user_id = match user_id_direct, user_obj_nested with

     

       74
       74
       +
                 | Some uid, _ -> uid

     

       75
       75
       +
                 | None, Some uid -> uid

     

       76
       76
       +
                 | None, None -> Jsont.Error.msgf Jsont.Meta.none "Missing user_id field"

     

       77
       77
       +
               in

     

       78
       78
       +
               { emoji_name; emoji_code; reaction_type; user_id; unknown }

     

       171
       79
        
           in

     

       172
       172
       -
           Jsont.of_of_string ~kind:"Reaction" of_string ~enc:to_string

     

       80
       80
       +
           Jsont.Object.map ~kind:"Reaction" make

     

       81
       81
       +
           |> Jsont.Object.mem "emoji_name" Jsont.string ~enc:emoji_name

     

       82
       82
       +
           |> Jsont.Object.mem "emoji_code" Jsont.string ~enc:emoji_code

     

       83
       83
       +
           |> Jsont.Object.mem "reaction_type" Jsont.string ~enc:reaction_type

     

       84
       84
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun t -> t.unknown)

     

       85
       85
       +
           |> Jsont.Object.opt_mem "user_id" Jsont.int ~enc:(fun t -> Some t.user_id)

     

       86
       86
       +
           |> Jsont.Object.opt_mem "user" user_obj_codec ~enc:(fun _ -> None)

     

       87
       87
       +
           |> Jsont.Object.finish

     

       173
       88
        
       

     

       174
       89
        
         let of_json (json : Zulip.json) : (t, Zulip.zerror) result =

     

       175
       90
        
           match Zulip.Encode.from_json jsont json with

Compare changes