···
-
(* Include shared types module *)
-
module Requests_types = Requests_types
-
(* Include cache module *)
-
module Requests_cache = Requests_cache
-
(* Initialize the RNG on module load for OAuth and other crypto operations *)
-
let () = Mirage_crypto_rng_unix.use_default ()
-
| Http_error of { status : Cohttp.Code.status_code; body : string; headers : Cohttp.Header.t }
-
| Connection_error of string
-
| Max_retry_error of { url : Uri.t; reason : string }
-
| Proxy_error of string
-
| Protocol_error of string
-
| Header_parsing_error of string
-
| Certificate_verification_error of string
-
let pp_error ppf = function
-
| Http_error { status; body; _ } ->
-
Format.fprintf ppf "HTTP error %s: %s"
-
(Cohttp.Code.string_of_status status) body
-
| Connection_error msg -> Format.fprintf ppf "Connection error: %s" msg
-
| Timeout_error -> Format.fprintf ppf "Request timeout"
-
| Too_many_redirects -> Format.fprintf ppf "Too many redirects"
-
| Max_retry_error { url; reason } ->
-
Format.fprintf ppf "Max retries exceeded for %a: %s" Uri.pp url reason
-
| Pool_exhausted -> Format.fprintf ppf "Connection pool exhausted"
-
| Pool_error msg -> Format.fprintf ppf "Pool error: %s" msg
-
| Proxy_error msg -> Format.fprintf ppf "Proxy error: %s" msg
-
| Protocol_error msg -> Format.fprintf ppf "Protocol error: %s" msg
-
| Header_parsing_error msg -> Format.fprintf ppf "Header parsing error: %s" msg
-
| Certificate_verification_error msg -> Format.fprintf ppf "Certificate error: %s" msg
-
exception Request_error of error
-
let log_src = Logs.Src.create "requests" ~doc:"HTTP requests library"
-
module Log = (val Logs.src_log log_src : Logs.LOG)
-
(* Authentication mechanisms - defined early for use in Config *)
-
| Basic of { username : string; password : string }
-
| DigestAuth of { username : string; password : string; challenge : string option ref }
-
| Bearer of { token : string }
-
consumer_secret : string;
-
token_secret : string option;
-
signature_method : [`HMAC_SHA1 | `HMAC_SHA256 | `PLAINTEXT];
-
client_id : string option;
-
client_secret : string option;
-
| Custom of (meth -> Uri.t -> Cohttp.Header.t -> Cohttp.Header.t)
-
let basic ~username ~password = Basic { username; password }
-
let digest ~username ~password = DigestAuth { username; password; challenge = ref (None : string option) }
-
let bearer ~token = Bearer { token }
-
let oauth1 ~consumer_key ~consumer_secret ?token ?token_secret
-
?(signature_method=`HMAC_SHA1) () =
-
OAuth1 { consumer_key; consumer_secret; token; token_secret; signature_method }
-
let oauth2 ?client_id ?client_secret ?(token_type="Bearer") ~access_token () =
-
OAuth2 { client_id; client_secret; token_type; access_token }
-
let custom f = Custom f
-
let apply auth meth uri headers =
-
| Basic { username; password } ->
-
let encoded = Base64.encode_string (Printf.sprintf "%s:%s" username password) in
-
Cohttp.Header.add headers "Authorization" (Printf.sprintf "Basic %s" encoded)
-
| DigestAuth { username; password; challenge } ->
-
(* Use stored challenge if available, otherwise headers unchanged (will trigger 401) *)
-
| None -> headers (* No challenge yet, will get 401 response *)
-
| Some challenge_header ->
-
(* Apply digest auth with challenge *)
-
Digest_auth.apply_digest_auth ~username ~password ~meth ~uri ~headers ~body:None ~challenge_header)
-
Cohttp.Header.add headers "Authorization" (Printf.sprintf "Bearer %s" token)
-
| OAuth1 { consumer_key; consumer_secret; token; token_secret; signature_method } ->
-
let timestamp = Printf.sprintf "%.0f" (Unix.gettimeofday ()) in
-
(* Generate cryptographically secure nonce using mirage-crypto-rng *)
-
let nonce_bytes = Mirage_crypto_rng.generate 16 in
-
let nonce = Base64.encode_string nonce_bytes in
-
let signature_method_str = match signature_method with
-
| `HMAC_SHA1 -> "HMAC-SHA1"
-
| `HMAC_SHA256 -> "HMAC-SHA256"
-
| `PLAINTEXT -> "PLAINTEXT" in
-
("oauth_consumer_key", consumer_key);
-
("oauth_nonce", nonce);
-
("oauth_signature_method", signature_method_str);
-
("oauth_timestamp", timestamp);
-
("oauth_version", "1.0");
-
| Some t -> [("oauth_token", t)]
-
(* Build signature base string *)
-
let method_str = match meth with
-
| `GET -> "GET" | `POST -> "POST" | `PUT -> "PUT"
-
| `DELETE -> "DELETE" | `HEAD -> "HEAD" | `OPTIONS -> "OPTIONS"
-
let u = Uri.with_port (Uri.with_fragment uri None) None in
-
(Uri.query uri |> List.map (fun (k, vs) ->
-
List.map (fun v -> (k, v)) vs) |> List.flatten) in
-
let sorted_params = List.sort (fun (k1, v1) (k2, v2) ->
-
match String.compare k1 k2 with
-
| 0 -> String.compare v1 v2
-
| n -> n) params_for_sig in
-
let param_string = sorted_params
-
|> List.map (fun (k, v) ->
-
Printf.sprintf "%s=%s" (Uri.pct_encode k) (Uri.pct_encode v))
-
|> String.concat "&" in
-
let base_string = String.concat "&" [
-
Uri.pct_encode method_str;
-
Uri.pct_encode normalized_url;
-
Uri.pct_encode param_string
-
(* Generate signature *)
-
let signature = match signature_method with
-
(Uri.pct_encode consumer_secret)
-
(Uri.pct_encode (Option.value ~default:"" token_secret))
-
let signing_key = Printf.sprintf "%s&%s"
-
(Uri.pct_encode consumer_secret)
-
(Uri.pct_encode (Option.value ~default:"" token_secret)) in
-
let raw_sig = Digestif.SHA1.hmac_string ~key:signing_key base_string in
-
Base64.encode_string (Digestif.SHA1.to_raw_string raw_sig)
-
let signing_key = Printf.sprintf "%s&%s"
-
(Uri.pct_encode consumer_secret)
-
(Uri.pct_encode (Option.value ~default:"" token_secret)) in
-
let raw_sig = Digestif.SHA256.hmac_string ~key:signing_key base_string in
-
Base64.encode_string (Digestif.SHA256.to_raw_string raw_sig)
-
let full_oauth_params = ("oauth_signature", signature) :: oauth_params in
-
let oauth_header = "OAuth " ^ String.concat ", "
-
(List.map (fun (k, v) ->
-
Printf.sprintf "%s=\"%s\"" k (Uri.pct_encode v))
-
(List.sort (fun (k1,_) (k2,_) -> String.compare k1 k2) full_oauth_params)) in
-
Cohttp.Header.add headers "Authorization" oauth_header
-
| OAuth2 { client_id; client_secret; token_type; access_token } ->
-
(* OAuth2 can use client credentials in headers for some flows *)
-
match client_id, client_secret with
-
| Some id, Some secret when id <> "" && secret <> "" ->
-
(* Add client credentials as basic auth for token endpoint requests *)
-
let encoded = Base64.encode_string (Printf.sprintf "%s:%s" id secret) in
-
Cohttp.Header.add headers "X-Client-Authorization" (Printf.sprintf "Basic %s" encoded)
-
Cohttp.Header.add headers "Authorization" (Printf.sprintf "%s %s" token_type access_token)
-
| Custom f -> f meth uri headers
-
module Response = Requests_types.Response
-
(* Retry Implementation *)
-
redirect_location : string option;
-
allowed_methods : meth list;
-
status_forcelist : int list;
-
raise_on_redirect : bool;
-
raise_on_status : bool;
-
respect_retry_after : bool;
-
remove_headers_on_redirect : string list;
-
history : history list;
-
mutable retry_count : int;
-
let default_backoff = { factor = 0.0; jitter = 0.0; max = 120.0 }
-
let default_allowed_methods = [`HEAD; `GET; `PUT; `DELETE; `OPTIONS]
-
let default_remove_headers = ["Cookie"; "Authorization"; "Proxy-Authorization"]
-
allowed_methods = default_allowed_methods;
-
backoff = default_backoff;
-
raise_on_redirect = true;
-
raise_on_status = true;
-
respect_retry_after = true;
-
remove_headers_on_redirect = default_remove_headers;
-
let create ?total ?(connect=None) ?(read=None) ?(redirect=None) ?(status=None) ?(other=None)
-
?(allowed_methods=default_allowed_methods)
-
?(backoff=default_backoff)
-
?(raise_on_redirect=true)
-
?(raise_on_status=true)
-
?(respect_retry_after=true)
-
?(remove_headers_on_redirect=default_remove_headers) () =
-
let total = Option.value total ~default:10 in
-
{ total; connect; read; redirect; status; other;
-
allowed_methods; status_forcelist; backoff;
-
raise_on_redirect; raise_on_status; respect_retry_after;
-
remove_headers_on_redirect; history = []; retry_count = 0 }
-
let disabled = { default with total = 0 }
-
let get_history t = t.history
-
let increment t ~method_ ~url ?response ?error () =
-
let status = Option.map (fun r ->
-
Cohttp.Code.code_of_status (Response.status r)) response in
-
let redirect_location = match response with
-
| Some r -> Cohttp.Header.get (Response.headers r) "location"
-
let history_entry = { method_; url; error; status; redirect_location } in
-
{ t with history = history_entry :: t.history; retry_count = t.retry_count + 1 }
-
let is_retry t ~method_ ~status_code =
-
if t.retry_count >= t.total then false
-
else if not (List.mem method_ t.allowed_methods) then false
-
else List.mem status_code t.status_forcelist
-
let get_backoff_time t =
-
if t.backoff.factor = 0.0 then 0.0
-
let base_time = t.backoff.factor *. (2.0 ** float_of_int t.retry_count) in
-
(* Use Mirage crypto RNG for jitter calculation *)
-
let rand_bytes = Mirage_crypto_rng.generate 4 in
-
let rand_cstruct = Cstruct.of_string rand_bytes in
-
let rand_uint32 = Cstruct.LE.get_uint32 rand_cstruct 0 in
-
(* Convert to float in [0, 1) range *)
-
let normalized = Int32.to_float rand_uint32 /. (2.0 ** 32.0) in
-
let jittered = base_time +. (normalized *. t.backoff.jitter) in
-
min jittered t.backoff.max
-
let sleep ~clock t response =
-
match t.respect_retry_after, response with
-
(match Cohttp.Header.get (Response.headers resp) "retry-after" with
-
(try float_of_string retry_after with _ -> get_backoff_time t)
-
| None -> get_backoff_time t)
-
| _ -> get_backoff_time t
-
if backoff_time > 0.0 then
-
Eio.Time.sleep clock backoff_time
-
headers : Cohttp.Header.t;
-
timeout : float option;
-
follow_redirects : bool;
-
let create ?(headers=Cohttp.Header.init ()) ?timeout ?(follow_redirects=true)
-
?(max_redirects=10) ?(verify_tls=true) ?(auth=Auth.none) () =
-
{ headers; timeout; follow_redirects; max_redirects; verify_tls; auth }
-
let default = create ()
-
let with_headers t headers = { t with headers }
-
let add_header key value t =
-
{ t with headers = Cohttp.Header.add t.headers key value }
-
let with_timeout t timeout = { t with timeout = Some timeout }
-
let with_follow_redirects t follow_redirects = { t with follow_redirects }
-
let with_max_redirects t max_redirects = { t with max_redirects }
-
let with_verify_tls t verify_tls = { t with verify_tls }
-
let _with_auth t auth = { t with auth }
-
Format.fprintf ppf "@[<v>Config:@,Redirects: %b (max %d)@,Timeout: %a@,TLS verify: %b@]"
-
t.follow_redirects t.max_redirects
-
(fun ppf -> function None -> Format.fprintf ppf "none" | Some f -> Format.fprintf ppf "%.2fs" f) t.timeout
-
| WithCaCerts of X509.Authenticator.t
-
| Custom of Tls.Config.client
-
let default () = Default
-
let with_ca_certs auth = WithCaCerts auth
-
let with_custom config = Custom config
-
let insecure () = Insecure
-
let _pp_config ppf = function
-
| Default -> Format.fprintf ppf "Default TLS"
-
| WithCaCerts _ -> Format.fprintf ppf "Custom CA certs"
-
| Custom _ -> Format.fprintf ppf "Custom TLS config"
-
| Insecure -> Format.fprintf ppf "Insecure (no verification)"
-
let to_tls_config : config -> (Tls.Config.client, [> `Msg of string ]) result = function
-
(match Ca_certs.authenticator () with
-
Tls.Config.client ~authenticator ()
-
Tls.Config.client ~authenticator:auth ()
-
let authenticator ?ip:_ ~host:_ _ = Ok None in
-
Tls.Config.client ~authenticator ()
-
type clock = Clock : _ Eio.Time.clock -> clock
-
tls_config : Tls.config;
-
default_headers : Cohttp.Header.t;
-
cache : Requests_cache.t option;
-
} constraint 'a = [> `Generic] Net.ty
-
let create ?(tls_config=Tls.default ()) ?(default_headers=Cohttp.Header.init ()) ?cache ~clock net =
-
{ net; clock = Clock clock; tls_config; default_headers; cache }
-
let create_with_cache ~sw ?(tls_config=Tls.default ()) ?(default_headers=Cohttp.Header.init ())
-
~cache_dir ~clock net =
-
let cache = Requests_cache.create ~sw ~enabled:true ~cache_dir () in
-
{ net; clock = Clock clock; tls_config; default_headers; cache = Some cache }
-
let make_client net tls_config =
-
match Tls.to_tls_config tls_config with
-
let https_fn uri socket =
-
|> Option.map (fun x -> Domain_name.(host_exn (of_string_exn x)))
-
Tls_eio.client_of_flow ?host tls_config socket
-
Cohttp_eio.Client.make ~https:(Some https_fn) net
-
failwith ("TLS configuration error: " ^ msg)
-
let merge_headers base_headers request_headers =
-
Cohttp.Header.fold (fun key value acc ->
-
Cohttp.Header.add acc key value
-
) request_headers base_headers
-
let rec request_with_redirects ~sw client config uri redirect_count meth body =
-
if redirect_count > config.Config.max_redirects then
-
raise (Request_error Too_many_redirects);
-
let headers = config.Config.headers in
-
let resp, response_body =
-
| `GET -> Cohttp_eio.Client.get ~sw client uri ~headers
-
let body = match body with
-
| Some b -> Flow.string_source b
-
| None -> Flow.string_source ""
-
Cohttp_eio.Client.post ~sw client uri ~headers ~body
-
let body = match body with
-
| Some b -> Flow.string_source b
-
| None -> Flow.string_source ""
-
Cohttp_eio.Client.put ~sw client uri ~headers ~body
-
| `DELETE -> Cohttp_eio.Client.delete ~sw client uri ~headers
-
let response = Cohttp_eio.Client.head ~sw client uri ~headers in
-
(response, Cohttp_eio.Body.of_string "")
-
Cohttp_eio.Client.call ~sw client `OPTIONS uri ~headers
-
let body = match body with
-
| Some b -> Flow.string_source b
-
| None -> Flow.string_source ""
-
Cohttp_eio.Client.call ~sw client `PATCH uri ~headers ~body
-
let status = Cohttp.Response.status resp in
-
let headers = Cohttp.Response.headers resp in
-
if config.Config.follow_redirects && Response.is_redirect { Response.status; headers; body = ""; body_stream = None } then
-
match Cohttp.Header.get headers "location" with
-
let new_uri = Uri.resolve "" uri (Uri.of_string location) in
-
request_with_redirects ~sw client config new_uri (redirect_count + 1) meth body
-
let body = Eio.Flow.read_all response_body in
-
{ Response.status; headers; body; body_stream = None }
-
let body = Eio.Flow.read_all response_body in
-
{ Response.status; headers; body; body_stream = None }
-
let rec request_with_retries ~sw t ?(config=Config.default) ?body ~meth uri retry_state =
-
(* Check cache first for GET/HEAD requests *)
-
match t.cache, meth with
-
| Some cache, (`GET | `HEAD) ->
-
Requests_cache.get cache ~method_:meth ~url:uri ~headers:config.Config.headers
-
match check_cache () with
-
| Some cached_response ->
-
Log.debug (fun m -> m "Using cached response for %s" (Uri.to_string uri));
-
let client = make_client t.net t.tls_config in
-
let merged_headers = merge_headers t.default_headers config.Config.headers in
-
(* Apply authentication *)
-
let merged_headers = Auth.apply config.Config.auth meth uri merged_headers in
-
let config = { config with Config.headers = merged_headers } in
-
let result = request_with_redirects ~sw client config uri 0 meth body in
-
(* Handle Digest auth challenge if we get a 401 *)
-
let result = match config.Config.auth with
-
| DigestAuth { username = _; password = _; challenge } when result.Response.status = `Unauthorized ->
-
(match Cohttp.Header.get result.Response.headers "www-authenticate" with
-
| Some www_auth when String.starts_with ~prefix:"Digest" www_auth ->
-
(* Store the challenge *)
-
challenge := Some www_auth;
-
Log.debug (fun m -> m "Got Digest challenge, retrying with auth");
-
(* Retry request with digest auth *)
-
let merged_headers = merge_headers t.default_headers config.Config.headers in
-
let merged_headers = Auth.apply config.Config.auth meth uri merged_headers in
-
let config = { config with Config.headers = merged_headers } in
-
request_with_redirects ~sw client config uri 0 meth body
-
(* Store successful responses in cache *)
-
| Some cache when Response.is_success result ->
-
Requests_cache.put cache ~method_:meth ~url:uri
-
~request_headers:config.Config.headers ~response:result
-
if not (Response.is_success result) then
-
let status = Cohttp.Code.code_of_status result.Response.status in
-
if Retry.is_retry retry_state ~method_:meth ~status_code:status then begin
-
Log.info (fun m -> m "Retrying request to %a (attempt %d/%d)"
-
Uri.pp uri (retry_state.Retry.retry_count + 1) retry_state.Retry.total);
-
let retry_state = Retry.increment retry_state ~method_:meth ~url:uri
-
(match t.clock with Clock c -> Retry.sleep ~clock:c retry_state (Some result));
-
request_with_retries ~sw t ~config ?body ~meth uri retry_state
-
raise (Request_error (Http_error {
-
status = result.Response.status;
-
body = result.Response.body;
-
headers = result.Response.headers
-
| Request_error _ as e -> raise e
-
(* Check if we should retry on connection errors *)
-
if retry_state.Retry.retry_count < retry_state.Retry.total &&
-
List.mem meth retry_state.Retry.allowed_methods then begin
-
Log.info (fun m -> m "Retrying request to %a after error: %s (attempt %d/%d)"
-
Uri.pp uri (Printexc.to_string e)
-
(retry_state.Retry.retry_count + 1) retry_state.Retry.total);
-
let retry_state = Retry.increment retry_state ~method_:meth ~url:uri
-
~error:(Request_error (Connection_error (Printexc.to_string e))) () in
-
(match t.clock with Clock c -> Retry.sleep ~clock:c retry_state None);
-
request_with_retries ~sw t ~config ?body ~meth uri retry_state
-
raise (Request_error (Connection_error (Printexc.to_string e)))
-
let request ~sw t ?(config=Config.default) ?body ~meth uri =
-
let retry_state = Retry.default in
-
request_with_retries ~sw t ~config ?body ~meth uri retry_state
-
let get ~sw t ?config uri =
-
request ~sw t ?config ~meth:`GET uri
-
let post ~sw t ?config ?body uri =
-
request ~sw t ?config ?body ~meth:`POST uri
-
let put ~sw t ?config ?body uri =
-
request ~sw t ?config ?body ~meth:`PUT uri
-
let delete ~sw t ?config uri =
-
request ~sw t ?config ~meth:`DELETE uri
-
let head ~sw t ?config uri =
-
request ~sw t ?config ~meth:`HEAD uri
-
let patch ~sw t ?config ?body uri =
-
request ~sw t ?config ?body ~meth:`PATCH uri
-
let get ~sw t ?config uri =
-
let response = get ~sw t ?config uri in
-
Yojson.Safe.from_string response.Response.body
-
let post ~sw t ?config json uri =
-
let body = Yojson.Safe.to_string json in
-
let config = match config with
-
| Some c -> Some (Config.add_header "Content-Type" "application/json" c)
-
| None -> Some (Config.add_header "Content-Type" "application/json" Config.default)
-
let response = post ~sw t ?config ~body uri in
-
Yojson.Safe.from_string response.Response.body
-
let put ~sw t ?config json uri =
-
let body = Yojson.Safe.to_string json in
-
let config = match config with
-
| Some c -> Some (Config.add_header "Content-Type" "application/json" c)
-
| None -> Some (Config.add_header "Content-Type" "application/json" Config.default)
-
let response = put ~sw t ?config ~body uri in
-
Yojson.Safe.from_string response.Response.body
-
type t = (string * string list) list
-
|> List.map (fun (key, values) ->
-
Printf.sprintf "%s=%s" (Uri.pct_encode key) (Uri.pct_encode value)
-
let post_form ~sw t ?config ~form uri =
-
let body = Form.encode form in
-
let config = match config with
-
| Some c -> Some (Config.add_header "Content-Type" "application/x-www-form-urlencoded" c)
-
| None -> Some (Config.add_header "Content-Type" "application/x-www-form-urlencoded" Config.default)
-
post ~sw t ?config ~body uri
-
module Session = struct
-
domain : string option;
-
expires : float option; (* Unix timestamp *)
-
cookies : cookie list ref;
-
} constraint 'a = [> `Generic] Net.ty
-
type 'a t = 'a session constraint 'a = [> `Generic] Net.ty
-
let create ?tls_config ?default_headers ~clock net =
-
{ client = create ?tls_config ?default_headers ~clock net;
-
let parse_cookie_header cookie_str =
-
let parts = String.split_on_char ';' cookie_str |> List.map String.trim in
-
match String.split_on_char '=' kv with
-
let name = String.trim k in
-
let value = String.trim v in
-
let rec parse_attrs attrs cookie =
-
match String.lowercase_ascii attr with
-
| "secure" -> { cookie with secure = true }
-
| "httponly" -> { cookie with http_only = true }
-
| s when String.starts_with ~prefix:"domain=" s ->
-
let domain = String.sub s 7 (String.length s - 7) in
-
{ cookie with domain = Some domain }
-
| s when String.starts_with ~prefix:"path=" s ->
-
let path = String.sub s 5 (String.length s - 5) in
-
{ cookie with path = Some path }
-
| s when String.starts_with ~prefix:"expires=" s ->
-
(* Simple expiry parsing - could be improved *)
-
{ cookie with expires = Some (Unix.gettimeofday () +. 3600.0) }
-
parse_attrs rest cookie'
-
domain = None; path = None; expires = None;
-
secure = false; http_only = false
-
Some (parse_attrs attrs base_cookie)
-
let update_cookies t headers =
-
let new_cookies = Cohttp.Header.get_multi headers "set-cookie"
-
|> List.filter_map parse_cookie_header
-
(* Replace existing cookies with same name *)
-
let updated = List.fold_left (fun acc new_cookie ->
-
let filtered = List.filter (fun c -> c.name <> new_cookie.name) acc in
-
) !(t.cookies) new_cookies in
-
let add_cookies config cookies =
-
if cookies = [] then config else
-
(* Filter out expired cookies *)
-
let now = Unix.gettimeofday () in
-
let valid_cookies = cookies |> List.filter (fun c ->
-
| Some exp when exp < now -> false
-
if valid_cookies = [] then config else
-
|> List.map (fun c -> Printf.sprintf "%s=%s" c.name c.value)
-
Config.add_header "Cookie" cookie_header config
-
let request_with_cookies ~sw t ?config ~meth ?body uri =
-
| Some c -> add_cookies c !(t.cookies)
-
| None -> add_cookies Config.default !(t.cookies)
-
let response = request ~sw t.client ~config ?body ~meth uri in
-
update_cookies t response.Response.headers;
-
let get ~sw t ?config uri =
-
request_with_cookies ~sw t ?config ~meth:`GET uri
-
let post ~sw t ?config ?body uri =
-
request_with_cookies ~sw t ?config ~meth:`POST ?body uri
-
(* Return valid cookies as (name, value) pairs for compatibility *)
-
let now = Unix.gettimeofday () in
-
|> List.filter (fun c ->
-
| Some exp when exp < now -> false
-
|> List.map (fun c -> (c.name, c.value))
-
let clear_cookies t = t.cookies := []
-
let stream_response ~sw t ?config uri f =
-
let client = make_client t.net t.tls_config in
-
let headers = match config with
-
| Some c -> c.Config.headers
-
| None -> Cohttp.Header.init ()
-
let merged_headers = merge_headers t.default_headers headers in
-
let merged_headers = match config with
-
| Some c -> Auth.apply c.Config.auth `GET uri merged_headers
-
| None -> merged_headers
-
let _resp, body = Cohttp_eio.Client.get ~sw client uri ~headers:merged_headers in
-
let buf_reader = Eio.Buf_read.of_flow ~max_size:(16 * 1024 * 1024) body in
-
(* Connection Pool Implementation *)
-
module ConnectionPool = struct
-
type connection_state =
-
client : Cohttp_eio.Client.t;
-
mutable state : connection_state;
-
mutable last_used : float;
-
mutable request_count : int;
-
tls_config : Tls.config option;
-
mutable connections : connection Queue.t;
-
mutable active_connections : int;
-
mutable total_connections_created : int;
-
mutable total_requests : int;
-
available : Eio.Condition.t;
-
timeout : float option;
-
max_requests_per_connection : int option;
-
connection_timeout : float;
-
max_requests_per_connection = Some 100;
-
connection_timeout = 60.0;
-
let create ~sw ?(config=default_config) ?tls_config ~scheme ~host ~port net =
-
Log.debug (fun m -> m "Creating connection pool for %s://%s:%d" scheme host port);
-
connections = Queue.create ();
-
active_connections = 0;
-
total_connections_created = 0;
-
mutex = Eio.Mutex.create ();
-
available = Eio.Condition.create ();
-
let create_new_connection net tls_config =
-
let client = make_client net (Option.value ~default:(Tls.default ()) tls_config) in
-
last_used = Unix.gettimeofday ();
-
let is_connection_valid conn config =
-
let now = Unix.gettimeofday () in
-
let age = now -. conn.last_used in
-
age < config.connection_timeout &&
-
(match config.max_requests_per_connection with
-
| Some max -> conn.request_count < max)
-
let rec get_connection ~sw (Pool t as pool) =
-
Eio.Mutex.use_rw ~protect:true t.mutex (fun () ->
-
(* Try to get an existing connection *)
-
let rec find_valid_connection () =
-
if Queue.is_empty t.connections then
-
let conn = Queue.pop t.connections in
-
if is_connection_valid conn t.config then
-
find_valid_connection ()
-
match find_valid_connection () with
-
conn.last_used <- Unix.gettimeofday ();
-
conn.request_count <- conn.request_count + 1;
-
t.active_connections <- t.active_connections + 1;
-
t.total_requests <- t.total_requests + 1;
-
if t.active_connections >= t.config.maxsize then
-
if t.config.block then (
-
(* Wait for a connection to become available *)
-
Eio.Condition.await t.available t.mutex;
-
get_connection ~sw pool
-
raise (Request_error Pool_exhausted)
-
(* Create a new connection *)
-
t.active_connections <- t.active_connections + 1;
-
t.total_connections_created <- t.total_connections_created + 1;
-
t.total_requests <- t.total_requests + 1;
-
let conn = create_new_connection t.net t.tls_config in
-
conn.request_count <- 1;
-
let put_connection (Pool t) _client =
-
(* Since we can't track connection metadata with just the client,
-
we'll simply decrement the active count *)
-
Eio.Mutex.use_rw ~protect:false t.mutex (fun () ->
-
t.active_connections <- t.active_connections - 1;
-
Eio.Condition.broadcast t.available
-
let num_connections (Pool t) =
-
Eio.Mutex.use_ro t.mutex (fun () ->
-
Queue.length t.connections + t.active_connections
-
let num_requests (Pool t) = t.total_requests
-
Eio.Mutex.use_rw ~protect:false t.mutex (fun () ->
-
Queue.iter (fun conn -> conn.state <- Closed) t.connections;
-
Queue.clear t.connections;
-
t.active_connections <- 0;
-
Eio.Condition.broadcast t.available
-
module Timeout = struct
-
connect : float option;
-
start_time : float option;
-
let default = { connect = None; read = None; total = None; start_time = None }
-
let create ?connect ?read ?total () = { connect; read; total; start_time = None }
-
let from_float f = { connect = Some f; read = Some f; total = None; start_time = None }
-
let start_connect t = { t with start_time = Some (Unix.gettimeofday ()) }
-
let get_connect_timeout t = t.connect
-
let get_read_timeout t = t.read
-
let clone t = { t with start_time = None }
-
(* Cache Implementation *)
-
must_revalidate : bool;
-
let parse_cache_control header =
-
no_cache = false; no_store = false; max_age = None;
-
s_maxage = None; must_revalidate = false;
-
public = false; private_ = false; immutable = false;
-
let directives = String.split_on_char ',' header |> List.map String.trim in
-
List.fold_left (fun acc directive ->
-
match String.split_on_char '=' directive with
-
| ["no-cache"] -> { acc with no_cache = true }
-
| ["no-store"] -> { acc with no_store = true }
-
| ["max-age"; v] -> { acc with max_age = try Some (int_of_string v) with _ -> None }
-
mutable cache : (string, (float * Response.t)) Hashtbl.t;
-
let create ~max_size () = {
-
cache = Hashtbl.create max_size;
-
let default_cache_dir () =
-
(* Use XDG cache directory for storing HTTP cache *)
-
let xdg = Xdg.create ~env:Sys.getenv_opt () in
-
let cache_home = Xdg.cache_dir xdg in
-
let cache_dir = Filename.concat cache_home "ocaml-requests" in
-
(* Ensure cache directory exists *)
-
if not (Sys.file_exists cache_dir) then
-
Unix.mkdir cache_dir 0o755;
-
let create ?(cache_dir = default_cache_dir ()) ~max_size () = {
-
cache_dir; max_size; size = 0L; hits = 0; misses = 0;
-
| `Memory of Memory.storage
-
| `File of File.storage
-
type 'a t = { storage : storage } constraint 'a = [> `Generic] Net.ty
-
type stats = { hits : int; misses : int; size : int64; entries : int }
-
let create storage = { storage }
-
let is_cacheable ~method_ ~response =
-
method_ = `GET && Response.is_success response
-
let make_cache_key ~method_ ~url =
-
| `GET -> "GET" | `POST -> "POST" | `PUT -> "PUT"
-
| `DELETE -> "DELETE" | `HEAD -> "HEAD"
-
| `OPTIONS -> "OPTIONS" | `PATCH -> "PATCH")
-
let get t ~method_ ~url ~headers:_ =
-
let key = make_cache_key ~method_ ~url in
-
(match Hashtbl.find_opt storage.cache key with
-
| Some (expiry, response) when expiry > Unix.gettimeofday () ->
-
storage.hits <- storage.hits + 1;
-
storage.misses <- storage.misses + 1;
-
let put t ~method_ ~url ~response =
-
if is_cacheable ~method_ ~response then
-
let key = make_cache_key ~method_ ~url in
-
let expiry = Unix.gettimeofday () +. 3600.0 in
-
if Hashtbl.length storage.cache < storage.max_size then
-
Hashtbl.replace storage.cache key (expiry, response)
-
Hashtbl.clear storage.cache;
-
{ hits = storage.Memory.hits;
-
misses = storage.Memory.misses;
-
size = Int64.of_int (Hashtbl.length storage.Memory.cache * 1024);
-
entries = Hashtbl.length storage.Memory.cache }
-
{ hits = storage.File.hits;
-
misses = storage.File.misses;
-
size = storage.File.size;
-
module PoolManager = struct
-
type 'a pool_manager = {
-
pools : (string, ConnectionPool.t) Hashtbl.t;
-
headers : Cohttp.Header.t;
-
pool_config : ConnectionPool.config;
-
tls_config : Tls.config option;
-
cache : 'a Cache.t option;
-
} constraint 'a = [> `Generic] Net.ty
-
type 'a t = 'a pool_manager constraint 'a = [> `Generic] Net.ty
-
let create ~sw ~clock ?(num_pools=10) ?(headers=Cohttp.Header.init ())
-
?(retries=Retry.default) ?(timeout=Timeout.default)
-
?(pool_config=ConnectionPool.default_config) ?tls_config ?cache net =
-
let cache = Option.map Cache.create cache in
-
{ sw; net; clock = Clock clock; pools = Hashtbl.create num_pools; num_pools;
-
headers; retries; timeout; pool_config; tls_config; cache }
-
let get_pool t ~scheme ~host ~port =
-
let key = Printf.sprintf "%s://%s:%d" scheme host port in
-
match Hashtbl.find_opt t.pools key with
-
let pool = ConnectionPool.create ~sw:t.sw ~config:t.pool_config
-
?tls_config:t.tls_config ~scheme ~host ~port t.net in
-
Hashtbl.add t.pools key pool;
-
let urlopen ~sw t ~method_ ~url ?body ?headers ?(retries=t.retries)
-
?(timeout=t.timeout) ?(redirect=true) ?(assert_same_host=false)
-
?(preload_content=true) ?(decode_content=true) ?chunk_size () =
-
(* Validate same host if required *)
-
if assert_same_host && redirect then
-
Log.warn (fun m -> m "assert_same_host is set with redirects enabled");
-
(* Check cache first for GET requests *)
-
match t.cache, method_ with
-
Cache.get cache ~method_ ~url
-
~headers:(Option.value headers ~default:t.headers)
-
match cached_response with
-
| Some response -> response
-
let scheme = Uri.scheme url |> Option.value ~default:"http" in
-
let host = Uri.host url |> Option.value ~default:"localhost" in
-
let port = Uri.port url |> Option.value ~default:
-
(if scheme = "https" then 443 else 80) in
-
let pool = get_pool t ~scheme ~host ~port in
-
let conn = ConnectionPool.get_connection ~sw pool in
-
| Some h -> Cohttp.Header.fold (fun k v acc ->
-
Cohttp.Header.add acc k v) h t.headers
-
(* Add chunked transfer encoding if chunk_size is specified *)
-
let headers = match chunk_size with
-
| Some _ -> Cohttp.Header.add headers "Transfer-Encoding" "chunked"
-
let create_client = fun ?tls_config ?default_headers ~clock net ->
-
{ net; clock; tls_config = Option.value ~default:(Tls.default ()) tls_config;
-
default_headers = Option.value ~default:(Cohttp.Header.init ()) default_headers;
-
let req_client = create_client ?tls_config:t.tls_config ~default_headers:t.headers ~clock:t.clock t.net in
-
let config = Config.create ~headers ~follow_redirects:redirect () in
-
(* Wrap request with timeout if specified *)
-
match timeout.Timeout.total with
-
(* We need access to a clock - assuming t has one or using Eio.Stdenv.clock *)
-
(* For now, just make the request without timeout wrapper since we don't have clock access *)
-
Result.Ok (request ~sw req_client ~config ?body ~meth:method_ url)
-
Result.Ok (request ~sw req_client ~config ?body ~meth:method_ url)
-
(* Execute with retries *)
-
let rec execute_with_retries attempt =
-
match make_request () with
-
| Result.Ok response ->
-
(* Process response based on flags *)
-
(* Check for content encoding and decode if needed *)
-
match Cohttp.Header.get response.Response.headers "content-encoding" with
-
| Some "gzip" | Some "deflate" ->
-
Log.info (fun m -> m "Content encoding detected but not yet implemented");
-
if preload_content then
-
(* Content is already loaded in response.body *)
-
(* For streaming, we'd need to return a different type *)
-
(match t.cache, method_ with
-
| Some cache, `GET -> Cache.put cache ~method_ ~url ~response
-
ConnectionPool.put_connection pool conn;
-
| Result.Error `Timeout ->
-
if attempt < retries.Retry.total then (
-
Log.info (fun m -> m "Request timeout, retry %d/%d" (attempt + 1) retries.Retry.total);
-
(match t.clock with Clock c -> Eio.Time.sleep c 1.0);
-
execute_with_retries (attempt + 1)
-
ConnectionPool.put_connection pool conn;
-
raise (Request_error Timeout_error)
-
let request ~sw t ~method_ ~url ?body ?headers () =
-
urlopen ~sw t ~method_ ~url ?body ?headers ()
-
Hashtbl.iter (fun _ pool -> ConnectionPool.clear pool) t.pools;
-
let connection_pool_stats t =
-
Hashtbl.fold (fun key pool acc -> (key, pool) :: acc) t.pools []
-
module FilePost = struct
-
| Text of { name : string; data : string }
-
filename : string option;
-
data : Flow.source_ty Eio.Resource.t;
-
content_type : string option;
-
let choose_boundary () =
-
(* Use Mirage crypto RNG for boundary generation *)
-
let rand_bytes = Mirage_crypto_rng.generate 8 in
-
let rand_cstruct = Cstruct.of_string rand_bytes in
-
let rand_hex = Cstruct.to_hex_string rand_cstruct in
-
Printf.sprintf "----OCamlBoundary%s" rand_hex
-
let encode_multipart_formdata ~fields ~boundary =
-
let boundary = Option.value boundary ~default:(choose_boundary ()) in
-
let content_type = Printf.sprintf "multipart/form-data; boundary=%s" boundary in
-
let buf = Buffer.create 1024 in
-
List.iter (fun field ->
-
Buffer.add_string buf (Printf.sprintf "--%s\r\n" boundary);
-
| Text { name; data } ->
-
Buffer.add_string buf (Printf.sprintf "Content-Disposition: form-data; name=\"%s\"\r\n\r\n" name);
-
Buffer.add_string buf data;
-
Buffer.add_string buf "\r\n"
-
| File { name; filename; content_type; data } ->
-
let filename_str = Option.value ~default:"file" filename in
-
let content_type_str = Option.value ~default:"application/octet-stream" content_type in
-
Buffer.add_string buf (Printf.sprintf "Content-Disposition: form-data; name=\"%s\"; filename=\"%s\"\r\n" name filename_str);
-
Buffer.add_string buf (Printf.sprintf "Content-Type: %s\r\n\r\n" content_type_str);
-
(* For now, just read the file data as a string *)
-
let file_content = Eio.Flow.read_all data in
-
Buffer.add_string buf file_content;
-
Buffer.add_string buf "\r\n"
-
Buffer.add_string buf (Printf.sprintf "--%s--\r\n" boundary);
-
let body_content = Buffer.contents buf in
-
(content_type, Flow.string_source body_content)
-
(* Progress tracking *)
-
module Progress = struct
-
mutable total : int64 option;
-
mutable current : int64;
-
let create ?total ?desc ?(unit="B") ?(width=40) () =
-
{ total; desc; unit_=unit; width; current = 0L }
-
t.current <- Int64.add t.current amount;
-
Log.info (fun m -> m "Progress: %Ld %s" t.current t.unit_)
-
Log.info (fun m -> m "Progress complete: %Ld %s" t.current t.unit_)
-
let track_source ~sw:_ _t source =
-
(* Wrap source to track upload progress *)
-
Log.info (fun m -> m "Progress tracking for uploads enabled");
-
(* Since we can't easily wrap a Flow source, we'll just pass it through *)
-
(* In a real implementation, we'd need to create a custom Flow wrapper *)
-
let track_response t response f =
-
(* Track download progress while processing response *)
-
let body = Response.body response in
-
let total_size = String.length body |> Int64.of_int in
-
(* Update progress to show total if not set *)
-
| None -> t.total <- Some total_size
-
(* Process body in chunks and track progress *)
-
let chunk_size = 8192 in
-
let processed = ref 0L in
-
let process_chunks () =
-
if pos >= String.length body then (
-
String.concat "" (List.rev acc)
-
let len = min chunk_size (String.length body - pos) in
-
let chunk = String.sub body pos len in
-
processed := Int64.add !processed (Int64.of_int len);
-
update t (Int64.of_int len);
-
(* Show percentage if total is known *)
-
| Some total when total > 0L ->
-
let pct = Int64.to_float !processed *. 100.0 /. Int64.to_float total in
-
Log.info (fun m -> m "Progress: %.1f%% (%Ld/%Ld %s)"
-
pct !processed total t.unit_)
-
iter (pos + len) (chunk :: acc)
-
let tracked_body = process_chunks () in
-
let make_headers ?keep_alive ?accept_encoding ?user_agent
-
?basic_auth ?proxy_basic_auth ?disable_cache () =
-
let h = Cohttp.Header.init () in
-
let h = match user_agent with
-
| Some ua -> Cohttp.Header.add h "User-Agent" ua
-
| None -> Cohttp.Header.add h "User-Agent" "OCaml-Requests/1.0"
-
let h = match accept_encoding with
-
| Some enc -> Cohttp.Header.add h "Accept-Encoding" (String.concat ", " enc)
-
let h = match basic_auth with
-
let encoded = Base64.encode_string (Printf.sprintf "%s:%s" user pass) in
-
Cohttp.Header.add h "Authorization" (Printf.sprintf "Basic %s" encoded)
-
let h = match proxy_basic_auth with
-
let encoded = Base64.encode_string (Printf.sprintf "%s:%s" user pass) in
-
Cohttp.Header.add h "Proxy-Authorization" (Printf.sprintf "Basic %s" encoded)
-
let h = match keep_alive with
-
| Some true -> Cohttp.Header.add h "Connection" "keep-alive"
-
| Some false -> Cohttp.Header.add h "Connection" "close"
-
let h = match disable_cache with
-
|> (fun h -> Cohttp.Header.add h "Cache-Control" "no-cache, no-store, must-revalidate")
-
|> (fun h -> Cohttp.Header.add h "Pragma" "no-cache")
-
|> (fun h -> Cohttp.Header.add h "Expires" "0")
-
let parse_url url = Uri.of_string url
-
let getproxies_environment () =
-
let vars = ["http_proxy"; "https_proxy"; "ftp_proxy"; "no_proxy"] in
-
List.filter_map (fun var ->
-
match Sys.getenv_opt var with
-
| Some value -> Some (var, value)
-
let proxy_bypass_environment host =
-
match Sys.getenv_opt "no_proxy" with
-
let hosts = String.split_on_char ',' no_proxy |> List.map String.trim in
-
List.exists (fun h -> h = host || String.ends_with ~suffix:h host) hosts
-
let urlencode ?(safe="") params =
-
(* Custom encoder that respects the safe characters *)
-
let encode_with_safe str =
-
(* Encode character by character, skipping safe ones *)
-
let s = String.make 1 c in
-
if String.contains safe c then s
-
|> List.map (fun (k, v) ->
-
Printf.sprintf "%s=%s" (encode_with_safe k) (encode_with_safe v))
-
let current_time () = Unix.gettimeofday ()
-
let parse_retry_after header = try Some (float_of_string header) with _ -> None
-
(* Streaming support *)
-
let upload ~sw t ?config ?(chunk_size=8192) ~meth uri ~body =
-
Log.debug (fun m -> m "Streaming upload to %s with chunk size %d" (Uri.to_string uri) chunk_size);
-
let config = Option.value config ~default:Config.default in
-
let headers = Config.(config.headers) in
-
let headers = Cohttp.Header.add headers "Transfer-Encoding" "chunked" in
-
let config = { config with Config.headers } in
-
(* For now, just read the entire body and send it *)
-
(* A proper implementation would need to create a Flow wrapper *)
-
let body_content = Flow.read_all body in
-
(* Use the regular request with the body *)
-
request ~sw t ~config ~body:body_content ~meth uri
-
let download ~sw t ?config ?(chunk_size=8192) uri ~sink =
-
Log.debug (fun m -> m "Streaming download from %s with chunk size %d" (Uri.to_string uri) chunk_size);
-
(* Create client and perform streaming download directly *)
-
let client = make_client t.net t.tls_config in
-
let headers = match config with
-
| Some c -> c.Config.headers
-
| None -> Cohttp.Header.init ()
-
let merged_headers = merge_headers t.default_headers headers in
-
let merged_headers = match config with
-
| Some c -> Auth.apply c.Config.auth `GET uri merged_headers
-
| None -> merged_headers
-
let _resp, body = Cohttp_eio.Client.get ~sw client uri ~headers:merged_headers in
-
let buf_reader = Eio.Buf_read.of_flow ~max_size:(16 * 1024 * 1024) body in
-
(* Stream data in chunks to the sink *)
-
let rec stream_chunks () =
-
let chunk = Eio.Buf_read.take chunk_size buf_reader in
-
if String.length chunk > 0 then (
-
Flow.copy_string chunk sink;
-
| Eio.Buf_read.Buffer_limit_exceeded ->
-
(* Read in smaller chunks when buffer limit exceeded *)
-
let smaller_chunk_size = min chunk_size 1024 in
-
let rec read_smaller () =
-
let chunk = Eio.Buf_read.take smaller_chunk_size buf_reader in
-
if String.length chunk > 0 then (
-
Flow.copy_string chunk sink;
-
let iter_response ?(chunk_size=8192) response ~f =
-
(* Use the body_stream if available, otherwise process the body string *)
-
match response.Response.body_stream with
-
let rec iter_stream () =
-
let chunk = Eio.Buf_read.take chunk_size buf_reader in
-
if String.length chunk > 0 then (
-
| Eio.Buf_read.Buffer_limit_exceeded ->
-
let smaller_chunk_size = min chunk_size 1024 in
-
let rec read_smaller () =
-
let chunk = Eio.Buf_read.take smaller_chunk_size buf_reader in
-
if String.length chunk > 0 then (
-
(* Fallback to processing the body string in chunks *)
-
let body = Response.body response in
-
if pos < String.length body then
-
let len = min chunk_size (String.length body - pos) in
-
let chunk = String.sub body pos len in
-
let lines ?(chunk_size=8192) ?(keep_ends=false) response =
-
let body = Response.body response in
-
(* Process body in chunks to find lines efficiently *)
-
let buffer = Buffer.create 256 in
-
let rec extract_lines pos =
-
if pos >= String.length body then (
-
(* Add any remaining buffer content *)
-
if Buffer.length buffer > 0 then
-
acc := Buffer.contents buffer :: !acc
-
let len = min chunk_size (String.length body - pos) in
-
let chunk = String.sub body pos len in
-
(* Process chunk character by character to find line breaks *)
-
let line = Buffer.contents buffer in
-
acc := (line ^ "\n") :: !acc
-
Buffer.add_char buffer c
-
extract_lines (pos + len)
-
List.rev !acc |> List.to_seq
-
let json_stream ?(chunk_size=8192) response =
-
lines ~chunk_size response
-
|> Seq.filter (fun line -> String.trim line <> "")
-
|> Seq.map (fun line ->
-
try Yojson.Safe.from_string line
-
Log.warn (fun m -> m "Failed to parse JSON line: %s" line);
-
(* Download utility functions using Stream module *)
-
let download_file ~sw t ?config uri ~path =
-
Log.debug (fun m -> m "Downloading file from %s to %s" (Uri.to_string uri) (Eio.Path.native_exn path));
-
(* Use streaming download to avoid loading entire file into memory *)
-
Eio.Path.with_open_out ~create:(`Or_truncate 0o644) path (fun file ->
-
let sink = (file :> Eio.Flow.sink_ty Eio.Resource.t) in
-
Stream.download ~sw t ?config uri ~sink
-
(* Add function for range request support with caching *)
-
let download_file_range ~sw t ?config uri ~path ~start_byte ~end_byte =
-
Log.debug (fun m -> m "Downloading file range %Ld-%Ld from %s to %s"
-
start_byte end_byte (Uri.to_string uri) (Eio.Path.native_exn path));
-
(* Check if we have this range in cache *)
-
let range = Requests_cache.Range.{ start = start_byte; end_ = Some end_byte } in
-
Requests_cache.download_range cache ~sw ~url:uri ~range
-
~on_chunk:(fun _data -> ())
-
match try_cache () with
-
Log.debug (fun m -> m "Using cached data for range %Ld-%Ld" start_byte end_byte)
-
(* Fallback to regular range request *)
-
let range_header = Printf.sprintf "bytes=%Ld-%Ld" start_byte end_byte in
-
let config = match config with
-
| Some c -> Some (Config.add_header "Range" range_header c)
-
| None -> Some (Config.add_header "Range" range_header Config.default)
-
(* Download and cache the chunk *)
-
let response = get ~sw t ?config uri in
-
(* Store the chunk in cache if we have one *)
-
let range = Requests_cache.Range.{ start = start_byte; end_ = Some end_byte } in
-
Requests_cache.put_chunk cache ~url:uri ~range ~data:response.Response.body
-
Eio.Path.with_open_out ~create:(`Or_truncate 0o644) path (fun file ->
-
Flow.copy_string response.Response.body (file :> Eio.Flow.sink_ty Eio.Resource.t)
-
(* Add function for resumable downloads *)
-
let download_file_resume ~sw t ?config uri ~path =
-
Log.debug (fun m -> m "Attempting resumable download from %s to %s" (Uri.to_string uri) (Eio.Path.native_exn path));
-
let stat = Eio.Path.stat ~follow:false path in
-
Optint.Int63.to_int64 stat.size
-
if start_byte > 0L then (
-
Log.info (fun m -> m "Resuming download from byte %Ld" start_byte);
-
let range_header = Printf.sprintf "bytes=%Ld-" start_byte in
-
let config = match config with
-
| Some c -> Some (Config.add_header "Range" range_header c)
-
| None -> Some (Config.add_header "Range" range_header Config.default)
-
Eio.Path.with_open_out ~append:true ~create:(`Or_truncate 0o644) path (fun file ->
-
let sink = (file :> Eio.Flow.sink_ty Eio.Resource.t) in
-
Stream.download ~sw t ?config uri ~sink
-
download_file ~sw t ?config uri ~path
-
module Defaults = struct
-
let user_agent = ref "OCaml-Requests/1.0"
-
let socket_timeout = ref None
-
let retry = ref Retry.default
-
let pool_maxsize = ref 10
-
(* Additional exceptions *)
-
(* Unused exceptions - kept for potential future use
-
exception MaxRetryError of { url : Uri.t; reason : string }
-
exception PoolError of string
-
exception Pool_exhausted *)
anil.recoil.org