commit cb9ab68fe1cd4e65f8a83248913cbfefe8155e58 · anil.recoil.org/slop

+291

stack/requests/lib/digest_auth.ml

···

       1
       +
       (** RFC 2617 HTTP Digest Authentication implementation *)

     

       2
       +
       

     

       3
       +
       module Log = (val Logs.src_log (Logs.Src.create "requests.digest_auth" ~doc:"HTTP Digest Authentication") : Logs.LOG)

     

       4
       +
       

     

       5
       +
       (** Digest auth challenge parameters from WWW-Authenticate header *)

     

       6
       +
       type challenge = {

     

       7
       +
         realm : string;

     

       8
       +
         domain : string option;

     

       9
       +
         nonce : string;

     

       10
       +
         opaque : string option;

     

       11
       +
         stale : bool;

     

       12
       +
         algorithm : [`MD5 | `MD5_sess | `SHA256 | `SHA256_sess];

     

       13
       +
         qop : [`Auth | `Auth_int] list option;  (* quality of protection *)

     

       14
       +
         charset : string option;

     

       15
       +
         userhash : bool;

     

       16
       +
       }

     

       17
       +
       

     

       18
       +
       (** Client's chosen parameters for response *)

     

       19
       +
       type client_data = {

     

       20
       +
         username : string;

     

       21
       +
         password : string;

     

       22
       +
         nc : int;  (* nonce count *)

     

       23
       +
         cnonce : string;  (* client nonce *)

     

       24
       +
         qop_chosen : [`Auth | `Auth_int] option;

     

       25
       +
       }

     

       26
       +
       

     

       27
       +
       (** Parse WWW-Authenticate header for Digest challenge *)

     

       28
       +
       let parse_challenge header_value =

     

       29
       +
         (* Remove "Digest " prefix if present *)

     

       30
       +
         let value =

     

       31
       +
           if String.starts_with ~prefix:"Digest " header_value then

     

       32
       +
             String.sub header_value 7 (String.length header_value - 7)

     

       33
       +
           else header_value

     

       34
       +
         in

     

       35
       +
       

     

       36
       +
         (* Parse comma-separated key=value pairs *)

     

       37
       +
         let parse_params str =

     

       38
       +
           let rec parse_one pos acc =

     

       39
       +
             if pos >= String.length str then acc

     

       40
       +
             else

     

       41
       +
               (* Skip whitespace *)

     

       42
       +
               let pos = ref pos in

     

       43
       +
               while !pos < String.length str && str.[!pos] = ' ' do incr pos done;

     

       44
       +
               if !pos >= String.length str then acc

     

       45
       +
               else

     

       46
       +
                 (* Find key *)

     

       47
       +
                 let key_start = !pos in

     

       48
       +
                 while !pos < String.length str && str.[!pos] <> '=' do incr pos done;

     

       49
       +
                 if !pos >= String.length str then acc

     

       50
       +
                 else

     

       51
       +
                   let key = String.trim (String.sub str key_start (!pos - key_start)) in

     

       52
       +
                   incr pos;  (* Skip '=' *)

     

       53
       +
       

     

       54
       +
                   (* Parse value - may be quoted *)

     

       55
       +
                   let value, next_pos =

     

       56
       +
                     if !pos < String.length str && str.[!pos] = '"' then begin

     

       57
       +
                       (* Quoted value *)

     

       58
       +
                       incr pos;

     

       59
       +
                       let value_start = !pos in

     

       60
       +
                       while !pos < String.length str && str.[!pos] <> '"' do

     

       61
       +
                         if str.[!pos] = '\\' && !pos + 1 < String.length str then

     

       62
       +
                           pos := !pos + 2  (* Skip escaped character *)

     

       63
       +
                         else

     

       64
       +
                           incr pos

     

       65
       +
                       done;

     

       66
       +
                       let value = String.sub str value_start (!pos - value_start) in

     

       67
       +
                       if !pos < String.length str then incr pos;  (* Skip closing quote *)

     

       68
       +
                       (* Skip to next comma *)

     

       69
       +
                       while !pos < String.length str && str.[!pos] <> ',' do incr pos done;

     

       70
       +
                       if !pos < String.length str then incr pos;  (* Skip comma *)

     

       71
       +
                       (value, !pos)

     

       72
       +
                     end else begin

     

       73
       +
                       (* Unquoted value *)

     

       74
       +
                       let value_start = !pos in

     

       75
       +
                       while !pos < String.length str && str.[!pos] <> ',' do incr pos done;

     

       76
       +
                       let value = String.trim (String.sub str value_start (!pos - value_start)) in

     

       77
       +
                       if !pos < String.length str then incr pos;  (* Skip comma *)

     

       78
       +
                       (value, !pos)

     

       79
       +
                     end

     

       80
       +
                   in

     

       81
       +
                   parse_one next_pos ((key, value) :: acc)

     

       82
       +
           in

     

       83
       +
           List.rev (parse_one 0 [])

     

       84
       +
         in

     

       85
       +
       

     

       86
       +
         let params = parse_params value in

     

       87
       +
       

     

       88
       +
         (* Extract required and optional parameters *)

     

       89
       +
         let get_param name = List.assoc_opt name params in

     

       90
       +
         let get_param_req name =

     

       91
       +
           match get_param name with

     

       92
       +
           | Some v -> v

     

       93
       +
           | None -> failwith (Printf.sprintf "Missing required Digest parameter: %s" name)

     

       94
       +
         in

     

       95
       +
       

     

       96
       +
         try

     

       97
       +
           let realm = get_param_req "realm" in

     

       98
       +
           let nonce = get_param_req "nonce" in

     

       99
       +
       

     

       100
       +
           let algorithm = match get_param "algorithm" with

     

       101
       +
             | Some "MD5" | None -> `MD5

     

       102
       +
             | Some "MD5-sess" -> `MD5_sess

     

       103
       +
             | Some "SHA-256" -> `SHA256

     

       104
       +
             | Some "SHA-256-sess" -> `SHA256_sess

     

       105
       +
             | Some a ->

     

       106
       +
                 Log.warn (fun m -> m "Unknown digest algorithm: %s, using MD5" a);

     

       107
       +
                 `MD5

     

       108
       +
           in

     

       109
       +
       

     

       110
       +
           let qop = match get_param "qop" with

     

       111
       +
             | None -> None

     

       112
       +
             | Some qop_str ->

     

       113
       +
                 let qops = String.split_on_char ',' qop_str |> List.map String.trim in

     

       114
       +
                 Some (List.filter_map (function

     

       115
       +
                   | "auth" -> Some `Auth

     

       116
       +
                   | "auth-int" -> Some `Auth_int

     

       117
       +
                   | _ -> None

     

       118
       +
                 ) qops)

     

       119
       +
           in

     

       120
       +
       

     

       121
       +
           Some {

     

       122
       +
             realm;

     

       123
       +
             domain = get_param "domain";

     

       124
       +
             nonce;

     

       125
       +
             opaque = get_param "opaque";

     

       126
       +
             stale = (match get_param "stale" with

     

       127
       +
               | Some "true" | Some "TRUE" -> true

     

       128
       +
               | _ -> false);

     

       129
       +
             algorithm;

     

       130
       +
             qop;

     

       131
       +
             charset = get_param "charset";

     

       132
       +
             userhash = (match get_param "userhash" with

     

       133
       +
               | Some "true" | Some "TRUE" -> true

     

       134
       +
               | _ -> false);

     

       135
       +
           }

     

       136
       +
         with

     

       137
       +
         | Failure msg ->

     

       138
       +
             Log.warn (fun m -> m "Failed to parse Digest challenge: %s" msg);

     

       139
       +
             None

     

       140
       +
         | Not_found -> None

     

       141
       +
       

     

       142
       +
       (** Generate client nonce *)

     

       143
       +
       let generate_cnonce () =

     

       144
       +
         let rand_bytes = Mirage_crypto_rng.generate 16 in

     

       145
       +
         Base64.encode_string rand_bytes

     

       146
       +
       

     

       147
       +
       (** Hash function based on algorithm *)

     

       148
       +
       let hash_function = function

     

       149
       +
         | `MD5 | `MD5_sess ->

     

       150
       +
             fun s -> Digestif.MD5.(to_hex (digest_string s))

     

       151
       +
         | `SHA256 | `SHA256_sess ->

     

       152
       +
             fun s -> Digestif.SHA256.(to_hex (digest_string s))

     

       153
       +
       

     

       154
       +
       (** Calculate H(A1) according to RFC 2617 *)

     

       155
       +
       let calculate_ha1 ~algorithm ~username ~realm ~password ~nonce ~cnonce =

     

       156
       +
         let hash = hash_function algorithm in

     

       157
       +
         match algorithm with

     

       158
       +
         | `MD5 | `SHA256 ->

     

       159
       +
             hash (Printf.sprintf "%s:%s:%s" username realm password)

     

       160
       +
         | `MD5_sess | `SHA256_sess ->

     

       161
       +
             let ha1_base = hash (Printf.sprintf "%s:%s:%s" username realm password) in

     

       162
       +
             hash (Printf.sprintf "%s:%s:%s" ha1_base nonce cnonce)

     

       163
       +
       

     

       164
       +
       (** Calculate H(A2) according to RFC 2617 *)

     

       165
       +
       let calculate_ha2 ~algorithm ~meth ~uri ~qop ~body =

     

       166
       +
         let hash = hash_function algorithm in

     

       167
       +
         let method_str = match meth with

     

       168
       +
           | `GET -> "GET" | `POST -> "POST" | `PUT -> "PUT"

     

       169
       +
           | `DELETE -> "DELETE" | `HEAD -> "HEAD" | `OPTIONS -> "OPTIONS"

     

       170
       +
           | `PATCH -> "PATCH" | `TRACE -> "TRACE" | `CONNECT -> "CONNECT"

     

       171
       +
           | `Other s -> s

     

       172
       +
         in

     

       173
       +
         match qop with

     

       174
       +
         | None | Some `Auth ->

     

       175
       +
             hash (Printf.sprintf "%s:%s" method_str (Uri.path_and_query uri))

     

       176
       +
         | Some `Auth_int ->

     

       177
       +
             (* For auth-int, include hash of entity body *)

     

       178
       +
             let body_hash = match body with

     

       179
       +
               | None -> hash ""

     

       180
       +
               | Some b -> hash b

     

       181
       +
             in

     

       182
       +
             hash (Printf.sprintf "%s:%s:%s" method_str (Uri.path_and_query uri) body_hash)

     

       183
       +
       

     

       184
       +
       (** Calculate the response hash *)

     

       185
       +
       let calculate_response ~ha1 ~ha2 ~nonce ~nc ~cnonce ~qop =

     

       186
       +
         let hash = hash_function `MD5 in  (* Response always uses the same hash as HA1 *)

     

       187
       +
         match qop with

     

       188
       +
         | None ->

     

       189
       +
             hash (Printf.sprintf "%s:%s:%s" ha1 nonce ha2)

     

       190
       +
         | Some qop_value ->

     

       191
       +
             let qop_str = match qop_value with

     

       192
       +
               | `Auth -> "auth"

     

       193
       +
               | `Auth_int -> "auth-int"

     

       194
       +
             in

     

       195
       +
             let nc_str = Printf.sprintf "%08x" nc in

     

       196
       +
             hash (Printf.sprintf "%s:%s:%s:%s:%s:%s" ha1 nonce nc_str cnonce qop_str ha2)

     

       197
       +
       

     

       198
       +
       (** Generate Authorization header value for Digest auth *)

     

       199
       +
       let generate_auth_header ~challenge ~client_data ~meth ~uri ~body =

     

       200
       +
         let { username; password; nc; cnonce; qop_chosen } = client_data in

     

       201
       +
         let { realm; nonce; opaque; algorithm; _ } = challenge in

     

       202
       +
       

     

       203
       +
         (* Calculate hashes *)

     

       204
       +
         let ha1 = calculate_ha1 ~algorithm ~username ~realm ~password ~nonce ~cnonce in

     

       205
       +
         let ha2 = calculate_ha2 ~algorithm ~meth ~uri ~qop:qop_chosen ~body in

     

       206
       +
         let response = calculate_response ~ha1 ~ha2 ~nonce ~nc ~cnonce ~qop:qop_chosen in

     

       207
       +
       

     

       208
       +
         (* Build Authorization header *)

     

       209
       +
         let params = [

     

       210
       +
           ("username", Printf.sprintf "\"%s\"" username);

     

       211
       +
           ("realm", Printf.sprintf "\"%s\"" realm);

     

       212
       +
           ("nonce", Printf.sprintf "\"%s\"" nonce);

     

       213
       +
           ("uri", Printf.sprintf "\"%s\"" (Uri.path_and_query uri));

     

       214
       +
           ("response", Printf.sprintf "\"%s\"" response);

     

       215
       +
         ] in

     

       216
       +
       

     

       217
       +
         let params = match algorithm with

     

       218
       +
           | `MD5 -> params  (* MD5 is default, don't need to specify *)

     

       219
       +
           | `MD5_sess -> ("algorithm", "MD5-sess") :: params

     

       220
       +
           | `SHA256 -> ("algorithm", "SHA-256") :: params

     

       221
       +
           | `SHA256_sess -> ("algorithm", "SHA-256-sess") :: params

     

       222
       +
         in

     

       223
       +
       

     

       224
       +
         let params = match opaque with

     

       225
       +
           | Some o -> ("opaque", Printf.sprintf "\"%s\"" o) :: params

     

       226
       +
           | None -> params

     

       227
       +
         in

     

       228
       +
       

     

       229
       +
         let params = match qop_chosen with

     

       230
       +
           | None -> params

     

       231
       +
           | Some qop ->

     

       232
       +
               let qop_str = match qop with `Auth -> "auth" | `Auth_int -> "auth-int" in

     

       233
       +
               let nc_str = Printf.sprintf "%08x" nc in

     

       234
       +
               ("qop", qop_str) ::

     

       235
       +
               ("nc", nc_str) ::

     

       236
       +
               ("cnonce", Printf.sprintf "\"%s\"" cnonce) ::

     

       237
       +
               params

     

       238
       +
         in

     

       239
       +
       

     

       240
       +
         "Digest " ^ String.concat ", " (List.map (fun (k, v) -> k ^ "=" ^ v) params)

     

       241
       +
       

     

       242
       +
       (** Nonce counter storage - in production should be persistent *)

     

       243
       +
       module NonceCounter = struct

     

       244
       +
         let table = Hashtbl.create 16

     

       245
       +
       

     

       246
       +
         let get_and_increment ~nonce =

     

       247
       +
           let current = try Hashtbl.find table nonce with Not_found -> 0 in

     

       248
       +
           Hashtbl.replace table nonce (current + 1);

     

       249
       +
           current + 1

     

       250
       +
       

     

       251
       +
         let reset ~nonce =

     

       252
       +
           Hashtbl.remove table nonce

     

       253
       +
       end

     

       254
       +
       

     

       255
       +
       (** Apply Digest authentication to a request *)

     

       256
       +
       let apply_digest_auth ~username ~password ~meth ~uri ~headers ~body ~challenge_header =

     

       257
       +
         match parse_challenge challenge_header with

     

       258
       +
         | None ->

     

       259
       +
             Log.warn (fun m -> m "Failed to parse Digest challenge");

     

       260
       +
             headers

     

       261
       +
         | Some challenge ->

     

       262
       +
             (* Choose QOP if server offers options *)

     

       263
       +
             let qop_chosen = match challenge.qop with

     

       264
       +
               | None -> None

     

       265
       +
               | Some qops ->

     

       266
       +
                   (* Prefer auth over auth-int for simplicity *)

     

       267
       +
                   if List.mem `Auth qops then Some `Auth

     

       268
       +
                   else if List.mem `Auth_int qops then Some `Auth_int

     

       269
       +
                   else None

     

       270
       +
             in

     

       271
       +
       

     

       272
       +
             (* Get or generate client nonce *)

     

       273
       +
             let cnonce = generate_cnonce () in

     

       274
       +
       

     

       275
       +
             (* Get and increment nonce counter *)

     

       276
       +
             let nc = NonceCounter.get_and_increment ~nonce:challenge.nonce in

     

       277
       +
       

     

       278
       +
             let client_data = { username; password; nc; cnonce; qop_chosen } in

     

       279
       +
             let auth_value = generate_auth_header ~challenge ~client_data ~meth ~uri ~body in

     

       280
       +
       

     

       281
       +
             Cohttp.Header.add headers "Authorization" auth_value

     

       282
       +
       

     

       283
       +
       (** Check if a response requires digest auth *)

     

       284
       +
       let is_digest_challenge response =

     

       285
       +
         let status = Cohttp.Response.status response in

     

       286
       +
         match Cohttp.Code.code_of_status status with

     

       287
       +
         | 401 ->

     

       288
       +
             (match Cohttp.Header.get (Cohttp.Response.headers response) "www-authenticate" with

     

       289
       +
              | Some header when String.starts_with ~prefix:"Digest" header -> Some header

     

       290
       +
              | _ -> None)

     

       291
       +
         | _ -> None

+2 -1

stack/requests/lib/dune

···

       1
        
       (library

     

       2
        
        (public_name requests)

     

       3
        
        (name requests)

     

       4
       -
        (libraries eio cohttp-eio tls-eio ca-certs x509 uri yojson logs base64 unix digestif mirage-crypto-rng mirage-crypto-rng.unix domain-name xdg))
     

       0

···

       1
        
       (library

     

       2
        
        (public_name requests)

     

       3
        
        (name requests)

     

       4
       +
        (modules requests requests_types requests_cache digest_auth)

     

       5
       +
        (libraries eio cohttp-eio tls-eio ca-certs x509 uri yojson logs base64 unix digestif mirage-crypto-rng mirage-crypto-rng.unix domain-name xdg cacheio xdge cstruct))

+259 -103

stack/requests/lib/requests.ml

···

       1
        
       open Eio

     

       2
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       3
        
       (* Initialize the RNG on module load for OAuth and other crypto operations *)

     

       4
        
       let () = Mirage_crypto_rng_unix.use_default ()

     

       5
        
       

     
···

       54
        
         type t =

     

       55
        
           | None

     

       56
        
           | Basic of { username : string; password : string }

     

       57
       -
           | Digest of { username : string; password : string }

     

       58
        
           | Bearer of { token : string }

     

       59
        
           | OAuth1 of {

     

       60
        
               consumer_key : string;

     
···

       75
        
       

     

       76
        
         let basic ~username ~password = Basic { username; password }

     

       77
        
       

     

       78
       -
         let digest ~username ~password = Digest { username; password }

     

       79
        
       

     

       80
        
         let bearer ~token = Bearer { token }

     

       81
        
       

     
···

       94
        
           | Basic { username; password } ->

     

       95
        
               let encoded = Base64.encode_string (Printf.sprintf "%s:%s" username password) in

     

       96
        
               Cohttp.Header.add headers "Authorization" (Printf.sprintf "Basic %s" encoded)

     

       97
       -
           | Digest { username; password } ->

     

       98
       -
               (* Simplified - would need challenge-response in real implementation *)

     

       99
       -
               Log.warn (fun m -> m "Digest auth not fully implemented - using Basic fallback");

     

       100
       -
               let encoded = Base64.encode_string (Printf.sprintf "%s:%s" username password) in

     

       101
       -
               Cohttp.Header.add headers "Authorization" (Printf.sprintf "Basic %s" encoded)

     

       0
        
       
     

       0
        
       
     

       102
        
           | Bearer { token } ->

     

       103
        
               Cohttp.Header.add headers "Authorization" (Printf.sprintf "Bearer %s" token)

     

       104
        
           | OAuth1 { consumer_key; consumer_secret; token; token_secret; signature_method } ->

     
···

       193
        
           | Custom f -> f meth uri headers

     

       194
        
       end

     

       195
        
       

     

       196
       -
       module Response = struct

     

       197
       -
         type t = {

     

       198
       -
           status : Cohttp.Code.status_code;

     

       199
       -
           headers : Cohttp.Header.t;

     

       200
       -
           body : string;

     

       201
       -
           body_stream : Buf_read.t option;

     

       202
       -
         }

     

       203
       -
       

     

       204
       -
         let status t = t.status

     

       205
       -
         let headers t = t.headers

     

       206
       -
         let body t = t.body

     

       207
       -
         let body_stream t =

     

       208
       -
           match t.body_stream with

     

       209
       -
           | Some s -> s

     

       210
       -
           | None -> Buf_read.of_string t.body

     

       211
       -
       

     

       212
       -
         let is_success t =

     

       213
       -
           let code = Cohttp.Code.code_of_status t.status in

     

       214
       -
           code >= 200 && code < 300

     

       215
       -
       

     

       216
       -
         let is_redirect t =

     

       217
       -
           let code = Cohttp.Code.code_of_status t.status in

     

       218
       -
           code >= 300 && code < 400

     

       219
       -
       

     

       220
       -
         let is_client_error t =

     

       221
       -
           let code = Cohttp.Code.code_of_status t.status in

     

       222
       -
           code >= 400 && code < 500

     

       223
       -
       

     

       224
       -
         let is_server_error t =

     

       225
       -
           let code = Cohttp.Code.code_of_status t.status in

     

       226
       -
           code >= 500 && code < 600

     

       227
       -
       

     

       228
       -
         let _pp ppf t =

     

       229
       -
           Format.fprintf ppf "@[<v>Response:@,Status: %s@,Headers: %d@,Body: %d bytes@]"

     

       230
       -
             (Cohttp.Code.string_of_status t.status)

     

       231
       -
             (Cohttp.Header.to_lines t.headers |> List.length)

     

       232
       -
             (String.length t.body)

     

       233
       -
       end

     

       234
        
       

     

       235
        
       (* Retry Implementation *)

     

       236
        
       module Retry = struct

     
···

       325
        
           if t.backoff.factor = 0.0 then 0.0

     

       326
        
           else

     

       327
        
             let base_time = t.backoff.factor *. (2.0 ** float_of_int t.retry_count) in

     

       328
       -
             let jittered = base_time +. Random.float t.backoff.jitter in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       329
        
             min jittered t.backoff.max

     

       330
        
       

     

       331
        
         let sleep ~clock t response =

     
···

       419
        
         clock : clock;

     

       420
        
         tls_config : Tls.config;

     

       421
        
         default_headers : Cohttp.Header.t;

     

       0
        
       
     

       422
        
       } constraint 'a = [> `Generic] Net.ty

     

       423
        
       

     

       424
       -
       let create ?(tls_config=Tls.default ()) ?(default_headers=Cohttp.Header.init ()) ~clock net =

     

       425
       -
         { net; clock = Clock clock; tls_config; default_headers }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       426
        
       

     

       427
        
       

     

       428
        
       let make_client net tls_config =

     
···

       494
        
           { Response.status; headers; body; body_stream = None }

     

       495
        
       

     

       496
        
       let rec request_with_retries ~sw t ?(config=Config.default) ?body ~meth uri retry_state =

     

       497
       -
         let client = make_client t.net t.tls_config in

     

       498
       -
         let merged_headers = merge_headers t.default_headers config.Config.headers in

     

       499
       -
         (* Apply authentication *)

     

       500
       -
         let merged_headers = Auth.apply config.Config.auth meth uri merged_headers in

     

       501
       -
         let config = { config with Config.headers = merged_headers } in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       502
        
       

     

       503
       -
         try

     

       504
       -
           let result = request_with_redirects ~sw client config uri 0 meth body in

     

       505
       -
           if not (Response.is_success result) then

     

       506
       -
             let status = Cohttp.Code.code_of_status result.Response.status in

     

       507
       -
             if Retry.is_retry retry_state ~method_:meth ~status_code:status then begin

     

       508
       -
               Log.info (fun m -> m "Retrying request to %a (attempt %d/%d)"

     

       509
       -
                 Uri.pp uri (retry_state.Retry.retry_count + 1) retry_state.Retry.total);

     

       510
       -
               let retry_state = Retry.increment retry_state ~method_:meth ~url:uri

     

       511
       -
                 ~response:result () in

     

       512
       -
               (match t.clock with Clock c -> Retry.sleep ~clock:c retry_state (Some result));

     

       513
       -
               request_with_retries ~sw t ~config ?body ~meth uri retry_state

     

       514
       -
             end else

     

       515
       -
               raise (Request_error (Http_error {

     

       516
       -
                 status = result.Response.status;

     

       517
       -
                 body = result.Response.body;

     

       518
       -
                 headers = result.Response.headers

     

       519
       -
               }))

     

       520
       -
           else

     

       521
       -
             result

     

       522
        
         with

     

       523
        
         | Request_error _ as e -> raise e

     

       524
        
         | e ->

     
···

       720
        
         let clear_cookies t = t.cookies := []

     

       721
        
       end

     

       722
        
       

     

       723
       -
       let download_file ~sw t ?config uri ~path =

     

       724
       -
         let response = get ~sw t ?config uri in

     

       725
       -
         let oc = open_out_bin path in

     

       726
       -
         try

     

       727
       -
           output_string oc response.Response.body;

     

       728
       -
           close_out oc

     

       729
       -
         with e ->

     

       730
       -
           close_out_noerr oc;

     

       731
       -
           raise e

     

       732
        
       

     

       733
        
       let stream_response ~sw t ?config uri f =

     

       734
        
         let client = make_client t.net t.tls_config in

     
···

       737
        
           | None -> Cohttp.Header.init ()

     

       738
        
         in

     

       739
        
         let merged_headers = merge_headers t.default_headers headers in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       740
        
         let _resp, body = Cohttp_eio.Client.get ~sw client uri ~headers:merged_headers in

     

       741
        
         let buf_reader = Eio.Buf_read.of_flow ~max_size:(16 * 1024 * 1024) body in

     

       742
        
         f buf_reader

     
···

       1127
        
       

     

       1128
        
               let create_client = fun ?tls_config ?default_headers ~clock net ->

     

       1129
        
                 { net; clock; tls_config = Option.value ~default:(Tls.default ()) tls_config;

     

       1130
       -
                   default_headers = Option.value ~default:(Cohttp.Header.init ()) default_headers }

     

       0
        
       
     

       1131
        
               in

     

       1132
        
               let req_client = create_client ?tls_config:t.tls_config ~default_headers:t.headers ~clock:t.clock t.net in

     

       1133
        
               let config = Config.create ~headers ~follow_redirects:redirect () in

     
···

       1211
        
             }

     

       1212
        
       

     

       1213
        
         let choose_boundary () =

     

       1214
       -
           Printf.sprintf "----OCamlBoundary%08x%08x"

     

       1215
       -
             (Random.int 0x7FFFFFFF) (Random.int 0x7FFFFFFF)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       1216
        
       

     

       1217
        
         let encode_multipart_formdata ~fields ~boundary =

     

       1218
        
           let boundary = Option.value boundary ~default:(choose_boundary ()) in

     
···

       1413
        
       

     

       1414
        
         let download ~sw t ?config ?(chunk_size=8192) uri ~sink =

     

       1415
        
           Log.debug (fun m -> m "Streaming download from %s with chunk size %d" (Uri.to_string uri) chunk_size);

     

       1416
       -
           let response = get ~sw t ?config uri in

     

       1417
       -
           (* Write response body to sink in chunks *)

     

       1418
       -
           let body = Response.body response in

     

       1419
       -
           let rec write_chunks pos =

     

       1420
       -
             if pos < String.length body then

     

       1421
       -
               let len = min chunk_size (String.length body - pos) in

     

       1422
       -
               let chunk = String.sub body pos len in

     

       1423
       -
               Flow.copy_string chunk sink;

     

       1424
       -
               write_chunks (pos + len)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       1425
        
           in

     

       1426
       -
           write_chunks 0

     

       0
        
       
     

       1427
        
       

     

       1428
        
         let iter_response ?(chunk_size=8192) response ~f =

     

       1429
       -
           let body = Response.body response in

     

       1430
       -
           let rec iter pos =

     

       1431
       -
             if pos < String.length body then

     

       1432
       -
               let len = min chunk_size (String.length body - pos) in

     

       1433
       -
               let chunk = String.sub body pos len in

     

       1434
       -
               f chunk;

     

       1435
       -
               iter (pos + len)

     

       1436
       -
           in

     

       1437
       -
           iter 0

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       1438
        
       

     

       1439
        
         let lines ?(chunk_size=8192) ?(keep_ends=false) response =

     

       1440
        
           let body = Response.body response in

     
···

       1476
        
                 Log.warn (fun m -> m "Failed to parse JSON line: %s" line);

     

       1477
        
                 `Null)

     

       1478
        
       end

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       1479
        
       

     

       1480
        
       (* Global defaults *)

     

       1481
        
       module Defaults = struct

···

       1
        
       open Eio

     

       2
        
       

     

       3
       +
       (* Include shared types module *)

     

       4
       +
       module Requests_types = Requests_types

     

       5
       +
       

     

       6
       +
       (* Include cache module *)

     

       7
       +
       module Requests_cache = Requests_cache

     

       8
       +
       

     

       9
        
       (* Initialize the RNG on module load for OAuth and other crypto operations *)

     

       10
        
       let () = Mirage_crypto_rng_unix.use_default ()

     

       11
        
       

     
···

       60
        
         type t =

     

       61
        
           | None

     

       62
        
           | Basic of { username : string; password : string }

     

       63
       +
           | DigestAuth of { username : string; password : string; challenge : string option ref }

     

       64
        
           | Bearer of { token : string }

     

       65
        
           | OAuth1 of {

     

       66
        
               consumer_key : string;

     
···

       81
        
       

     

       82
        
         let basic ~username ~password = Basic { username; password }

     

       83
        
       

     

       84
       +
         let digest ~username ~password = DigestAuth { username; password; challenge = ref (None : string option) }

     

       85
        
       

     

       86
        
         let bearer ~token = Bearer { token }

     

       87
        
       

     
···

       100
        
           | Basic { username; password } ->

     

       101
        
               let encoded = Base64.encode_string (Printf.sprintf "%s:%s" username password) in

     

       102
        
               Cohttp.Header.add headers "Authorization" (Printf.sprintf "Basic %s" encoded)

     

       103
       +
           | DigestAuth { username; password; challenge } ->

     

       104
       +
               (* Use stored challenge if available, otherwise headers unchanged (will trigger 401) *)

     

       105
       +
               (match !challenge with

     

       106
       +
                | None -> headers  (* No challenge yet, will get 401 response *)

     

       107
       +
                | Some challenge_header ->

     

       108
       +
                    (* Apply digest auth with challenge *)

     

       109
       +
                    Digest_auth.apply_digest_auth ~username ~password ~meth ~uri ~headers ~body:None ~challenge_header)

     

       110
        
           | Bearer { token } ->

     

       111
        
               Cohttp.Header.add headers "Authorization" (Printf.sprintf "Bearer %s" token)

     

       112
        
           | OAuth1 { consumer_key; consumer_secret; token; token_secret; signature_method } ->

     
···

       201
        
           | Custom f -> f meth uri headers

     

       202
        
       end

     

       203
        
       

     

       204
       +
       module Response = Requests_types.Response

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       205
        
       

     

       206
        
       (* Retry Implementation *)

     

       207
        
       module Retry = struct

     
···

       296
        
           if t.backoff.factor = 0.0 then 0.0

     

       297
        
           else

     

       298
        
             let base_time = t.backoff.factor *. (2.0 ** float_of_int t.retry_count) in

     

       299
       +
             (* Use Mirage crypto RNG for jitter calculation *)

     

       300
       +
           let rand_bytes = Mirage_crypto_rng.generate 4 in

     

       301
       +
           let rand_cstruct = Cstruct.of_string rand_bytes in

     

       302
       +
           let rand_uint32 = Cstruct.LE.get_uint32 rand_cstruct 0 in

     

       303
       +
           (* Convert to float in [0, 1) range *)

     

       304
       +
           let normalized = Int32.to_float rand_uint32 /. (2.0 ** 32.0) in

     

       305
       +
           let jittered = base_time +. (normalized *. t.backoff.jitter) in

     

       306
        
             min jittered t.backoff.max

     

       307
        
       

     

       308
        
         let sleep ~clock t response =

     
···

       396
        
         clock : clock;

     

       397
        
         tls_config : Tls.config;

     

       398
        
         default_headers : Cohttp.Header.t;

     

       399
       +
         cache : Requests_cache.t option;

     

       400
        
       } constraint 'a = [> `Generic] Net.ty

     

       401
        
       

     

       402
       +
       let create ?(tls_config=Tls.default ()) ?(default_headers=Cohttp.Header.init ()) ?cache ~clock net =

     

       403
       +
         { net; clock = Clock clock; tls_config; default_headers; cache }

     

       404
       +
       

     

       405
       +
       let create_with_cache ~sw ?(tls_config=Tls.default ()) ?(default_headers=Cohttp.Header.init ())

     

       406
       +
           ~cache_dir ~clock net =

     

       407
       +
         let cache = Requests_cache.create ~sw ~enabled:true ~cache_dir () in

     

       408
       +
         { net; clock = Clock clock; tls_config; default_headers; cache = Some cache }

     

       409
        
       

     

       410
        
       

     

       411
        
       let make_client net tls_config =

     
···

       477
        
           { Response.status; headers; body; body_stream = None }

     

       478
        
       

     

       479
        
       let rec request_with_retries ~sw t ?(config=Config.default) ?body ~meth uri retry_state =

     

       480
       +
         (* Check cache first for GET/HEAD requests *)

     

       481
       +
         let check_cache () =

     

       482
       +
           match t.cache, meth with

     

       483
       +
           | Some cache, (`GET | `HEAD) ->

     

       484
       +
               Requests_cache.get cache ~method_:meth ~url:uri ~headers:config.Config.headers

     

       485
       +
           | _ -> None

     

       486
       +
         in

     

       487
       +
       

     

       488
       +
         match check_cache () with

     

       489
       +
         | Some cached_response ->

     

       490
       +
             Log.debug (fun m -> m "Using cached response for %s" (Uri.to_string uri));

     

       491
       +
             cached_response

     

       492
       +
         | None ->

     

       493
       +
             let client = make_client t.net t.tls_config in

     

       494
       +
             let merged_headers = merge_headers t.default_headers config.Config.headers in

     

       495
       +
             (* Apply authentication *)

     

       496
       +
             let merged_headers = Auth.apply config.Config.auth meth uri merged_headers in

     

       497
       +
             let config = { config with Config.headers = merged_headers } in

     

       498
       +
       

     

       499
       +
             try

     

       500
       +
               let result = request_with_redirects ~sw client config uri 0 meth body in

     

       501
       +
       

     

       502
       +
               (* Handle Digest auth challenge if we get a 401 *)

     

       503
       +
               let result = match config.Config.auth with

     

       504
       +
                 | DigestAuth { username = _; password = _; challenge } when result.Response.status = `Unauthorized ->

     

       505
       +
                     (match Cohttp.Header.get result.Response.headers "www-authenticate" with

     

       506
       +
                      | Some www_auth when String.starts_with ~prefix:"Digest" www_auth ->

     

       507
       +
                          (* Store the challenge *)

     

       508
       +
                          challenge := Some www_auth;

     

       509
       +
                          Log.debug (fun m -> m "Got Digest challenge, retrying with auth");

     

       510
       +
       

     

       511
       +
                          (* Retry request with digest auth *)

     

       512
       +
                          let merged_headers = merge_headers t.default_headers config.Config.headers in

     

       513
       +
                          let merged_headers = Auth.apply config.Config.auth meth uri merged_headers in

     

       514
       +
                          let config = { config with Config.headers = merged_headers } in

     

       515
       +
                          request_with_redirects ~sw client config uri 0 meth body

     

       516
       +
                      | _ -> result)

     

       517
       +
                 | _ -> result

     

       518
       +
               in

     

       519
       +
       

     

       520
       +
               (* Store successful responses in cache *)

     

       521
       +
               (match t.cache with

     

       522
       +
                | Some cache when Response.is_success result ->

     

       523
       +
                    Requests_cache.put cache ~method_:meth ~url:uri

     

       524
       +
                      ~request_headers:config.Config.headers ~response:result

     

       525
       +
                | _ -> ());

     

       526
        
       

     

       527
       +
               if not (Response.is_success result) then

     

       528
       +
                 let status = Cohttp.Code.code_of_status result.Response.status in

     

       529
       +
                 if Retry.is_retry retry_state ~method_:meth ~status_code:status then begin

     

       530
       +
                   Log.info (fun m -> m "Retrying request to %a (attempt %d/%d)"

     

       531
       +
                     Uri.pp uri (retry_state.Retry.retry_count + 1) retry_state.Retry.total);

     

       532
       +
                   let retry_state = Retry.increment retry_state ~method_:meth ~url:uri

     

       533
       +
                     ~response:result () in

     

       534
       +
                   (match t.clock with Clock c -> Retry.sleep ~clock:c retry_state (Some result));

     

       535
       +
                   request_with_retries ~sw t ~config ?body ~meth uri retry_state

     

       536
       +
                 end else

     

       537
       +
                   raise (Request_error (Http_error {

     

       538
       +
                     status = result.Response.status;

     

       539
       +
                     body = result.Response.body;

     

       540
       +
                     headers = result.Response.headers

     

       541
       +
                   }))

     

       542
       +
               else

     

       543
       +
                 result

     

       0
        
       
     

       0
        
       
     

       544
        
         with

     

       545
        
         | Request_error _ as e -> raise e

     

       546
        
         | e ->

     
···

       742
        
         let clear_cookies t = t.cookies := []

     

       743
        
       end

     

       744
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       745
        
       

     

       746
        
       let stream_response ~sw t ?config uri f =

     

       747
        
         let client = make_client t.net t.tls_config in

     
···

       750
        
           | None -> Cohttp.Header.init ()

     

       751
        
         in

     

       752
        
         let merged_headers = merge_headers t.default_headers headers in

     

       753
       +
         let merged_headers = match config with

     

       754
       +
           | Some c -> Auth.apply c.Config.auth `GET uri merged_headers

     

       755
       +
           | None -> merged_headers

     

       756
       +
         in

     

       757
        
         let _resp, body = Cohttp_eio.Client.get ~sw client uri ~headers:merged_headers in

     

       758
        
         let buf_reader = Eio.Buf_read.of_flow ~max_size:(16 * 1024 * 1024) body in

     

       759
        
         f buf_reader

     
···

       1144
        
       

     

       1145
        
               let create_client = fun ?tls_config ?default_headers ~clock net ->

     

       1146
        
                 { net; clock; tls_config = Option.value ~default:(Tls.default ()) tls_config;

     

       1147
       +
                   default_headers = Option.value ~default:(Cohttp.Header.init ()) default_headers;

     

       1148
       +
                   cache = None }

     

       1149
        
               in

     

       1150
        
               let req_client = create_client ?tls_config:t.tls_config ~default_headers:t.headers ~clock:t.clock t.net in

     

       1151
        
               let config = Config.create ~headers ~follow_redirects:redirect () in

     
···

       1229
        
             }

     

       1230
        
       

     

       1231
        
         let choose_boundary () =

     

       1232
       +
           (* Use Mirage crypto RNG for boundary generation *)

     

       1233
       +
           let rand_bytes = Mirage_crypto_rng.generate 8 in

     

       1234
       +
           let rand_cstruct = Cstruct.of_string rand_bytes in

     

       1235
       +
           let rand_hex = Cstruct.to_hex_string rand_cstruct in

     

       1236
       +
           Printf.sprintf "----OCamlBoundary%s" rand_hex

     

       1237
        
       

     

       1238
        
         let encode_multipart_formdata ~fields ~boundary =

     

       1239
        
           let boundary = Option.value boundary ~default:(choose_boundary ()) in

     
···

       1434
        
       

     

       1435
        
         let download ~sw t ?config ?(chunk_size=8192) uri ~sink =

     

       1436
        
           Log.debug (fun m -> m "Streaming download from %s with chunk size %d" (Uri.to_string uri) chunk_size);

     

       1437
       +
           (* Create client and perform streaming download directly *)

     

       1438
       +
           let client = make_client t.net t.tls_config in

     

       1439
       +
           let headers = match config with

     

       1440
       +
             | Some c -> c.Config.headers

     

       1441
       +
             | None -> Cohttp.Header.init ()

     

       1442
       +
           in

     

       1443
       +
           let merged_headers = merge_headers t.default_headers headers in

     

       1444
       +
           let merged_headers = match config with

     

       1445
       +
             | Some c -> Auth.apply c.Config.auth `GET uri merged_headers

     

       1446
       +
             | None -> merged_headers

     

       1447
       +
           in

     

       1448
       +
       

     

       1449
       +
           let _resp, body = Cohttp_eio.Client.get ~sw client uri ~headers:merged_headers in

     

       1450
       +
           let buf_reader = Eio.Buf_read.of_flow ~max_size:(16 * 1024 * 1024) body in

     

       1451
       +
       

     

       1452
       +
           (* Stream data in chunks to the sink *)

     

       1453
       +
           let rec stream_chunks () =

     

       1454
       +
             try

     

       1455
       +
               let chunk = Eio.Buf_read.take chunk_size buf_reader in

     

       1456
       +
               if String.length chunk > 0 then (

     

       1457
       +
                 Flow.copy_string chunk sink;

     

       1458
       +
                 stream_chunks ()

     

       1459
       +
               )

     

       1460
       +
             with

     

       1461
       +
             | End_of_file -> ()

     

       1462
       +
             | Eio.Buf_read.Buffer_limit_exceeded ->

     

       1463
       +
                 (* Read in smaller chunks when buffer limit exceeded *)

     

       1464
       +
                 let smaller_chunk_size = min chunk_size 1024 in

     

       1465
       +
                 let rec read_smaller () =

     

       1466
       +
                   try

     

       1467
       +
                     let chunk = Eio.Buf_read.take smaller_chunk_size buf_reader in

     

       1468
       +
                     if String.length chunk > 0 then (

     

       1469
       +
                       Flow.copy_string chunk sink;

     

       1470
       +
                       read_smaller ()

     

       1471
       +
                     )

     

       1472
       +
                   with End_of_file -> ()

     

       1473
       +
                 in

     

       1474
       +
                 read_smaller ()

     

       1475
        
           in

     

       1476
       +
           stream_chunks ()

     

       1477
       +
       

     

       1478
        
       

     

       1479
        
         let iter_response ?(chunk_size=8192) response ~f =

     

       1480
       +
           (* Use the body_stream if available, otherwise process the body string *)

     

       1481
       +
           match response.Response.body_stream with

     

       1482
       +
           | Some buf_reader ->

     

       1483
       +
               let rec iter_stream () =

     

       1484
       +
                 try

     

       1485
       +
                   let chunk = Eio.Buf_read.take chunk_size buf_reader in

     

       1486
       +
                   if String.length chunk > 0 then (

     

       1487
       +
                     f chunk;

     

       1488
       +
                     iter_stream ()

     

       1489
       +
                   )

     

       1490
       +
                 with

     

       1491
       +
                 | End_of_file -> ()

     

       1492
       +
                 | Eio.Buf_read.Buffer_limit_exceeded ->

     

       1493
       +
                     let smaller_chunk_size = min chunk_size 1024 in

     

       1494
       +
                     let rec read_smaller () =

     

       1495
       +
                       try

     

       1496
       +
                         let chunk = Eio.Buf_read.take smaller_chunk_size buf_reader in

     

       1497
       +
                         if String.length chunk > 0 then (

     

       1498
       +
                           f chunk;

     

       1499
       +
                           read_smaller ()

     

       1500
       +
                         )

     

       1501
       +
                       with End_of_file -> ()

     

       1502
       +
                     in

     

       1503
       +
                     read_smaller ()

     

       1504
       +
               in

     

       1505
       +
               iter_stream ()

     

       1506
       +
           | None ->

     

       1507
       +
               (* Fallback to processing the body string in chunks *)

     

       1508
       +
               let body = Response.body response in

     

       1509
       +
               let rec iter pos =

     

       1510
       +
                 if pos < String.length body then

     

       1511
       +
                   let len = min chunk_size (String.length body - pos) in

     

       1512
       +
                   let chunk = String.sub body pos len in

     

       1513
       +
                   f chunk;

     

       1514
       +
                   iter (pos + len)

     

       1515
       +
               in

     

       1516
       +
               iter 0

     

       1517
        
       

     

       1518
        
         let lines ?(chunk_size=8192) ?(keep_ends=false) response =

     

       1519
        
           let body = Response.body response in

     
···

       1555
        
                 Log.warn (fun m -> m "Failed to parse JSON line: %s" line);

     

       1556
        
                 `Null)

     

       1557
        
       end

     

       1558
       +
       

     

       1559
       +
       (* Download utility functions using Stream module *)

     

       1560
       +
       let download_file ~sw t ?config uri ~path =

     

       1561
       +
         Log.debug (fun m -> m "Downloading file from %s to %s" (Uri.to_string uri) (Eio.Path.native_exn path));

     

       1562
       +
         (* Use streaming download to avoid loading entire file into memory *)

     

       1563
       +
         Eio.Path.with_open_out ~create:(`Or_truncate 0o644) path (fun file ->

     

       1564
       +
           let sink = (file :> Eio.Flow.sink_ty Eio.Resource.t) in

     

       1565
       +
           Stream.download ~sw t ?config uri ~sink

     

       1566
       +
         )

     

       1567
       +
       

     

       1568
       +
       (* Add function for range request support with caching *)

     

       1569
       +
       let download_file_range ~sw t ?config uri ~path ~start_byte ~end_byte =

     

       1570
       +
         Log.debug (fun m -> m "Downloading file range %Ld-%Ld from %s to %s"

     

       1571
       +
           start_byte end_byte (Uri.to_string uri) (Eio.Path.native_exn path));

     

       1572
       +
       

     

       1573
       +
         (* Check if we have this range in cache *)

     

       1574
       +
         let try_cache () =

     

       1575
       +
           match t.cache with

     

       1576
       +
           | Some cache ->

     

       1577
       +
               let range = Requests_cache.Range.{ start = start_byte; end_ = Some end_byte } in

     

       1578
       +
               Requests_cache.download_range cache ~sw ~url:uri ~range

     

       1579
       +
                 ~on_chunk:(fun _data -> ())

     

       1580
       +
           | None -> None

     

       1581
       +
         in

     

       1582
       +
       

     

       1583
       +
         match try_cache () with

     

       1584
       +
         | Some true ->

     

       1585
       +
             Log.debug (fun m -> m "Using cached data for range %Ld-%Ld" start_byte end_byte)

     

       1586
       +
         | Some false | None ->

     

       1587
       +
             (* Fallback to regular range request *)

     

       1588
       +
             let range_header = Printf.sprintf "bytes=%Ld-%Ld" start_byte end_byte in

     

       1589
       +
             let config = match config with

     

       1590
       +
               | Some c -> Some (Config.add_header "Range" range_header c)

     

       1591
       +
               | None -> Some (Config.add_header "Range" range_header Config.default)

     

       1592
       +
             in

     

       1593
       +
       

     

       1594
       +
             (* Download and cache the chunk *)

     

       1595
       +
             let response = get ~sw t ?config uri in

     

       1596
       +
       

     

       1597
       +
             (* Store the chunk in cache if we have one *)

     

       1598
       +
             (match t.cache with

     

       1599
       +
              | Some cache ->

     

       1600
       +
                  let range = Requests_cache.Range.{ start = start_byte; end_ = Some end_byte } in

     

       1601
       +
                  Requests_cache.put_chunk cache ~url:uri ~range ~data:response.Response.body

     

       1602
       +
              | None -> ());

     

       1603
       +
       

     

       1604
       +
             (* Write to file *)

     

       1605
       +
             Eio.Path.with_open_out ~create:(`Or_truncate 0o644) path (fun file ->

     

       1606
       +
               Flow.copy_string response.Response.body (file :> Eio.Flow.sink_ty Eio.Resource.t)

     

       1607
       +
             )

     

       1608
       +
       

     

       1609
       +
       (* Add function for resumable downloads *)

     

       1610
       +
       let download_file_resume ~sw t ?config uri ~path =

     

       1611
       +
         Log.debug (fun m -> m "Attempting resumable download from %s to %s" (Uri.to_string uri) (Eio.Path.native_exn path));

     

       1612
       +
         let start_byte =

     

       1613
       +
           try

     

       1614
       +
             let stat = Eio.Path.stat ~follow:false path in

     

       1615
       +
             Optint.Int63.to_int64 stat.size

     

       1616
       +
           with

     

       1617
       +
           | _ -> 0L

     

       1618
       +
         in

     

       1619
       +
       

     

       1620
       +
         if start_byte > 0L then (

     

       1621
       +
           Log.info (fun m -> m "Resuming download from byte %Ld" start_byte);

     

       1622
       +
           let range_header = Printf.sprintf "bytes=%Ld-" start_byte in

     

       1623
       +
           let config = match config with

     

       1624
       +
             | Some c -> Some (Config.add_header "Range" range_header c)

     

       1625
       +
             | None -> Some (Config.add_header "Range" range_header Config.default)

     

       1626
       +
           in

     

       1627
       +
       

     

       1628
       +
           Eio.Path.with_open_out ~append:true ~create:(`Or_truncate 0o644) path (fun file ->

     

       1629
       +
             let sink = (file :> Eio.Flow.sink_ty Eio.Resource.t) in

     

       1630
       +
             Stream.download ~sw t ?config uri ~sink

     

       1631
       +
           )

     

       1632
       +
         ) else (

     

       1633
       +
           download_file ~sw t ?config uri ~path

     

       1634
       +
         )

     

       1635
        
       

     

       1636
        
       (* Global defaults *)

     

       1637
        
       module Defaults = struct

+83 -1

stack/requests/lib/requests.mli

···

       131
        
         (** Create an insecure TLS config (no certificate verification) *)

     

       132
        
       end

     

       133
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       134
        
       (** Client type *)

     

       135
        
       type 'a t constraint 'a = [> `Generic] Net.ty

     

       136
        
       

     
···

       138
        
       val create :

     

       139
        
         ?tls_config:Tls.config ->

     

       140
        
         ?default_headers:Cohttp.Header.t ->

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       141
        
         clock:_ Eio.Time.clock ->

     

       142
        
         'a Net.t ->

     

       143
        
         'a t

     
···

       277
        
         'a t ->

     

       278
        
         ?config:Config.t ->

     

       279
        
         Uri.t ->

     

       280
       -
         path:string ->

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       281
        
         unit

     

       282
        
       

     

       283
        
       val stream_response :

     
···

       515
        
           sink:Flow.sink_ty Flow.sink ->

     

       516
        
           unit

     

       517
        
         (** Stream download to an Eio Flow sink *)

     

       0
        
       
     

       518
        
       

     

       519
        
         val iter_response :

     

       520
        
           ?chunk_size:int ->

···

       131
        
         (** Create an insecure TLS config (no certificate verification) *)

     

       132
        
       end

     

       133
        
       

     

       134
       +
       (** Shared types module *)

     

       135
       +
       module Requests_types : sig

     

       136
       +
         module Response : sig

     

       137
       +
           type t = {

     

       138
       +
             status : Cohttp.Code.status_code;

     

       139
       +
             headers : Cohttp.Header.t;

     

       140
       +
             body : string;

     

       141
       +
             body_stream : Eio.Buf_read.t option;

     

       142
       +
           }

     

       143
       +
         end

     

       144
       +
       end

     

       145
       +
       

     

       146
       +
       (** HTTP caching module *)

     

       147
       +
       module Requests_cache : sig

     

       148
       +
         type t

     

       149
       +
       

     

       150
       +
         val create :

     

       151
       +
           sw:Eio.Switch.t ->

     

       152
       +
           enabled:bool ->

     

       153
       +
           ?cache_get_requests:bool ->

     

       154
       +
           ?cache_range_requests:bool ->

     

       155
       +
           cache_dir:Eio.Fs.dir_ty Eio.Path.t option ->

     

       156
       +
           unit -> t

     

       157
       +
       

     

       158
       +
         val get : t ->

     

       159
       +
           method_:[`GET | `HEAD | `POST | `PUT | `DELETE | `PATCH | `OPTIONS | `TRACE | `CONNECT] ->

     

       160
       +
           url:Uri.t ->

     

       161
       +
           headers:Cohttp.Header.t ->

     

       162
       +
           Requests_types.Response.t option

     

       163
       +
       

     

       164
       +
         val put : t ->

     

       165
       +
           method_:[`GET | `HEAD | `POST | `PUT | `DELETE | `PATCH | `OPTIONS | `TRACE | `CONNECT] ->

     

       166
       +
           url:Uri.t ->

     

       167
       +
           request_headers:Cohttp.Header.t ->

     

       168
       +
           response:Requests_types.Response.t ->

     

       169
       +
           unit

     

       170
       +
       

     

       171
       +
         val evict : t -> url:Uri.t -> unit

     

       172
       +
         val clear : t -> unit

     

       173
       +
       

     

       174
       +
         module Range : sig

     

       175
       +
           type t = {

     

       176
       +
             start : int64;

     

       177
       +
             end_ : int64 option;

     

       178
       +
           }

     

       179
       +
         end

     

       180
       +
       

     

       181
       +
         val put_chunk : t -> url:Uri.t -> range:Range.t -> data:string -> unit

     

       182
       +
         val has_complete : t -> url:Uri.t -> total_size:int64 -> bool

     

       183
       +
         val missing_ranges : t -> url:Uri.t -> total_size:int64 -> Range.t list

     

       184
       +
       end

     

       185
       +
       

     

       186
        
       (** Client type *)

     

       187
        
       type 'a t constraint 'a = [> `Generic] Net.ty

     

       188
        
       

     
···

       190
        
       val create :

     

       191
        
         ?tls_config:Tls.config ->

     

       192
        
         ?default_headers:Cohttp.Header.t ->

     

       193
       +
         ?cache:Requests_cache.t ->

     

       194
       +
         clock:_ Eio.Time.clock ->

     

       195
       +
         'a Net.t ->

     

       196
       +
         'a t

     

       197
       +
       

     

       198
       +
       (** Create an HTTP client with caching enabled *)

     

       199
       +
       val create_with_cache :

     

       200
       +
         sw:Eio.Switch.t ->

     

       201
       +
         ?tls_config:Tls.config ->

     

       202
       +
         ?default_headers:Cohttp.Header.t ->

     

       203
       +
         cache_dir:Eio.Fs.dir_ty Eio.Path.t option ->

     

       204
        
         clock:_ Eio.Time.clock ->

     

       205
        
         'a Net.t ->

     

       206
        
         'a t

     
···

       340
        
         'a t ->

     

       341
        
         ?config:Config.t ->

     

       342
        
         Uri.t ->

     

       343
       +
         path:Eio.Fs.dir_ty Eio.Path.t ->

     

       344
       +
         unit

     

       345
       +
       

     

       346
       +
       val download_file_range :

     

       347
       +
         sw:Switch.t ->

     

       348
       +
         'a t ->

     

       349
       +
         ?config:Config.t ->

     

       350
       +
         Uri.t ->

     

       351
       +
         path:Eio.Fs.dir_ty Eio.Path.t ->

     

       352
       +
         start_byte:int64 ->

     

       353
       +
         end_byte:int64 ->

     

       354
       +
         unit

     

       355
       +
       

     

       356
       +
       val download_file_resume :

     

       357
       +
         sw:Switch.t ->

     

       358
       +
         'a t ->

     

       359
       +
         ?config:Config.t ->

     

       360
       +
         Uri.t ->

     

       361
       +
         path:Eio.Fs.dir_ty Eio.Path.t ->

     

       362
        
         unit

     

       363
        
       

     

       364
        
       val stream_response :

     
···

       596
        
           sink:Flow.sink_ty Flow.sink ->

     

       597
        
           unit

     

       598
        
         (** Stream download to an Eio Flow sink *)

     

       599
       +
       

     

       600
        
       

     

       601
        
         val iter_response :

     

       602
        
           ?chunk_size:int ->

+504

stack/requests/lib/requests_cache.ml

···

       1
       +
       (** HTTP caching with cacheio integration - separate headers and body storage *)

     

       2
       +
       

     

       3
       +
       open Eio

     

       4
       +
       

     

       5
       +
       module Log = (val Logs.src_log (Logs.Src.create "requests.cache" ~doc:"HTTP cache with cacheio") : Logs.LOG)

     

       6
       +
       

     

       7
       +
       type t = {

     

       8
       +
         sw : Switch.t;

     

       9
       +
         enabled : bool;

     

       10
       +
         cache_get_requests : bool;

     

       11
       +
         cache_range_requests : bool;

     

       12
       +
         cacheio : Cacheio.t option;  (* Optional cacheio backend *)

     

       13
       +
         memory_cache : (string, Requests_types.Response.t * float) Hashtbl.t;  (* Memory cache fallback *)

     

       14
       +
       }

     

       15
       +
       

     

       16
       +
       let create ~sw ~enabled ?(cache_get_requests=true) ?(cache_range_requests=true) ~cache_dir () =

     

       17
       +
         let cacheio =

     

       18
       +
           match cache_dir with

     

       19
       +
           | Some dir when enabled ->

     

       20
       +
               (try

     

       21
       +
                 Some (Cacheio.create ~base_dir:dir)

     

       22
       +
               with e ->

     

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

     

       24
       +
                   (Printexc.to_string e));

     

       25
       +
                 None)

     

       26
       +
           | _ -> None

     

       27
       +
         in

     

       28
       +
         { sw; enabled; cache_get_requests; cache_range_requests;

     

       29
       +
           cacheio; memory_cache = Hashtbl.create 100 }

     

       30
       +
       

     

       31
       +
       (** Generate cache key from method and URL *)

     

       32
       +
       let make_cache_key ~method_ ~url ~headers =

     

       33
       +
         (* Include method, URL, and important headers in cache key *)

     

       34
       +
         let method_str = match method_ with

     

       35
       +
           | `GET -> "GET" | `HEAD -> "HEAD"

     

       36
       +
           | _ -> "OTHER"  (* Don't cache non-idempotent methods *)

     

       37
       +
         in

     

       38
       +
         let url_str = Uri.to_string url in

     

       39
       +
       

     

       40
       +
         (* Include range header if present *)

     

       41
       +
         let range_str = match Cohttp.Header.get headers "range" with

     

       42
       +
           | Some r -> "_range:" ^ r

     

       43
       +
           | None -> ""

     

       44
       +
         in

     

       45
       +
       

     

       46
       +
         Printf.sprintf "%s_%s%s" method_str url_str range_str

     

       47
       +
       

     

       48
       +
       (** Check if a response is cacheable *)

     

       49
       +
       let is_cacheable ~method_ ~status ~headers =

     

       50
       +
         (* Only cache GET and HEAD requests *)

     

       51
       +
         match method_ with

     

       52
       +
         | `GET | `HEAD ->

     

       53
       +
             let code = Cohttp.Code.code_of_status status in

     

       54
       +
             (* Cache successful responses and some redirects *)

     

       55
       +
             if code >= 200 && code < 300 then

     

       56
       +
               (* Check cache-control headers *)

     

       57
       +
               match Cohttp.Header.get headers "cache-control" with

     

       58
       +
               | Some cc ->

     

       59
       +
                   let cc_lower = String.lowercase_ascii cc in

     

       60
       +
                   (* Simple substring search without regex *)

     

       61
       +
                   let rec contains_substring str sub pos =

     

       62
       +
                     if pos + String.length sub > String.length str then false

     

       63
       +
                     else if String.sub str pos (String.length sub) = sub then true

     

       64
       +
                     else contains_substring str sub (pos + 1)

     

       65
       +
                   in

     

       66
       +
                   if contains_substring cc_lower "no-store" 0 ||

     

       67
       +
                      contains_substring cc_lower "no-cache" 0 ||

     

       68
       +
                      contains_substring cc_lower "private" 0 then

     

       69
       +
                     false

     

       70
       +
                   else

     

       71
       +
                     true

     

       72
       +
               | None -> true

     

       73
       +
             else if code = 301 || code = 308 then

     

       74
       +
               true  (* Permanent redirects *)

     

       75
       +
             else

     

       76
       +
               false

     

       77
       +
         | _ -> false

     

       78
       +
       

     

       79
       +
       (** Parse cache-control max-age directive *)

     

       80
       +
       let parse_max_age headers =

     

       81
       +
         match Cohttp.Header.get headers "cache-control" with

     

       82
       +
         | Some cc ->

     

       83
       +
             (* Look for max-age=N *)

     

       84
       +
             let parts = String.split_on_char ',' cc |> List.map String.trim in

     

       85
       +
             List.find_map (fun part ->

     

       86
       +
               let prefix = "max-age=" in

     

       87
       +
               let prefix_len = String.length prefix in

     

       88
       +
               if String.length part >= prefix_len &&

     

       89
       +
                  String.sub part 0 prefix_len = prefix then

     

       90
       +
                 let value = String.sub part prefix_len (String.length part - prefix_len) in

     

       91
       +
                 try Some (float_of_string value) with _ -> None

     

       92
       +
               else None

     

       93
       +
             ) parts

     

       94
       +
         | None -> None

     

       95
       +
       

     

       96
       +
       (** Serialize headers and status to JSON *)

     

       97
       +
       let serialize_metadata ~status ~headers =

     

       98
       +
         let status_code = Cohttp.Code.code_of_status status in

     

       99
       +
         let headers_assoc = Cohttp.Header.to_list headers in

     

       100
       +
         let json = `Assoc [

     

       101
       +
           ("status_code", `Int status_code);

     

       102
       +
           ("headers", `Assoc (List.map (fun (k, v) -> (k, `String v)) headers_assoc));

     

       103
       +
         ] in

     

       104
       +
         Yojson.Basic.to_string json

     

       105
       +
       

     

       106
       +
       (** Deserialize headers and status from JSON *)

     

       107
       +
       let deserialize_metadata json_str =

     

       108
       +
         try

     

       109
       +
           let json = Yojson.Basic.from_string json_str in

     

       110
       +
           let status_code = json |> Yojson.Basic.Util.member "status_code" |> Yojson.Basic.Util.to_int in

     

       111
       +
           let status = Cohttp.Code.status_of_code status_code in

     

       112
       +
           let headers_json = json |> Yojson.Basic.Util.member "headers" |> Yojson.Basic.Util.to_assoc in

     

       113
       +
           let headers = headers_json |> List.map (fun (k, v) ->

     

       114
       +
             (k, Yojson.Basic.Util.to_string v)

     

       115
       +
           ) |> Cohttp.Header.of_list in

     

       116
       +
           Some (status, headers)

     

       117
       +
         with _ -> None

     

       118
       +
       

     

       119
       +
       (** Get cached response if available and not expired *)

     

       120
       +
       let get t ~method_ ~url ~headers =

     

       121
       +
         if not t.enabled then None

     

       122
       +
         else if method_ = `GET && not t.cache_get_requests then None

     

       123
       +
         else

     

       124
       +
           let key = make_cache_key ~method_ ~url ~headers in

     

       125
       +
       

     

       126
       +
           (* Try cacheio first *)

     

       127
       +
           match t.cacheio with

     

       128
       +
           | Some cache ->

     

       129
       +
               (* Check for metadata entry *)

     

       130
       +
               let metadata_key = key ^ ".meta" in

     

       131
       +
               let body_key = key ^ ".body" in

     

       132
       +
       

     

       133
       +
               if Cacheio.exists cache ~key:metadata_key && Cacheio.exists cache ~key:body_key then

     

       134
       +
                 Switch.run @@ fun sw ->

     

       135
       +
                 (* Read metadata *)

     

       136
       +
                 let metadata_opt = match Cacheio.get cache ~key:metadata_key ~sw with

     

       137
       +
                   | Some source ->

     

       138
       +
                       let buf = Buffer.create 256 in

     

       139
       +
                       let rec read_all () =

     

       140
       +
                         let chunk = Cstruct.create 1024 in

     

       141
       +
                         try

     

       142
       +
                           let n = Flow.single_read source chunk in

     

       143
       +
                           if n > 0 then begin

     

       144
       +
                             Buffer.add_string buf (Cstruct.to_string ~off:0 ~len:n chunk);

     

       145
       +
                             read_all ()

     

       146
       +
                           end

     

       147
       +
                         with End_of_file -> ()

     

       148
       +
                       in

     

       149
       +
                       read_all ();

     

       150
       +
                       deserialize_metadata (Buffer.contents buf)

     

       151
       +
                   | None -> None

     

       152
       +
                 in

     

       153
       +
       

     

       154
       +
                 (match metadata_opt with

     

       155
       +
                  | Some (status, resp_headers) ->

     

       156
       +
                      (* Read body *)

     

       157
       +
                      (match Cacheio.get cache ~key:body_key ~sw with

     

       158
       +
                       | Some source ->

     

       159
       +
                           let buf = Buffer.create 4096 in

     

       160
       +
                           let rec read_all () =

     

       161
       +
                             let chunk = Cstruct.create 4096 in

     

       162
       +
                             try

     

       163
       +
                               let n = Flow.single_read source chunk in

     

       164
       +
                               if n > 0 then begin

     

       165
       +
                                 Buffer.add_string buf (Cstruct.to_string ~off:0 ~len:n chunk);

     

       166
       +
                                 read_all ()

     

       167
       +
                               end

     

       168
       +
                             with End_of_file -> ()

     

       169
       +
                           in

     

       170
       +
                           read_all ();

     

       171
       +
                           let body = Buffer.contents buf in

     

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

     

       173
       +
                           Some { Requests_types.Response.status; headers = resp_headers; body; body_stream = None }

     

       174
       +
                       | None ->

     

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

     

       176
       +
                           None)

     

       177
       +
                  | None ->

     

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

     

       179
       +
                      None)

     

       180
       +
               else

     

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

     

       182
       +
                  None)

     

       183
       +
           | None ->

     

       184
       +
               (* Fall back to memory cache *)

     

       185
       +
               match Hashtbl.find_opt t.memory_cache key with

     

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

     

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

     

       188
       +
                   Some response

     

       189
       +
               | _ ->

     

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

     

       191
       +
                   None

     

       192
       +
       

     

       193
       +
       (** Get cached response body as stream *)

     

       194
       +
       let get_stream t ~method_ ~url ~headers ~sw =

     

       195
       +
         if not t.enabled then None

     

       196
       +
         else if method_ = `GET && not t.cache_get_requests then None

     

       197
       +
         else

     

       198
       +
           let key = make_cache_key ~method_ ~url ~headers in

     

       199
       +
       

     

       200
       +
           match t.cacheio with

     

       201
       +
           | Some cache ->

     

       202
       +
               let metadata_key = key ^ ".meta" in

     

       203
       +
               let body_key = key ^ ".body" in

     

       204
       +
       

     

       205
       +
               if Cacheio.exists cache ~key:metadata_key && Cacheio.exists cache ~key:body_key then

     

       206
       +
                 (* Read metadata first *)

     

       207
       +
                 let metadata_opt =

     

       208
       +
                   match Cacheio.get cache ~key:metadata_key ~sw with

     

       209
       +
                   | Some source ->

     

       210
       +
                       let buf = Buffer.create 256 in

     

       211
       +
                       let rec read_all () =

     

       212
       +
                         let chunk = Cstruct.create 1024 in

     

       213
       +
                         try

     

       214
       +
                           let n = Flow.single_read source chunk in

     

       215
       +
                           if n > 0 then begin

     

       216
       +
                             Buffer.add_string buf (Cstruct.to_string ~off:0 ~len:n chunk);

     

       217
       +
                             read_all ()

     

       218
       +
                           end

     

       219
       +
                         with End_of_file -> ()

     

       220
       +
                       in

     

       221
       +
                       read_all ();

     

       222
       +
                       deserialize_metadata (Buffer.contents buf)

     

       223
       +
                   | None -> None

     

       224
       +
                 in

     

       225
       +
       

     

       226
       +
                 (match metadata_opt with

     

       227
       +
                  | Some (status, resp_headers) ->

     

       228
       +
                      (* Return body stream directly *)

     

       229
       +
                      (match Cacheio.get cache ~key:body_key ~sw with

     

       230
       +
                       | Some source ->

     

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

     

       232
       +
                           Some (status, resp_headers, source)

     

       233
       +
                       | None -> None)

     

       234
       +
                  | None -> None)

     

       235
       +
               else None

     

       236
       +
           | None -> None

     

       237
       +
       

     

       238
       +
       (** Store response in cache *)

     

       239
       +
       let put t ~method_ ~url ~request_headers ~response =

     

       240
       +
         if not t.enabled then ()

     

       241
       +
         else if is_cacheable ~method_ ~status:response.Requests_types.Response.status ~headers:response.headers then

     

       242
       +
           let key = make_cache_key ~method_ ~url ~headers:request_headers in

     

       243
       +
           let ttl = parse_max_age response.headers in

     

       244
       +
       

     

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

     

       246
       +
             (Uri.to_string url)

     

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

     

       248
       +
       

     

       249
       +
           (* Store in cacheio if available *)

     

       250
       +
           (match t.cacheio with

     

       251
       +
            | Some cache ->

     

       252
       +
                Switch.run @@ fun _sw ->

     

       253
       +
       

     

       254
       +
                (* Store metadata *)

     

       255
       +
                let metadata_key = key ^ ".meta" in

     

       256
       +
                let metadata = serialize_metadata ~status:response.status ~headers:response.headers in

     

       257
       +
                let metadata_source = Flow.string_source metadata in

     

       258
       +
                Cacheio.put cache ~key:metadata_key ~source:metadata_source ~ttl ();

     

       259
       +
       

     

       260
       +
                (* Store body *)

     

       261
       +
                let body_key = key ^ ".body" in

     

       262
       +
                let body_source = Flow.string_source response.body in

     

       263
       +
                Cacheio.put cache ~key:body_key ~source:body_source ~ttl ()

     

       264
       +
            | None -> ());

     

       265
       +
       

     

       266
       +
           (* Also store in memory cache as fallback *)

     

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

     

       268
       +
           Hashtbl.replace t.memory_cache key (response, expiry)

     

       269
       +
       

     

       270
       +
       (** Store response with streaming body *)

     

       271
       +
       let put_stream t ~method_ ~url ~request_headers ~status ~headers ~body_source ~ttl =

     

       272
       +
         if not t.enabled then ()

     

       273
       +
         else if is_cacheable ~method_ ~status ~headers then

     

       274
       +
           let key = make_cache_key ~method_ ~url ~headers:request_headers in

     

       275
       +
       

     

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

     

       277
       +
             (Uri.to_string url)

     

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

     

       279
       +
       

     

       280
       +
           match t.cacheio with

     

       281
       +
           | Some cache ->

     

       282
       +
               Switch.run @@ fun _sw ->

     

       283
       +
       

     

       284
       +
               (* Store metadata *)

     

       285
       +
               let metadata_key = key ^ ".meta" in

     

       286
       +
               let metadata = serialize_metadata ~status ~headers in

     

       287
       +
               let metadata_source = Flow.string_source metadata in

     

       288
       +
               Cacheio.put cache ~key:metadata_key ~source:metadata_source ~ttl ();

     

       289
       +
       

     

       290
       +
               (* Store body directly from source *)

     

       291
       +
               let body_key = key ^ ".body" in

     

       292
       +
               Cacheio.put cache ~key:body_key ~source:body_source ~ttl ()

     

       293
       +
           | None -> ()

     

       294
       +
       

     

       295
       +
       (** Range request support - exposed module *)

     

       296
       +
       module Range = struct

     

       297
       +
         type t = {

     

       298
       +
           start : int64;

     

       299
       +
           end_ : int64 option;  (* None means to end of file *)

     

       300
       +
         }

     

       301
       +
       

     

       302
       +
         let of_header header =

     

       303
       +
           (* Parse Range: bytes=start-end *)

     

       304
       +
           let prefix = "bytes=" in

     

       305
       +
           let prefix_len = String.length prefix in

     

       306
       +
           if String.length header >= prefix_len &&

     

       307
       +
              String.sub header 0 prefix_len = prefix then

     

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

     

       309
       +
             match String.split_on_char '-' range_str with

     

       310
       +
             | [start; ""] ->

     

       311
       +
                 (* bytes=N- means from N to end *)

     

       312
       +
                 (try Some { start = Int64.of_string start; end_ = None }

     

       313
       +
                  with _ -> None)

     

       314
       +
             | [start; end_] ->

     

       315
       +
                 (* bytes=N-M *)

     

       316
       +
                 (try Some {

     

       317
       +
                   start = Int64.of_string start;

     

       318
       +
                   end_ = Some (Int64.of_string end_)

     

       319
       +
                 }

     

       320
       +
                  with _ -> None)

     

       321
       +
             | _ -> None

     

       322
       +
           else None

     

       323
       +
       

     

       324
       +
         let to_header t =

     

       325
       +
           match t.end_ with

     

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

     

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

     

       328
       +
       

     

       329
       +
         let to_cacheio_range t ~total_size =

     

       330
       +
           let end_ = match t.end_ with

     

       331
       +
             | None -> Int64.pred total_size

     

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

     

       333
       +
           in

     

       334
       +
           (* Convert to Cacheio.Range.t *)

     

       335
       +
           Cacheio.Range.create ~start:t.start ~end_

     

       336
       +
       end

     

       337
       +
       

     

       338
       +
       (** Download with range request support and caching *)

     

       339
       +
       let download_range t ~sw ~url ~range ~on_chunk =

     

       340
       +
         let range_header = Range.to_header range in

     

       341
       +
       

     

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

     

       343
       +
           (Uri.to_string url) range_header);

     

       344
       +
       

     

       345
       +
         (* Check if we have cached data for this range *)

     

       346
       +
         match t.cacheio with

     

       347
       +
         | Some cache ->

     

       348
       +
             let key = Uri.to_string url in

     

       349
       +
             (* Convert our range to cacheio range - we need the total size *)

     

       350
       +
             (* For now, assume a large file size as we don't know the actual size *)

     

       351
       +
             let cacheio_range = Range.to_cacheio_range range ~total_size:Int64.max_int in

     

       352
       +
       

     

       353
       +
             (match Cacheio.get_range cache ~key ~range:cacheio_range ~sw with

     

       354
       +
              | `Complete source ->

     

       355
       +
                  (* Read chunks from the complete cached file *)

     

       356
       +
                  let rec read_chunks () =

     

       357
       +
                    let chunk = Cstruct.create 8192 in

     

       358
       +
                    try

     

       359
       +
                      let n = Flow.single_read source chunk in

     

       360
       +
                      if n > 0 then begin

     

       361
       +
                        on_chunk (Cstruct.to_string ~off:0 ~len:n chunk);

     

       362
       +
                        read_chunks ()

     

       363
       +
                      end

     

       364
       +
                    with End_of_file -> ()

     

       365
       +
                  in

     

       366
       +
                  read_chunks ();

     

       367
       +
                  Some true

     

       368
       +
              | `Chunks chunk_sources ->

     

       369
       +
                  (* Read from multiple chunk sources *)

     

       370
       +
                  List.iter (fun (_range, source) ->

     

       371
       +
                    let rec read_chunk () =

     

       372
       +
                      let chunk = Cstruct.create 8192 in

     

       373
       +
                      try

     

       374
       +
                        let n = Flow.single_read source chunk in

     

       375
       +
                        if n > 0 then begin

     

       376
       +
                          on_chunk (Cstruct.to_string ~off:0 ~len:n chunk);

     

       377
       +
                          read_chunk ()

     

       378
       +
                        end

     

       379
       +
                      with End_of_file -> ()

     

       380
       +
                    in

     

       381
       +
                    read_chunk ()

     

       382
       +
                  ) chunk_sources;

     

       383
       +
                  Some true

     

       384
       +
              | `Not_found ->

     

       385
       +
                  None)

     

       386
       +
         | None ->

     

       387
       +
             (* No cacheio backend available *)

     

       388
       +
             None

     

       389
       +
       

     

       390
       +
       (** Store a response chunk in cache *)

     

       391
       +
       let put_chunk t ~url ~range ~data =

     

       392
       +
         if not t.enabled || not t.cache_range_requests then ()

     

       393
       +
         else

     

       394
       +
           match t.cacheio with

     

       395
       +
           | Some cache ->

     

       396
       +
               let key = Uri.to_string url in

     

       397
       +
               (* Convert our range to cacheio range *)

     

       398
       +
               let cacheio_range = Range.to_cacheio_range range ~total_size:Int64.max_int in

     

       399
       +
       

     

       400
       +
               Switch.run @@ fun _sw ->

     

       401
       +
               let source = Flow.string_source data in

     

       402
       +
               Cacheio.put_chunk cache ~key ~range:cacheio_range ~source ()

     

       403
       +
           | None ->

     

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

     

       405
       +
                 (Uri.to_string url))

     

       406
       +
       

     

       407
       +
       (** Check if we have complete cached data for a URL *)

     

       408
       +
       let has_complete t ~url ~total_size =

     

       409
       +
         if not t.enabled then false

     

       410
       +
         else

     

       411
       +
           match t.cacheio with

     

       412
       +
           | Some cache ->

     

       413
       +
               let key = Uri.to_string url in

     

       414
       +
               Cacheio.has_complete_chunks cache ~key ~total_size

     

       415
       +
           | None -> false

     

       416
       +
       

     

       417
       +
       (** Get missing ranges for a URL *)

     

       418
       +
       let missing_ranges t ~url ~total_size =

     

       419
       +
         if not t.enabled then

     

       420
       +
           (* Return full range if cache disabled *)

     

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

     

       422
       +
         else

     

       423
       +
           match t.cacheio with

     

       424
       +
           | Some cache ->

     

       425
       +
               let key = Uri.to_string url in

     

       426
       +
               let cacheio_ranges = Cacheio.missing_ranges cache ~key ~total_size in

     

       427
       +
               (* Convert Cacheio.Range.t to our Range.t *)

     

       428
       +
               List.map (fun r ->

     

       429
       +
                 { Range.start = Cacheio.Range.start r;

     

       430
       +
                   end_ = Some (Cacheio.Range.end_ r) }

     

       431
       +
               ) cacheio_ranges

     

       432
       +
           | None ->

     

       433
       +
               (* No cache, need full range *)

     

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

     

       435
       +
       

     

       436
       +
       (** Coalesce chunks into a complete file *)

     

       437
       +
       let coalesce_chunks t ~url =

     

       438
       +
         if not t.enabled then false

     

       439
       +
         else

     

       440
       +
           match t.cacheio with

     

       441
       +
           | Some cache ->

     

       442
       +
               let key = Uri.to_string url in

     

       443
       +
               (* Run coalescing synchronously *)

     

       444
       +
               let promise = Cacheio.coalesce_chunks cache ~key ~verify:true () in

     

       445
       +
               (match Eio.Promise.await promise with

     

       446
       +
                | Ok () ->

     

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

     

       448
       +
                    true

     

       449
       +
                | Error exn ->

     

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

     

       451
       +
                      key (Printexc.to_string exn));

     

       452
       +
                    false)

     

       453
       +
           | None -> false

     

       454
       +
       

     

       455
       +
       (** Clear cache for a specific URL *)

     

       456
       +
       let evict t ~url =

     

       457
       +
         if not t.enabled then ()

     

       458
       +
         else

     

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

     

       460
       +
           (* Evict from cacheio - both metadata and body *)

     

       461
       +
           (match t.cacheio with

     

       462
       +
            | Some cache ->

     

       463
       +
                Cacheio.delete cache ~key:(key ^ ".meta");

     

       464
       +
                Cacheio.delete cache ~key:(key ^ ".body")

     

       465
       +
            | None -> ());

     

       466
       +
           (* Evict from memory cache *)

     

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

     

       468
       +
           Hashtbl.remove t.memory_cache key

     

       469
       +
       

     

       470
       +
       (** Clear entire cache *)

     

       471
       +
       let clear t =

     

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

     

       473
       +
         (* Clear cacheio *)

     

       474
       +
         (match t.cacheio with

     

       475
       +
          | Some cache -> Cacheio.clear cache

     

       476
       +
          | None -> ());

     

       477
       +
         (* Clear memory cache *)

     

       478
       +
         Hashtbl.clear t.memory_cache

     

       479
       +
       

     

       480
       +
       (** Get cache statistics *)

     

       481
       +
       let stats t =

     

       482
       +
         let cacheio_stats =

     

       483
       +
           match t.cacheio with

     

       484
       +
           | Some cache ->

     

       485
       +
               let stats = Cacheio.stats cache in

     

       486
       +
               `Assoc [

     

       487
       +
                 ("total_entries", `Int (Cacheio.Stats.entry_count stats));

     

       488
       +
                 ("total_bytes", `Int (Int64.to_int (Cacheio.Stats.total_size stats)));

     

       489
       +
                 ("expired_entries", `Int (Cacheio.Stats.expired_count stats));

     

       490
       +
                 ("pinned_entries", `Int (Cacheio.Stats.pinned_count stats));

     

       491
       +
                 ("temporary_entries", `Int (Cacheio.Stats.temporary_count stats));

     

       492
       +
               ]

     

       493
       +
           | None ->

     

       494
       +
               `Assoc []

     

       495
       +
         in

     

       496
       +
       

     

       497
       +
         `Assoc [

     

       498
       +
           ("memory_cache_entries", `Int (Hashtbl.length t.memory_cache));

     

       499
       +
           ("cache_backend", `String (if Option.is_some t.cacheio then "cacheio" else "memory"));

     

       500
       +
           ("enabled", `Bool t.enabled);

     

       501
       +
           ("cache_get_requests", `Bool t.cache_get_requests);

     

       502
       +
           ("cache_range_requests", `Bool t.cache_range_requests);

     

       503
       +
           ("cacheio_stats", cacheio_stats);

     

       504
       +
         ]

+34

stack/requests/lib/requests_types.ml

···

       1
       +
       (** Shared types for the requests library *)

     

       2
       +
       

     

       3
       +
       module Response = struct

     

       4
       +
         type t = {

     

       5
       +
           status : Cohttp.Code.status_code;

     

       6
       +
           headers : Cohttp.Header.t;

     

       7
       +
           body : string;

     

       8
       +
           body_stream : Eio.Buf_read.t option;

     

       9
       +
         }

     

       10
       +
       

     

       11
       +
         let status t = t.status

     

       12
       +
         let headers t = t.headers

     

       13
       +
         let body t = t.body

     

       14
       +
         let body_stream t =

     

       15
       +
           match t.body_stream with

     

       16
       +
           | Some s -> s

     

       17
       +
           | None -> Eio.Buf_read.of_string t.body

     

       18
       +
       

     

       19
       +
         let is_success t =

     

       20
       +
           let code = Cohttp.Code.code_of_status t.status in

     

       21
       +
           code >= 200 && code < 300

     

       22
       +
       

     

       23
       +
         let is_redirect t =

     

       24
       +
           let code = Cohttp.Code.code_of_status t.status in

     

       25
       +
           code >= 300 && code < 400

     

       26
       +
       

     

       27
       +
         let is_client_error t =

     

       28
       +
           let code = Cohttp.Code.code_of_status t.status in

     

       29
       +
           code >= 400 && code < 500

     

       30
       +
       

     

       31
       +
         let is_server_error t =

     

       32
       +
           let code = Cohttp.Code.code_of_status t.status in

     

       33
       +
           code >= 500 && code < 600

     

       34
       +
       end

+4 -4

stack/requests/test/dune

···

       1
       -
       (executable

     

       2
       -
        (public_name test_requests)

     

       3
       -
        (name test_requests)

     

       4
       -
        (libraries requests eio_main ca-certs))

···

       1
       +
       (executables

     

       2
       +
        (public_names test_requests test_streaming test_cache test_simple_cache test_cache_integration)

     

       3
       +
        (names test_requests test_streaming test_cache test_simple_cache test_cache_integration)

     

       4
       +
        (libraries requests eio_main ca-certs uri yojson cacheio))

+226

stack/requests/test/test_cache.ml

···

       1
       +
       (** Test cacheio integration with requests library *)

     

       2
       +
       

     

       3
       +
       open Eio

     

       4
       +
       

     

       5
       +
       let test_basic_caching () =

     

       6
       +
         Eio_main.run @@ fun env ->

     

       7
       +
         Switch.run @@ fun sw ->

     

       8
       +
       

     

       9
       +
         (* Create a temporary cache directory *)

     

       10
       +
         let cache_dir = Path.(env#fs / "/tmp/test_requests_cache") in

     

       11
       +
       

     

       12
       +
         (* Clean up any existing test directory *)

     

       13
       +
         (try

     

       14
       +
           Eio.Process.run env#process_mgr ["rm"; "-rf"; "/tmp/test_requests_cache"]

     

       15
       +
         with _ -> ());

     

       16
       +
       

     

       17
       +
         (* Create requests client with caching enabled *)

     

       18
       +
         let client = Requests.create_with_cache ~sw ~cache_dir:(Some cache_dir)

     

       19
       +
           ~clock:env#clock env#net in

     

       20
       +
       

     

       21
       +
         (* Test URL - using a small file from a reliable source *)

     

       22
       +
         let url = Uri.of_string "https://www.w3.org/WAI/ER/tests/xhtml/testfiles/resources/pdf/dummy.pdf" in

     

       23
       +
       

     

       24
       +
         Printf.printf "Test 1: First request (cache miss)...\n";

     

       25
       +
         let start_time = Unix.gettimeofday () in

     

       26
       +
         let response1 = Requests.get ~sw client url in

     

       27
       +
         let first_time = Unix.gettimeofday () -. start_time in

     

       28
       +
         Printf.printf "  Status: %s\n" (Cohttp.Code.string_of_status ((Requests.Response.status response1)));

     

       29
       +
         Printf.printf "  Body size: %d bytes\n" (String.length ((Requests.Response.body response1)));

     

       30
       +
         Printf.printf "  Time: %.3fs\n" first_time;

     

       31
       +
       

     

       32
       +
         Printf.printf "\nTest 2: Second request (should be cached)...\n";

     

       33
       +
         let start_time = Unix.gettimeofday () in

     

       34
       +
         let response2 = Requests.get ~sw client url in

     

       35
       +
         let second_time = Unix.gettimeofday () -. start_time in

     

       36
       +
         Printf.printf "  Status: %s\n" (Cohttp.Code.string_of_status (Requests.Response.status response2));

     

       37
       +
         Printf.printf "  Body size: %d bytes\n" (String.length (Requests.Response.body response2));

     

       38
       +
         Printf.printf "  Time: %.3fs\n" second_time;

     

       39
       +
       

     

       40
       +
         (* Verify responses are identical *)

     

       41
       +
         assert ((Requests.Response.body response1) = (Requests.Response.body response2));

     

       42
       +
         assert ((Requests.Response.status response1) = (Requests.Response.status response2));

     

       43
       +
       

     

       44
       +
         (* Cache should be significantly faster *)

     

       45
       +
         Printf.printf "\nCache speedup: %.1fx faster\n" (first_time /. second_time);

     

       46
       +
       

     

       47
       +
         (* Check that cache directory was created and has files *)

     

       48
       +
         let cache_files = ref 0 in

     

       49
       +
         let rec count_files dir =

     

       50
       +
           try

     

       51
       +
             let entries = Path.read_dir dir in

     

       52
       +
             List.iter (fun entry ->

     

       53
       +
               let path = Path.(dir / entry) in

     

       54
       +
               match Path.kind ~follow:false path with

     

       55
       +
               | `Directory -> count_files path

     

       56
       +
               | `Regular_file -> incr cache_files

     

       57
       +
               | _ -> ()

     

       58
       +
             ) entries

     

       59
       +
           with _ -> ()

     

       60
       +
         in

     

       61
       +
         count_files cache_dir;

     

       62
       +
         Printf.printf "\nCache contains %d file(s)\n" !cache_files;

     

       63
       +
         assert (!cache_files > 0);

     

       64
       +
       

     

       65
       +
         Printf.printf "\nBasic caching test passed! ✓\n"

     

       66
       +
       

     

       67
       +
       let test_range_requests () =

     

       68
       +
         Eio_main.run @@ fun env ->

     

       69
       +
         Switch.run @@ fun sw ->

     

       70
       +
       

     

       71
       +
         (* Create a temporary cache directory *)

     

       72
       +
         let cache_dir = Path.(env#fs / "/tmp/test_requests_cache_range") in

     

       73
       +
       

     

       74
       +
         (* Clean up any existing test directory *)

     

       75
       +
         (try

     

       76
       +
           Eio.Process.run env#process_mgr ["rm"; "-rf"; "/tmp/test_requests_cache_range"]

     

       77
       +
         with _ -> ());

     

       78
       +
       

     

       79
       +
         (* Create requests client with caching enabled *)

     

       80
       +
         let client = Requests.create_with_cache ~sw ~cache_dir:(Some cache_dir)

     

       81
       +
           ~clock:env#clock env#net in

     

       82
       +
       

     

       83
       +
         (* Test URL *)

     

       84
       +
         let url = Uri.of_string "https://www.w3.org/WAI/ER/tests/xhtml/testfiles/resources/pdf/dummy.pdf" in

     

       85
       +
       

     

       86
       +
         Printf.printf "Test 1: Download first 1000 bytes...\n";

     

       87
       +
         let out_path1 = Path.(env#fs / "/tmp/test_range_1.dat") in

     

       88
       +
         Requests.download_file_range ~sw client url ~path:out_path1 ~start_byte:0L ~end_byte:999L;

     

       89
       +
       

     

       90
       +
         (* Check file was created *)

     

       91
       +
         let stat1 = Path.stat ~follow:false out_path1 in

     

       92
       +
         let size1 = Optint.Int63.to_int64 stat1.size in

     

       93
       +
         Printf.printf "  Downloaded %Ld bytes\n" size1;

     

       94
       +
         assert (size1 <= 1000L);

     

       95
       +
       

     

       96
       +
         Printf.printf "\nTest 2: Download bytes 500-1499...\n";

     

       97
       +
         let out_path2 = Path.(env#fs / "/tmp/test_range_2.dat") in

     

       98
       +
         Requests.download_file_range ~sw client url ~path:out_path2 ~start_byte:500L ~end_byte:1499L;

     

       99
       +
       

     

       100
       +
         let stat2 = Path.stat ~follow:false out_path2 in

     

       101
       +
         let size2 = Optint.Int63.to_int64 stat2.size in

     

       102
       +
         Printf.printf "  Downloaded %Ld bytes\n" size2;

     

       103
       +
         assert (size2 <= 1000L);

     

       104
       +
       

     

       105
       +
         Printf.printf "\nTest 3: Request same range again (should use cache)...\n";

     

       106
       +
         let start_time = Unix.gettimeofday () in

     

       107
       +
         let out_path3 = Path.(env#fs / "/tmp/test_range_3.dat") in

     

       108
       +
         Requests.download_file_range ~sw client url ~path:out_path3 ~start_byte:500L ~end_byte:1499L;

     

       109
       +
         let cache_time = Unix.gettimeofday () -. start_time in

     

       110
       +
         Printf.printf "  Time: %.3fs\n" cache_time;

     

       111
       +
       

     

       112
       +
         (* Verify files 2 and 3 are identical *)

     

       113
       +
         let content2 = Path.load out_path2 in

     

       114
       +
         let content3 = Path.load out_path3 in

     

       115
       +
         assert (content2 = content3);

     

       116
       +
       

     

       117
       +
         Printf.printf "\nRange request caching test passed! ✓\n"

     

       118
       +
       

     

       119
       +
       let test_cache_headers () =

     

       120
       +
         Eio_main.run @@ fun env ->

     

       121
       +
         Switch.run @@ fun sw ->

     

       122
       +
       

     

       123
       +
         (* Create a temporary cache directory *)

     

       124
       +
         let cache_dir = Path.(env#fs / "/tmp/test_requests_cache_headers") in

     

       125
       +
       

     

       126
       +
         (* Clean up any existing test directory *)

     

       127
       +
         (try

     

       128
       +
           Eio.Process.run env#process_mgr ["rm"; "-rf"; "/tmp/test_requests_cache_headers"]

     

       129
       +
         with _ -> ());

     

       130
       +
       

     

       131
       +
         (* Create requests client with caching enabled *)

     

       132
       +
         let client = Requests.create_with_cache ~sw ~cache_dir:(Some cache_dir)

     

       133
       +
           ~clock:env#clock env#net in

     

       134
       +
       

     

       135
       +
         (* Test with a URL that has cache-control headers *)

     

       136
       +
         let url = Uri.of_string "https://httpbin.org/cache/60" in  (* Cache for 60 seconds *)

     

       137
       +
       

     

       138
       +
         Printf.printf "Test 1: Request with cache-control headers...\n";

     

       139
       +
         let response1 = Requests.get ~sw client url in

     

       140
       +
         Printf.printf "  Status: %s\n" (Cohttp.Code.string_of_status (Requests.Response.status response1));

     

       141
       +
       

     

       142
       +
         (* Check if Cache-Control header is present *)

     

       143
       +
         match Cohttp.Header.get (Requests.Response.headers response1) "cache-control" with

     

       144
       +
         | Some cc ->

     

       145
       +
             Printf.printf "  Cache-Control: %s\n" cc

     

       146
       +
         | None ->

     

       147
       +
             Printf.printf "  No Cache-Control header\n";

     

       148
       +
       

     

       149
       +
         Printf.printf "\nTest 2: Request no-cache URL...\n";

     

       150
       +
         let nocache_url = Uri.of_string "https://httpbin.org/response-headers?Cache-Control=no-cache" in

     

       151
       +
         let response2 = Requests.get ~sw client nocache_url in

     

       152
       +
         Printf.printf "  Status: %s\n" (Cohttp.Code.string_of_status (Requests.Response.status response2));

     

       153
       +
       

     

       154
       +
         match Cohttp.Header.get (Requests.Response.headers response2) "cache-control" with

     

       155
       +
         | Some cc ->

     

       156
       +
             Printf.printf "  Cache-Control: %s\n" cc

     

       157
       +
         | None ->

     

       158
       +
             Printf.printf "  No Cache-Control header\n";

     

       159
       +
       

     

       160
       +
         Printf.printf "\nCache header handling test passed! ✓\n"

     

       161
       +
       

     

       162
       +
       let test_cache_eviction () =

     

       163
       +
         Eio_main.run @@ fun env ->

     

       164
       +
         Switch.run @@ fun sw ->

     

       165
       +
       

     

       166
       +
         (* Create a temporary cache directory *)

     

       167
       +
         let cache_dir = Path.(env#fs / "/tmp/test_requests_cache_evict") in

     

       168
       +
       

     

       169
       +
         (* Clean up any existing test directory *)

     

       170
       +
         (try

     

       171
       +
           Eio.Process.run env#process_mgr ["rm"; "-rf"; "/tmp/test_requests_cache_evict"]

     

       172
       +
         with _ -> ());

     

       173
       +
       

     

       174
       +
         (* Create the cache directly to test eviction *)

     

       175
       +
         let cache = Requests.Requests_cache.create ~sw ~enabled:true ~cache_dir:(Some cache_dir) () in

     

       176
       +
       

     

       177
       +
         let url = Uri.of_string "https://httpbin.org/json" in

     

       178
       +
       

     

       179
       +
         Printf.printf "Test 1: Cache a response...\n";

     

       180
       +
         let response = {

     

       181
       +
           Requests.Requests_types.Response.status = `OK;

     

       182
       +
           headers = Cohttp.Header.init ();

     

       183
       +
           body = "{\"test\": \"data\"}";

     

       184
       +
           body_stream = None;

     

       185
       +
         } in

     

       186
       +
       

     

       187
       +
         Requests.Requests_cache.put cache ~method_:`GET ~url ~request_headers:(Cohttp.Header.init ()) ~response;

     

       188
       +
         Printf.printf "  Response cached\n";

     

       189
       +
       

     

       190
       +
         Printf.printf "\nTest 2: Verify cache hit...\n";

     

       191
       +
         let cached = Requests.Requests_cache.get cache ~method_:`GET ~url ~headers:(Cohttp.Header.init ()) in

     

       192
       +
         assert (cached <> None);

     

       193
       +
         Printf.printf "  Cache hit confirmed\n";

     

       194
       +
       

     

       195
       +
         Printf.printf "\nTest 3: Evict from cache...\n";

     

       196
       +
         Requests.Requests_cache.evict cache ~url;

     

       197
       +
         Printf.printf "  Entry evicted\n";

     

       198
       +
       

     

       199
       +
         Printf.printf "\nTest 4: Verify cache miss after eviction...\n";

     

       200
       +
         let cached2 = Requests.Requests_cache.get cache ~method_:`GET ~url ~headers:(Cohttp.Header.init ()) in

     

       201
       +
         assert (cached2 = None);

     

       202
       +
         Printf.printf "  Cache miss confirmed\n";

     

       203
       +
       

     

       204
       +
         Printf.printf "\nCache eviction test passed! ✓\n"

     

       205
       +
       

     

       206
       +
       let () =

     

       207
       +
         Printf.printf "=== Testing Requests Library with Cacheio ===\n\n";

     

       208
       +
       

     

       209
       +
         Printf.printf "Running basic caching test...\n";

     

       210
       +
         Printf.printf "-----------------------------\n";

     

       211
       +
         test_basic_caching ();

     

       212
       +
       

     

       213
       +
         Printf.printf "\n\nRunning range request test...\n";

     

       214
       +
         Printf.printf "-----------------------------\n";

     

       215
       +
         test_range_requests ();

     

       216
       +
       

     

       217
       +
         Printf.printf "\n\nRunning cache header test...\n";

     

       218
       +
         Printf.printf "-----------------------------\n";

     

       219
       +
         (try test_cache_headers () with e ->

     

       220
       +
           Printf.printf "  Skipped (httpbin may be unreliable): %s\n" (Printexc.to_string e));

     

       221
       +
       

     

       222
       +
         Printf.printf "\n\nRunning cache eviction test...\n";

     

       223
       +
         Printf.printf "-----------------------------\n";

     

       224
       +
         test_cache_eviction ();

     

       225
       +
       

     

       226
       +
         Printf.printf "\n\n=== All tests completed! ===\n"

+136

stack/requests/test/test_cache_integration.ml

···

       1
       +
       (** Test cache integration with cacheio *)

     

       2
       +
       

     

       3
       +
       open Eio

     

       4
       +
       open Requests

     

       5
       +
       

     

       6
       +
       let test_basic_cache ~env =

     

       7
       +
         Switch.run @@ fun sw ->

     

       8
       +
       

     

       9
       +
         (* Create a temporary cache directory *)

     

       10
       +
         let cache_dir = Eio.Path.(env#fs / "/tmp/test_cache") in

     

       11
       +
       

     

       12
       +
         (* Ensure the directory exists *)

     

       13
       +
         (try Eio.Path.mkdir ~perm:0o755 cache_dir

     

       14
       +
          with Eio.Io (Eio.Fs.E (Already_exists _), _) -> ());

     

       15
       +
       

     

       16
       +
         (* Ensure tmp subdirectory exists *)

     

       17
       +
         let tmp_dir = Eio.Path.(cache_dir / "tmp") in

     

       18
       +
         (try Eio.Path.mkdir ~perm:0o755 tmp_dir

     

       19
       +
          with Eio.Io (Eio.Fs.E (Already_exists _), _) -> ());

     

       20
       +
       

     

       21
       +
         (* Create cache with cacheio backend *)

     

       22
       +
         let cache = Requests_cache.create

     

       23
       +
           ~sw

     

       24
       +
           ~enabled:true

     

       25
       +
           ~cache_get_requests:true

     

       26
       +
           ~cache_range_requests:true

     

       27
       +
           ~cache_dir:(Some cache_dir)

     

       28
       +
           ()

     

       29
       +
         in

     

       30
       +
       

     

       31
       +
         (* Test basic operations *)

     

       32
       +
         let url = Uri.of_string "http://example.com/test" in

     

       33
       +
         let headers = Cohttp.Header.init () in

     

       34
       +
       

     

       35
       +
         (* Check cache miss *)

     

       36
       +
         let result = Requests_cache.get cache ~method_:`GET ~url ~headers in

     

       37
       +
         (match result with

     

       38
       +
          | None -> Printf.printf "✓ Cache miss works correctly\n"

     

       39
       +
          | Some r ->

     

       40
       +
              Printf.printf "ERROR: Expected cache miss but got response with body: %s\n" r.body;

     

       41
       +
              assert false);

     

       42
       +
       

     

       43
       +
         (* Store a response *)

     

       44
       +
         let response = {

     

       45
       +
           Requests_types.Response.status = `OK;

     

       46
       +
           headers = Cohttp.Header.of_list [

     

       47
       +
             ("Content-Type", "text/plain");

     

       48
       +
             ("Cache-Control", "max-age=3600")

     

       49
       +
           ];

     

       50
       +
           body = "Test response body";

     

       51
       +
           body_stream = None;

     

       52
       +
         } in

     

       53
       +
       

     

       54
       +
         Requests_cache.put cache ~method_:`GET ~url ~request_headers:headers ~response;

     

       55
       +
         Printf.printf "✓ Cache put works correctly\n";

     

       56
       +
       

     

       57
       +
         (* Check cache hit *)

     

       58
       +
         let cached = Requests_cache.get cache ~method_:`GET ~url ~headers in

     

       59
       +
         assert (cached <> None);

     

       60
       +
         (match cached with

     

       61
       +
          | Some r ->

     

       62
       +
              if r.body = "Test response body" then

     

       63
       +
                Printf.printf "✓ Cache hit works correctly\n"

     

       64
       +
              else begin

     

       65
       +
                Printf.printf "ERROR: Body mismatch. Expected: 'Test response body', Got: '%s'\n" r.body;

     

       66
       +
                assert false

     

       67
       +
              end

     

       68
       +
          | None -> failwith "Expected cache hit");

     

       69
       +
       

     

       70
       +
         (* Test cache eviction *)

     

       71
       +
         Requests_cache.evict cache ~url;

     

       72
       +
         let after_evict = Requests_cache.get cache ~method_:`GET ~url ~headers in

     

       73
       +
         assert (after_evict = None);

     

       74
       +
         Printf.printf "✓ Cache eviction works correctly\n";

     

       75
       +
       

     

       76
       +
         (* Clear cache *)

     

       77
       +
         Requests_cache.clear cache;

     

       78
       +
         Printf.printf "✓ Cache clear works correctly\n"

     

       79
       +
       

     

       80
       +
       let test_range_requests ~env =

     

       81
       +
         Switch.run @@ fun sw ->

     

       82
       +
       

     

       83
       +
         (* Create a temporary cache directory *)

     

       84
       +
         let cache_dir = Eio.Path.(env#fs / "/tmp/test_cache_ranges") in

     

       85
       +
       

     

       86
       +
         (* Ensure the directory exists *)

     

       87
       +
         (try Eio.Path.mkdir ~perm:0o755 cache_dir

     

       88
       +
          with Eio.Io (Eio.Fs.E (Already_exists _), _) -> ());

     

       89
       +
       

     

       90
       +
         (* Ensure tmp subdirectory exists *)

     

       91
       +
         let tmp_dir = Eio.Path.(cache_dir / "tmp") in

     

       92
       +
         (try Eio.Path.mkdir ~perm:0o755 tmp_dir

     

       93
       +
          with Eio.Io (Eio.Fs.E (Already_exists _), _) -> ());

     

       94
       +
       

     

       95
       +
         (* Create cache with range support *)

     

       96
       +
         let cache = Requests_cache.create

     

       97
       +
           ~sw

     

       98
       +
           ~enabled:true

     

       99
       +
           ~cache_range_requests:true

     

       100
       +
           ~cache_dir:(Some cache_dir)

     

       101
       +
           ()

     

       102
       +
         in

     

       103
       +
       

     

       104
       +
         let url = Uri.of_string "http://example.com/largefile" in

     

       105
       +
       

     

       106
       +
         (* Test missing ranges *)

     

       107
       +
         let missing = Requests_cache.missing_ranges cache ~url ~total_size:1000L in

     

       108
       +
         assert (List.length missing = 1);

     

       109
       +
         (match missing with

     

       110
       +
          | [{Requests_cache.Range.start = 0L; end_ = Some 999L}] ->

     

       111
       +
              Printf.printf "✓ Missing ranges works correctly\n"

     

       112
       +
          | _ -> failwith "Unexpected missing ranges");

     

       113
       +
       

     

       114
       +
         (* Store a chunk *)

     

       115
       +
         let range = Requests_cache.Range.{ start = 0L; end_ = Some 99L } in

     

       116
       +
         let data = String.make 100 'A' in

     

       117
       +
         Requests_cache.put_chunk cache ~url ~range ~data;

     

       118
       +
         Printf.printf "✓ Chunk storage works correctly\n";

     

       119
       +
       

     

       120
       +
         (* Check if complete *)

     

       121
       +
         let is_complete = Requests_cache.has_complete cache ~url ~total_size:100L in

     

       122
       +
         Printf.printf "✓ Completeness check: %b\n" is_complete

     

       123
       +
       

     

       124
       +
       let () =

     

       125
       +
         Eio_main.run @@ fun env ->

     

       126
       +
         Printf.printf "Testing cache integration with cacheio...\n";

     

       127
       +
       

     

       128
       +
         (* Test basic cache operations *)

     

       129
       +
         Printf.printf "\n=== Testing basic cache operations ===\n";

     

       130
       +
         test_basic_cache ~env;

     

       131
       +
       

     

       132
       +
         (* Test range request caching *)

     

       133
       +
         Printf.printf "\n=== Testing range request caching ===\n";

     

       134
       +
         test_range_requests ~env;

     

       135
       +
       

     

       136
       +
         Printf.printf "\n✅ All cache integration tests passed!\n"

+28

stack/requests/test/test_rng.ml

···

       1
       +
       (** Test that Mirage crypto RNG is working properly *)

     

       2
       +
       

     

       3
       +
       open Eio

     

       4
       +
       

     

       5
       +
       let test_rng () =

     

       6
       +
         Printf.printf "Testing Mirage crypto RNG usage...\n";

     

       7
       +
       

     

       8
       +
         (* Generate some random values *)

     

       9
       +
         for i = 1 to 5 do

     

       10
       +
           let rand_bytes = Mirage_crypto_rng.generate 8 in

     

       11
       +
           let rand_cstruct = Cstruct.of_string rand_bytes in

     

       12
       +
           let rand_hex = Cstruct.to_hex_string rand_cstruct in

     

       13
       +
           Printf.printf "  Random value %d: %s\n" i rand_hex

     

       14
       +
         done;

     

       15
       +
       

     

       16
       +
         Printf.printf "\nTesting multipart boundary generation...\n";

     

       17
       +
         let module R = Requests in

     

       18
       +
         for i = 1 to 3 do

     

       19
       +
           let boundary = R.Body.choose_boundary () in

     

       20
       +
           Printf.printf "  Boundary %d: %s\n" i boundary

     

       21
       +
         done;

     

       22
       +
       

     

       23
       +
         Printf.printf "\n✓ Mirage crypto RNG working correctly\n"

     

       24
       +
       

     

       25
       +
       let () =

     

       26
       +
         (* Initialize RNG (already done in requests.ml but being explicit) *)

     

       27
       +
         Mirage_crypto_rng_unix.use_default ();

     

       28
       +
         test_rng ()

+11

stack/requests/test/test_rng_simple.ml

···

       1
       +
       (* Simple test for RNG *)

     

       2
       +
       let () =

     

       3
       +
         Mirage_crypto_rng_unix.use_default ();

     

       4
       +
         

     

       5
       +
         for i = 1 to 5 do

     

       6
       +
           let rand = Mirage_crypto_rng.generate 8 in

     

       7
       +
           let hex = Hex.of_string rand |> Hex.to_string in

     

       8
       +
           Printf.printf "Random %d: %s\n" i hex

     

       9
       +
         done;

     

       10
       +
         

     

       11
       +
         Printf.printf "RNG test successful!\n"

+78

stack/requests/test/test_simple_cache.ml

···

       1
       +
       (** Simple test for cacheio integration *)

     

       2
       +
       

     

       3
       +
       open Eio

     

       4
       +
       

     

       5
       +
       let test_simple_caching () =

     

       6
       +
         Eio_main.run @@ fun env ->

     

       7
       +
         Switch.run @@ fun sw ->

     

       8
       +
       

     

       9
       +
         (* Create a temporary cache directory *)

     

       10
       +
         let cache_dir = Path.(env#fs / "/tmp/test_requests_cache_simple") in

     

       11
       +
       

     

       12
       +
         (* Clean up any existing test directory *)

     

       13
       +
         (try

     

       14
       +
           Eio.Process.run env#process_mgr ["rm"; "-rf"; "/tmp/test_requests_cache_simple"]

     

       15
       +
         with _ -> ());

     

       16
       +
       

     

       17
       +
         (* Create cache directly *)

     

       18
       +
         let cache = Requests.Requests_cache.create ~sw ~enabled:true ~cache_dir:(Some cache_dir) () in

     

       19
       +
       

     

       20
       +
         let url = Uri.of_string "https://example.com/test" in

     

       21
       +
         let headers = Cohttp.Header.init () in

     

       22
       +
       

     

       23
       +
         Printf.printf "Test 1: Store a response in cache...\n";

     

       24
       +
         let response = {

     

       25
       +
           Requests.Requests_types.Response.status = `OK;

     

       26
       +
           headers = Cohttp.Header.add headers "content-type" "text/plain";

     

       27
       +
           body = "This is test content from the cache!";

     

       28
       +
           body_stream = None;

     

       29
       +
         } in

     

       30
       +
       

     

       31
       +
         Requests.Requests_cache.put cache ~method_:`GET ~url ~request_headers:headers ~response;

     

       32
       +
         Printf.printf "  Response stored\n";

     

       33
       +
       

     

       34
       +
         Printf.printf "\nTest 2: Retrieve from cache...\n";

     

       35
       +
         match Requests.Requests_cache.get cache ~method_:`GET ~url ~headers with

     

       36
       +
         | Some cached ->

     

       37
       +
             Printf.printf "  Status: %s\n" (Cohttp.Code.string_of_status cached.Requests.Requests_types.Response.status);

     

       38
       +
             Printf.printf "  Body: %s\n" cached.body;

     

       39
       +
             assert (cached.body = response.body)

     

       40
       +
         | None ->

     

       41
       +
             failwith "Expected cache hit but got miss";

     

       42
       +
       

     

       43
       +
         Printf.printf "\nTest 3: Cache miss for different URL...\n";

     

       44
       +
         let other_url = Uri.of_string "https://example.com/other" in

     

       45
       +
         match Requests.Requests_cache.get cache ~method_:`GET ~url:other_url ~headers with

     

       46
       +
         | Some _ -> failwith "Expected cache miss but got hit"

     

       47
       +
         | None -> Printf.printf "  Cache miss confirmed\n";

     

       48
       +
       

     

       49
       +
         Printf.printf "\nTest 4: Test range chunk storage...\n";

     

       50
       +
         let chunk_url = Uri.of_string "https://example.com/largefile" in

     

       51
       +
         let range1 = Requests.Requests_cache.Range.{ start = 0L; end_ = Some 99L } in

     

       52
       +
         let chunk_data1 = String.make 100 'A' in

     

       53
       +
       

     

       54
       +
         Requests.Requests_cache.put_chunk cache ~url:chunk_url ~range:range1 ~data:chunk_data1;

     

       55
       +
         Printf.printf "  Chunk 0-99 stored\n";

     

       56
       +
       

     

       57
       +
         let range2 = Requests.Requests_cache.Range.{ start = 100L; end_ = Some 199L } in

     

       58
       +
         let chunk_data2 = String.make 100 'B' in

     

       59
       +
       

     

       60
       +
         Requests.Requests_cache.put_chunk cache ~url:chunk_url ~range:range2 ~data:chunk_data2;

     

       61
       +
         Printf.printf "  Chunk 100-199 stored\n";

     

       62
       +
       

     

       63
       +
         Printf.printf "\nTest 5: Check for complete chunks...\n";

     

       64
       +
         let has_complete = Requests.Requests_cache.has_complete cache ~url:chunk_url ~total_size:200L in

     

       65
       +
         Printf.printf "  Complete data available: %b\n" has_complete;

     

       66
       +
       

     

       67
       +
         Printf.printf "\nTest 6: Get missing ranges...\n";

     

       68
       +
         let missing = Requests.Requests_cache.missing_ranges cache ~url:chunk_url ~total_size:300L in

     

       69
       +
         Printf.printf "  Missing ranges: %d\n" (List.length missing);

     

       70
       +
         List.iter (fun _range ->

     

       71
       +
           Printf.printf "    (range stub)\n"

     

       72
       +
         ) missing;

     

       73
       +
       

     

       74
       +
         Printf.printf "\nSimple caching test passed! ✓\n"

     

       75
       +
       

     

       76
       +
       let () =

     

       77
       +
         Printf.printf "=== Testing Simple Cache Integration ===\n\n";

     

       78
       +
         test_simple_caching ()

+87

stack/requests/test/test_streaming.ml

···

       1
       +
       open Eio.Std

     

       2
       +
       

     

       3
       +
       (** Simple test for streaming download functionality *)

     

       4
       +
       

     

       5
       +
       let test_basic_streaming env =

     

       6
       +
         traceln "Testing basic streaming download...";

     

       7
       +
       

     

       8
       +
         (* Test with a small URL to verify streaming works *)

     

       9
       +
         let test_url = Uri.of_string "https://httpbin.org/json" in

     

       10
       +
       

     

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

     

       12
       +
           let client = Requests.create ~clock:env#clock env#net in

     

       13
       +
       

     

       14
       +
           (* Test 1: Stream response using stream_response *)

     

       15
       +
           traceln "Test 1: Using stream_response to read data in chunks";

     

       16
       +
           let chunks = ref [] in

     

       17
       +
           Requests.stream_response ~sw client test_url (fun buf_reader ->

     

       18
       +
             try

     

       19
       +
               while true do

     

       20
       +
                 let chunk = Eio.Buf_read.take 64 buf_reader in

     

       21
       +
                 if String.length chunk > 0 then (

     

       22
       +
                   chunks := chunk :: !chunks;

     

       23
       +
                   traceln "Read chunk of %d bytes" (String.length chunk)

     

       24
       +
                 ) else

     

       25
       +
                   raise End_of_file

     

       26
       +
               done

     

       27
       +
             with End_of_file -> ()

     

       28
       +
           );

     

       29
       +
       

     

       30
       +
           let total_bytes = List.fold_left (fun acc chunk -> acc + String.length chunk) 0 !chunks in

     

       31
       +
           traceln "Total bytes read: %d" total_bytes;

     

       32
       +
       

     

       33
       +
           (* Test 2: Stream download to file *)

     

       34
       +
           traceln "Test 2: Using Stream.download to download to file";

     

       35
       +
           let test_file = Eio.Path.(env#fs / "test_download.json") in

     

       36
       +
       

     

       37
       +
           Eio.Path.with_open_out ~create:(`Or_truncate 0o644) test_file (fun file ->

     

       38
       +
             let sink = (file :> Eio.Flow.sink_ty Eio.Resource.t) in

     

       39
       +
             Requests.Stream.download ~sw client test_url ~sink

     

       40
       +
           );

     

       41
       +
       

     

       42
       +
           (* Verify the file was created and has content *)

     

       43
       +
           let file_content = Eio.Path.load test_file in

     

       44
       +
           traceln "Downloaded file size: %d bytes" (String.length file_content);

     

       45
       +
           traceln "File content preview: %s" (String.sub file_content 0 (min 100 (String.length file_content)));

     

       46
       +
       

     

       47
       +
           (* Cleanup *)

     

       48
       +
           (try Eio.Path.unlink test_file with _ -> ());

     

       49
       +
       

     

       50
       +
           traceln "Streaming tests completed successfully!"

     

       51
       +
       

     

       52
       +
       let test_iter_response env =

     

       53
       +
         traceln "Testing iter_response functionality...";

     

       54
       +
       

     

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

     

       56
       +
           let client = Requests.create ~clock:env#clock env#net in

     

       57
       +
           let test_url = Uri.of_string "https://httpbin.org/json" in

     

       58
       +
       

     

       59
       +
           let response = Requests.get ~sw client test_url in

     

       60
       +
       

     

       61
       +
           let chunk_count = ref 0 in

     

       62
       +
           let total_bytes = ref 0 in

     

       63
       +
       

     

       64
       +
           Requests.Stream.iter_response ~chunk_size:32 response ~f:(fun chunk ->

     

       65
       +
             incr chunk_count;

     

       66
       +
             total_bytes := !total_bytes + String.length chunk;

     

       67
       +
             traceln "Chunk %d: %d bytes" !chunk_count (String.length chunk)

     

       68
       +
           );

     

       69
       +
       

     

       70
       +
           traceln "Processed %d chunks, total %d bytes" !chunk_count !total_bytes;

     

       71
       +
           traceln "Original response body size: %d bytes" (String.length (Requests.Response.body response));

     

       72
       +
       

     

       73
       +
           traceln "iter_response test completed successfully!"

     

       74
       +
       

     

       75
       +
       let main env =

     

       76
       +
         traceln "Starting streaming functionality tests...";

     

       77
       +
       

     

       78
       +
         try

     

       79
       +
           test_basic_streaming env;

     

       80
       +
           test_iter_response env;

     

       81
       +
           traceln "All streaming tests passed!";

     

       82
       +
         with

     

       83
       +
         | e ->

     

       84
       +
           traceln "Test failed with exception: %s" (Printexc.to_string e);

     

       85
       +
           raise e

     

       86
       +
       

     

       87
       +
       let () = Eio_main.run main