+53

lib/auth.ml

··· 33 33 34 34 let custom f = Custom f 35 35 36 36 + (** Check if a URL uses HTTPS scheme *) 37 37 + let is_https url = 38 38 + let uri = Uri.of_string url in 39 39 + match Uri.scheme uri with 40 40 + | Some "https" -> true 41 41 + | _ -> false 42 42 + 43 43 + (** Get the authentication type name for error messages *) 44 44 + let auth_type_name = function 45 45 + | No_auth -> "None" 46 46 + | Basic _ -> "Basic" 47 47 + | Bearer _ -> "Bearer" 48 48 + | Digest _ -> "Digest" 49 49 + | Custom _ -> "Custom" 50 50 + 51 51 + (** Check if auth type requires HTTPS (per RFC 7617/6750). 52 52 + Basic, Bearer, and Digest send credentials that can be intercepted. *) 53 53 + let requires_https = function 54 54 + | Basic _ | Bearer _ | Digest _ -> true 55 55 + | No_auth | Custom _ -> false 56 56 + 57 57 + (** Validate that sensitive authentication is used over HTTPS. 58 58 + Per RFC 7617 Section 4 (Basic) and RFC 6750 Section 5.1 (Bearer): 59 59 + These authentication methods MUST be used over TLS to prevent credential leakage. 60 60 + 61 61 + @param allow_insecure_auth If true, skip the check (for testing environments) 62 62 + @param url The request URL 63 63 + @param auth The authentication configuration 64 64 + @raise Error.Insecure_auth if auth requires HTTPS but URL is HTTP *) 65 65 + let validate_secure_transport ?(allow_insecure_auth = false) ~url auth = 66 66 + if allow_insecure_auth then 67 67 + Log.warn (fun m -> m "allow_insecure_auth=true: skipping HTTPS check for %s auth" 68 68 + (auth_type_name auth)) 69 69 + else if requires_https auth && not (is_https url) then begin 70 70 + Log.err (fun m -> m "%s authentication rejected over HTTP (use HTTPS or allow_insecure_auth=true)" 71 71 + (auth_type_name auth)); 72 72 + raise (Error.err (Error.Insecure_auth { 73 73 + url; 74 74 + auth_type = auth_type_name auth 75 75 + })) 76 76 + end 77 77 + 36 78 let apply auth headers = 37 79 match auth with 38 80 | No_auth -> headers ··· 49 91 | Custom f -> 50 92 Log.debug (fun m -> m "Applying custom authentication handler"); 51 93 f headers 94 94 + 95 95 + (** Apply authentication with HTTPS validation. 96 96 + This is the secure version that checks transport security before applying auth. 97 97 + 98 98 + @param allow_insecure_auth If true, allow auth over HTTP (not recommended) 99 99 + @param url The request URL (used for security check) 100 100 + @param auth The authentication to apply 101 101 + @param headers The headers to modify *) 102 102 + let apply_secure ?(allow_insecure_auth = false) ~url auth headers = 103 103 + validate_secure_transport ~allow_insecure_auth ~url auth; 104 104 + apply auth headers 52 105 53 106 (** {1 Digest Authentication Implementation} *) 54 107

+23 -1

lib/auth.mli

··· 33 33 (** Custom authentication handler *) 34 34 35 35 val apply : t -> Headers.t -> Headers.t 36 36 - (** Apply authentication to headers *) 36 36 + (** Apply authentication to headers. 37 37 + Note: This does not validate transport security. Use [apply_secure] for 38 38 + HTTPS enforcement per RFC 7617/6750. *) 39 39 + 40 40 + val apply_secure : ?allow_insecure_auth:bool -> url:string -> t -> Headers.t -> Headers.t 41 41 + (** Apply authentication with HTTPS validation. 42 42 + Per RFC 7617 Section 4 (Basic) and RFC 6750 Section 5.1 (Bearer): 43 43 + Basic, Bearer, and Digest authentication MUST be used over TLS. 44 44 + 45 45 + @param allow_insecure_auth If [true], skip the HTTPS check (not recommended, 46 46 + only for testing environments). Default: [false] 47 47 + @param url The request URL (used for security check) 48 48 + @raise Error.Insecure_auth if sensitive auth is used over HTTP *) 49 49 + 50 50 + val validate_secure_transport : ?allow_insecure_auth:bool -> url:string -> t -> unit 51 51 + (** Validate that sensitive authentication would be safe to use. 52 52 + Raises [Error.Insecure_auth] if Basic/Bearer/Digest auth would be used over HTTP. 53 53 + 54 54 + @param allow_insecure_auth If [true], skip the check. Default: [false] *) 55 55 + 56 56 + val requires_https : t -> bool 57 57 + (** Returns [true] if the authentication type requires HTTPS transport. 58 58 + Basic, Bearer, and Digest require HTTPS; No_auth and Custom do not. *) 37 59 38 60 (** {1 Digest Authentication Support} *) 39 61

+10

lib/error.ml

··· 45 45 | Headers_too_large of { limit: int; actual: int } 46 46 | Decompression_bomb of { limit: int64; ratio: float } 47 47 | Content_length_mismatch of { expected: int64; actual: int64 } 48 48 + | Insecure_auth of { url: string; auth_type: string } 49 49 + (** Per RFC 7617 Section 4 and RFC 6750 Section 5.1: 50 50 + Basic, Bearer, and Digest authentication over unencrypted HTTP 51 51 + exposes credentials to eavesdropping. *) 48 52 49 53 (* JSON errors *) 50 54 | Json_parse_error of { body_preview: string; reason: string } ··· 137 141 Format.fprintf ppf "Content-Length mismatch: expected %Ld bytes, received %Ld bytes" 138 142 expected actual 139 143 144 144 + | Insecure_auth { url; auth_type } -> 145 145 + Format.fprintf ppf "%s authentication over unencrypted HTTP rejected for %s. \ 146 146 + Use HTTPS or set allow_insecure_auth=true (not recommended)" 147 147 + auth_type (sanitize_url url) 148 148 + 140 149 | Json_parse_error { body_preview; reason } -> 141 150 let preview = if String.length body_preview > 100 142 151 then String.sub body_preview 0 100 ^ "..." ··· 229 238 | Headers_too_large _ -> true 230 239 | Decompression_bomb _ -> true 231 240 | Invalid_redirect _ -> true 241 241 + | Insecure_auth _ -> true 232 242 | _ -> false 233 243 234 244 let is_json_error = function

+5

lib/error.mli

··· 67 67 | Headers_too_large of { limit: int; actual: int } 68 68 | Decompression_bomb of { limit: int64; ratio: float } 69 69 | Content_length_mismatch of { expected: int64; actual: int64 } 70 70 + | Insecure_auth of { url: string; auth_type: string } 71 71 + (** Per RFC 7617 Section 4 and RFC 6750 Section 5.1: 72 72 + Basic, Bearer, and Digest authentication over unencrypted HTTP 73 73 + exposes credentials to eavesdropping. Raised when attempting 74 74 + to use these auth methods over HTTP without explicit opt-out. *) 70 75 71 76 (* JSON errors *) 72 77 | Json_parse_error of { body_preview: string; reason: string }

+6 -3

lib/http_client.ml

··· 177 177 178 178 (* Read response using Buf_read *) 179 179 let buf_read = Http_read.of_flow flow ~max_size:max_int in 180 180 - Http_read.response ~limits buf_read 180 180 + let (_version, status, headers, body) = Http_read.response ~limits buf_read in 181 181 + (status, headers, body) 181 182 182 183 (** Make HTTP request with optional auto-decompression *) 183 184 let make_request_decompress ?(limits=default_limits) ~sw ~method_ ~uri ~headers ~body ~auto_decompress flow = ··· 335 336 336 337 (* Read final response *) 337 338 let buf_read = Http_read.of_flow flow ~max_size:max_int in 338 338 - Http_read.response ~limits buf_read 339 339 + let (_version, status, headers, body) = Http_read.response ~limits buf_read in 340 340 + (status, headers, body) 339 341 340 342 | Rejected (status, resp_headers, resp_body_str) -> 341 343 (* Server rejected - return error response without sending body *) ··· 359 361 360 362 (* Read response *) 361 363 let buf_read = Http_read.of_flow flow ~max_size:max_int in 362 362 - Http_read.response ~limits buf_read 364 364 + let (_version, status, headers, body) = Http_read.response ~limits buf_read in 365 365 + (status, headers, body) 363 366 end 364 367 365 368 (** Make HTTP request with 100-continue support and optional auto-decompression *)

+47 -16

lib/http_read.ml

··· 67 67 let reason_phrase r = 68 68 Read.line r 69 69 70 70 + (** {1 HTTP Version Type} 71 71 + 72 72 + Per Recommendation #26: Expose HTTP version used for the response *) 73 73 + 74 74 + type http_version = 75 75 + | HTTP_1_0 76 76 + | HTTP_1_1 77 77 + 78 78 + let http_version_of_string = function 79 79 + | "HTTP/1.0" -> HTTP_1_0 80 80 + | "HTTP/1.1" -> HTTP_1_1 81 81 + | v -> raise (Error.err (Error.Invalid_request { 82 82 + reason = "Invalid HTTP version: " ^ v 83 83 + })) 84 84 + 85 85 + let http_version_to_string = function 86 86 + | HTTP_1_0 -> "HTTP/1.0" 87 87 + | HTTP_1_1 -> "HTTP/1.1" 88 88 + 70 89 (** {1 Status Line Parser} *) 71 90 72 91 let status_line r = 73 73 - let version = http_version r in 74 74 - (* Validate HTTP version *) 75 75 - (match version with 76 76 - | "HTTP/1.1" | "HTTP/1.0" -> () 77 77 - | _ -> 78 78 - raise (Error.err (Error.Invalid_request { 79 79 - reason = "Invalid HTTP version: " ^ version 80 80 - }))); 92 92 + let version_str = http_version r in 93 93 + (* Parse and validate HTTP version *) 94 94 + let version = http_version_of_string version_str in 81 95 sp r; 82 96 let code = status_code r in 83 97 sp r; 84 98 let _reason = reason_phrase r in 85 85 - Log.debug (fun m -> m "Parsed status line: %s %d" version code); 86 86 - code 99 99 + Log.debug (fun m -> m "Parsed status line: %s %d" version_str code); 100 100 + (version, code) 87 101 88 102 (** {1 Header Parsing} *) 89 103 ··· 364 378 365 379 (** Parse complete response (status + headers + body) to string *) 366 380 let response ~limits r = 367 367 - let status = status_line r in 381 381 + let (version, status) = status_line r in 368 382 let hdrs = headers ~limits r in 369 383 370 384 (* Determine how to read body *) 371 385 let transfer_encoding = Headers.get "transfer-encoding" hdrs in 372 386 let content_length = Headers.get "content-length" hdrs |> Option.map Int64.of_string in 373 387 388 388 + (* Per RFC 9112 Section 6.3: When both Transfer-Encoding and Content-Length 389 389 + are present, Transfer-Encoding takes precedence. The presence of both 390 390 + headers is a potential HTTP request smuggling attack indicator. *) 374 391 let body = match transfer_encoding, content_length with 375 375 - | Some te, _ when String.lowercase_ascii te |> String.trim = "chunked" -> 392 392 + | Some te, Some _ when String.lowercase_ascii te |> String.trim = "chunked" -> 393 393 + (* Both headers present - log warning per RFC 9112 Section 6.3 *) 394 394 + Log.warn (fun m -> m "Both Transfer-Encoding and Content-Length present - \ 395 395 + ignoring Content-Length per RFC 9112 (potential attack indicator)"); 396 396 + chunked_body ~limits r 397 397 + | Some te, None when String.lowercase_ascii te |> String.trim = "chunked" -> 376 398 Log.debug (fun m -> m "Reading chunked response body"); 377 399 chunked_body ~limits r 378 400 | _, Some len -> ··· 386 408 "" 387 409 in 388 410 389 389 - (status, hdrs, body) 411 411 + (version, status, hdrs, body) 390 412 391 413 (** Response with streaming body *) 392 414 type stream_response = { 415 415 + http_version : http_version; 393 416 status : int; 394 417 headers : Headers.t; 395 418 body : [ `String of string ··· 398 421 } 399 422 400 423 let response_stream ~limits r = 401 401 - let status = status_line r in 424 424 + let (version, status) = status_line r in 402 425 let hdrs = headers ~limits r in 403 426 404 427 (* Determine body type *) 405 428 let transfer_encoding = Headers.get "transfer-encoding" hdrs in 406 429 let content_length = Headers.get "content-length" hdrs |> Option.map Int64.of_string in 407 430 431 431 + (* Per RFC 9112 Section 6.3: When both Transfer-Encoding and Content-Length 432 432 + are present, Transfer-Encoding takes precedence. The presence of both 433 433 + headers is a potential HTTP request smuggling attack indicator. *) 408 434 let body = match transfer_encoding, content_length with 409 409 - | Some te, _ when String.lowercase_ascii te |> String.trim = "chunked" -> 435 435 + | Some te, Some _ when String.lowercase_ascii te |> String.trim = "chunked" -> 436 436 + (* Both headers present - log warning per RFC 9112 Section 6.3 *) 437 437 + Log.warn (fun m -> m "Both Transfer-Encoding and Content-Length present - \ 438 438 + ignoring Content-Length per RFC 9112 (potential attack indicator)"); 439 439 + `Stream (chunked_body_stream ~limits r) 440 440 + | Some te, None when String.lowercase_ascii te |> String.trim = "chunked" -> 410 441 Log.debug (fun m -> m "Creating chunked body stream"); 411 442 `Stream (chunked_body_stream ~limits r) 412 443 | _, Some len -> ··· 420 451 `None 421 452 in 422 453 423 423 - { status; headers = hdrs; body } 454 454 + { http_version = version; status; headers = hdrs; body } 424 455 425 456 (** {1 Convenience Functions} *) 426 457

+24 -5

lib/http_read.mli

··· 21 21 type limits = Response_limits.t 22 22 (** Alias for {!Response_limits.t}. See {!Response_limits} for documentation. *) 23 23 24 24 + (** {1 HTTP Version Type} 25 25 + 26 26 + Per Recommendation #26: Expose HTTP version used for the response. *) 27 27 + 28 28 + type http_version = 29 29 + | HTTP_1_0 (** HTTP/1.0 *) 30 30 + | HTTP_1_1 (** HTTP/1.1 *) 31 31 + (** HTTP protocol version. Useful for debugging protocol negotiation 32 32 + and monitoring HTTP/2 adoption (when supported). *) 33 33 + 34 34 + val http_version_to_string : http_version -> string 35 35 + (** [http_version_to_string v] returns "HTTP/1.0" or "HTTP/1.1". *) 36 36 + 24 37 (** {1 Low-level Parsers} *) 25 38 26 39 val http_version : Eio.Buf_read.t -> string ··· 30 43 (** [status_code r] parses a 3-digit HTTP status code. 31 44 @raise Error.t if the status code is invalid. *) 32 45 33 33 - val status_line : Eio.Buf_read.t -> int 34 34 - (** [status_line r] parses a complete HTTP status line and returns the status code. 46 46 + val status_line : Eio.Buf_read.t -> http_version * int 47 47 + (** [status_line r] parses a complete HTTP status line and returns 48 48 + the HTTP version and status code as a tuple. 35 49 Validates that the HTTP version is 1.0 or 1.1. 36 50 @raise Error.t if the status line is invalid. *) 37 51 ··· 74 88 75 89 (** {1 High-level Response Parsing} *) 76 90 77 77 - val response : limits:limits -> Eio.Buf_read.t -> int * Headers.t * string 91 91 + val response : limits:limits -> Eio.Buf_read.t -> http_version * int * Headers.t * string 78 92 (** [response ~limits r] parses a complete HTTP response including: 79 79 - - Status line (returns status code) 93 93 + - HTTP version 94 94 + - Status code 80 95 - Headers 81 96 - Body (based on Transfer-Encoding or Content-Length) 82 97 98 98 + Returns [(http_version, status, headers, body)]. 99 99 + 83 100 This reads the entire body into memory. For large responses, 84 101 use {!response_stream} instead. *) 85 102 86 103 (** {1 Streaming Response} *) 87 104 88 105 type stream_response = { 106 106 + http_version : http_version; (** HTTP protocol version *) 89 107 status : int; 90 108 headers : Headers.t; 91 109 body : [ `String of string 92 110 | `Stream of Eio.Flow.source_ty Eio.Resource.t 93 111 | `None ] 94 112 } 95 95 - (** A parsed response with optional streaming body. *) 113 113 + (** A parsed response with optional streaming body. 114 114 + Per Recommendation #26: Includes HTTP version for debugging/monitoring. *) 96 115 97 116 val response_stream : limits:limits -> Eio.Buf_read.t -> stream_response 98 117 (** [response_stream ~limits r] parses status line and headers, then

+38 -14

lib/one.ml

··· 170 170 ?(verify_tls = true) ?tls_config ?(auto_decompress = true) 171 171 ?(min_tls_version = TLS_1_2) 172 172 ?(expect_100_continue = true) ?(expect_100_continue_threshold = 1_048_576L) 173 173 + ?(allow_insecure_auth = false) 173 174 ~method_ url = 174 175 175 176 let start_time = Unix.gettimeofday () in ··· 179 180 (* Prepare headers *) 180 181 let headers = Option.value headers ~default:Headers.empty in 181 182 182 182 - (* Apply auth *) 183 183 + (* Add default User-Agent if not already set - per RFC 9110 Section 10.1.5 *) 184 184 + let headers = 185 185 + if not (Headers.mem "User-Agent" headers) then 186 186 + Headers.set "User-Agent" Version.user_agent headers 187 187 + else 188 188 + headers 189 189 + in 190 190 + 191 191 + (* Apply auth with secure transport validation per RFC 7617/6750 *) 183 192 let headers = Option.fold ~none:headers auth ~some:(fun a -> 184 193 Log.debug (fun m -> m "Applying authentication"); 185 185 - Auth.apply a headers) 194 194 + Auth.apply_secure ~allow_insecure_auth ~url a headers) 186 195 in 187 196 188 197 (* Add content type from body *) ··· 286 295 287 296 (* Convenience methods *) 288 297 let get ~sw ~clock ~net ?headers ?auth ?timeout 289 289 - ?follow_redirects ?max_redirects ?verify_tls ?tls_config ?min_tls_version url = 298 298 + ?follow_redirects ?max_redirects ?verify_tls ?tls_config ?min_tls_version 299 299 + ?allow_insecure_auth url = 290 300 request ~sw ~clock ~net ?headers ?auth ?timeout 291 301 ?follow_redirects ?max_redirects ?verify_tls ?tls_config ?min_tls_version 302 302 + ?allow_insecure_auth 292 303 ~expect_100_continue:false (* GET has no body *) 293 304 ~method_:`GET url 294 305 295 306 let post ~sw ~clock ~net ?headers ?body ?auth ?timeout 296 307 ?verify_tls ?tls_config ?min_tls_version 297 297 - ?expect_100_continue ?expect_100_continue_threshold url = 308 308 + ?expect_100_continue ?expect_100_continue_threshold 309 309 + ?allow_insecure_auth url = 298 310 request ~sw ~clock ~net ?headers ?body ?auth ?timeout 299 311 ?verify_tls ?tls_config ?min_tls_version 300 300 - ?expect_100_continue ?expect_100_continue_threshold ~method_:`POST url 312 312 + ?expect_100_continue ?expect_100_continue_threshold 313 313 + ?allow_insecure_auth ~method_:`POST url 301 314 302 315 let put ~sw ~clock ~net ?headers ?body ?auth ?timeout 303 316 ?verify_tls ?tls_config ?min_tls_version 304 304 - ?expect_100_continue ?expect_100_continue_threshold url = 317 317 + ?expect_100_continue ?expect_100_continue_threshold 318 318 + ?allow_insecure_auth url = 305 319 request ~sw ~clock ~net ?headers ?body ?auth ?timeout 306 320 ?verify_tls ?tls_config ?min_tls_version 307 307 - ?expect_100_continue ?expect_100_continue_threshold ~method_:`PUT url 321 321 + ?expect_100_continue ?expect_100_continue_threshold 322 322 + ?allow_insecure_auth ~method_:`PUT url 308 323 309 324 let delete ~sw ~clock ~net ?headers ?auth ?timeout 310 310 - ?verify_tls ?tls_config ?min_tls_version url = 325 325 + ?verify_tls ?tls_config ?min_tls_version 326 326 + ?allow_insecure_auth url = 311 327 request ~sw ~clock ~net ?headers ?auth ?timeout 312 328 ?verify_tls ?tls_config ?min_tls_version 329 329 + ?allow_insecure_auth 313 330 ~expect_100_continue:false (* DELETE typically has no body *) 314 331 ~method_:`DELETE url 315 332 316 333 let head ~sw ~clock ~net ?headers ?auth ?timeout 317 317 - ?verify_tls ?tls_config ?min_tls_version url = 334 334 + ?verify_tls ?tls_config ?min_tls_version 335 335 + ?allow_insecure_auth url = 318 336 request ~sw ~clock ~net ?headers ?auth ?timeout 319 337 ?verify_tls ?tls_config ?min_tls_version 338 338 + ?allow_insecure_auth 320 339 ~expect_100_continue:false (* HEAD has no body *) 321 340 ~method_:`HEAD url 322 341 323 342 let patch ~sw ~clock ~net ?headers ?body ?auth ?timeout 324 343 ?verify_tls ?tls_config ?min_tls_version 325 325 - ?expect_100_continue ?expect_100_continue_threshold url = 344 344 + ?expect_100_continue ?expect_100_continue_threshold 345 345 + ?allow_insecure_auth url = 326 346 request ~sw ~clock ~net ?headers ?body ?auth ?timeout 327 347 ?verify_tls ?tls_config ?min_tls_version 328 328 - ?expect_100_continue ?expect_100_continue_threshold ~method_:`PATCH url 348 348 + ?expect_100_continue ?expect_100_continue_threshold 349 349 + ?allow_insecure_auth ~method_:`PATCH url 329 350 330 351 let upload ~sw ~clock ~net ?headers ?auth ?timeout ?method_ ?mime ?length 331 352 ?on_progress ?verify_tls ?tls_config ?min_tls_version 332 332 - ?(expect_100_continue = true) ?expect_100_continue_threshold ~source url = 353 353 + ?(expect_100_continue = true) ?expect_100_continue_threshold 354 354 + ?allow_insecure_auth ~source url = 333 355 let method_ = Option.value method_ ~default:`POST in 334 356 let mime = Option.value mime ~default:Mime.octet_stream in 335 357 ··· 347 369 let body = Body.of_stream ?length mime tracked_source in 348 370 request ~sw ~clock ~net ?headers ~body ?auth ?timeout 349 371 ?verify_tls ?tls_config ?min_tls_version 372 372 + ?allow_insecure_auth 350 373 ~expect_100_continue ?expect_100_continue_threshold ~method_ url 351 374 352 375 let download ~sw ~clock ~net ?headers ?auth ?timeout ?on_progress 353 353 - ?verify_tls ?tls_config ?min_tls_version url ~sink = 376 376 + ?verify_tls ?tls_config ?min_tls_version ?allow_insecure_auth url ~sink = 354 377 let response = get ~sw ~clock ~net ?headers ?auth ?timeout 355 355 - ?verify_tls ?tls_config ?min_tls_version url in 378 378 + ?verify_tls ?tls_config ?min_tls_version 379 379 + ?allow_insecure_auth url in 356 380 357 381 try 358 382 (* Get content length for progress tracking *)

+14 -1

lib/one.mli

··· 75 75 ?min_tls_version:tls_version -> 76 76 ?expect_100_continue:bool -> 77 77 ?expect_100_continue_threshold:int64 -> 78 78 + ?allow_insecure_auth:bool -> 78 79 method_:Method.t -> 79 80 string -> 80 81 Response.t 81 82 (** [request ~sw ~clock ~net ?headers ?body ?auth ?timeout ?follow_redirects 82 83 ?max_redirects ?verify_tls ?tls_config ?auto_decompress ?min_tls_version 83 83 - ?expect_100_continue ?expect_100_continue_threshold ~method_ url] 84 84 + ?expect_100_continue ?expect_100_continue_threshold ?allow_insecure_auth 85 85 + ~method_ url] 84 86 makes a single HTTP request without connection pooling. 85 87 86 88 Each call opens a new TCP connection (with TLS if https://), makes the ··· 101 103 @param min_tls_version Minimum TLS version to accept (default: TLS_1_2) 102 104 @param expect_100_continue Use HTTP 100-continue for large bodies (default: true) 103 105 @param expect_100_continue_threshold Body size threshold to trigger 100-continue (default: 1MB) 106 106 + @param allow_insecure_auth Allow Basic/Bearer/Digest auth over HTTP (default: false). 107 107 + Per RFC 7617 Section 4 and RFC 6750 Section 5.1, these auth methods 108 108 + MUST be used over TLS. Set to [true] only for testing environments. 104 109 @param method_ HTTP method (GET, POST, etc.) 105 110 @param url URL to request 106 111 *) ··· 117 122 ?verify_tls:bool -> 118 123 ?tls_config:Tls.Config.client -> 119 124 ?min_tls_version:tls_version -> 125 125 + ?allow_insecure_auth:bool -> 120 126 string -> 121 127 Response.t 122 128 (** GET request. See {!request} for parameter details. *) ··· 134 140 ?min_tls_version:tls_version -> 135 141 ?expect_100_continue:bool -> 136 142 ?expect_100_continue_threshold:int64 -> 143 143 + ?allow_insecure_auth:bool -> 137 144 string -> 138 145 Response.t 139 146 (** POST request with 100-continue support. See {!request} for parameter details. *) ··· 151 158 ?min_tls_version:tls_version -> 152 159 ?expect_100_continue:bool -> 153 160 ?expect_100_continue_threshold:int64 -> 161 161 + ?allow_insecure_auth:bool -> 154 162 string -> 155 163 Response.t 156 164 (** PUT request with 100-continue support. See {!request} for parameter details. *) ··· 165 173 ?verify_tls:bool -> 166 174 ?tls_config:Tls.Config.client -> 167 175 ?min_tls_version:tls_version -> 176 176 + ?allow_insecure_auth:bool -> 168 177 string -> 169 178 Response.t 170 179 (** DELETE request. See {!request} for parameter details. *) ··· 179 188 ?verify_tls:bool -> 180 189 ?tls_config:Tls.Config.client -> 181 190 ?min_tls_version:tls_version -> 191 191 + ?allow_insecure_auth:bool -> 182 192 string -> 183 193 Response.t 184 194 (** HEAD request. See {!request} for parameter details. *) ··· 196 206 ?min_tls_version:tls_version -> 197 207 ?expect_100_continue:bool -> 198 208 ?expect_100_continue_threshold:int64 -> 209 209 + ?allow_insecure_auth:bool -> 199 210 string -> 200 211 Response.t 201 212 (** PATCH request with 100-continue support. See {!request} for parameter details. *) ··· 216 227 ?min_tls_version:tls_version -> 217 228 ?expect_100_continue:bool -> 218 229 ?expect_100_continue_threshold:int64 -> 230 230 + ?allow_insecure_auth:bool -> 219 231 source:Eio.Flow.source_ty Eio.Resource.t -> 220 232 string -> 221 233 Response.t ··· 233 245 ?verify_tls:bool -> 234 246 ?tls_config:Tls.Config.client -> 235 247 ?min_tls_version:tls_version -> 248 248 + ?allow_insecure_auth:bool -> 236 249 string -> 237 250 sink:Eio.Flow.sink_ty Eio.Resource.t -> 238 251 unit

+9

lib/requests.ml

··· 24 24 module Cache_control = Cache_control 25 25 module Response_limits = Response_limits 26 26 module Expect_continue = Expect_continue 27 27 + module Version = Version 27 28 28 29 (** Minimum TLS version configuration. 29 30 Per Recommendation #6: Allow enforcing minimum TLS version. *) ··· 292 293 let headers = match headers with 293 294 | Some h -> Headers.merge t.default_headers h 294 295 | None -> t.default_headers 296 296 + in 297 297 + 298 298 + (* Add default User-Agent if not already set - per RFC 9110 Section 10.1.5 *) 299 299 + let headers = 300 300 + if not (Headers.mem "User-Agent" headers) then 301 301 + Headers.set "User-Agent" Version.user_agent headers 302 302 + else 303 303 + headers 295 304 in 296 305 297 306 (* Use provided auth or default *)

+15

lib/response.ml

··· 193 193 else 194 194 t 195 195 196 196 + (** Result-based status check - per Recommendation #21. 197 197 + Returns Ok response for 2xx success, Error for 4xx/5xx errors. 198 198 + Enables functional error handling without exceptions. *) 199 199 + let check_status t = 200 200 + if t.status >= 400 then 201 201 + Error (Error.Http_error { 202 202 + url = t.url; 203 203 + status = t.status; 204 204 + reason = Status.reason_phrase (Status.of_int t.status); 205 205 + body_preview = None; 206 206 + headers = Headers.to_list t.headers; 207 207 + }) 208 208 + else 209 209 + Ok t 210 210 + 196 211 (* Pretty printers *) 197 212 let pp ppf t = 198 213 Format.fprintf ppf "@[<v>Response:@,\

+16

lib/response.mli

··· 236 236 237 237 @raise Error.HTTPError if status code >= 400. *) 238 238 239 239 + val check_status : t -> (t, Error.error) result 240 240 + (** [check_status response] returns [Ok response] if the status code is < 400, 241 241 + or [Error error] if the status code indicates an error (>= 400). 242 242 + 243 243 + This provides functional error handling without exceptions, complementing 244 244 + {!raise_for_status} for different coding styles. 245 245 + 246 246 + Example: 247 247 + {[ 248 248 + match Response.check_status response with 249 249 + | Ok resp -> process_success resp 250 250 + | Error err -> handle_error err 251 251 + ]} 252 252 + 253 253 + Per Recommendation #21: Provides a Result-based alternative to raise_for_status. *) 254 254 + 239 255 (** {1 Pretty Printing} *) 240 256 241 257 val pp : Format.formatter -> t -> unit

+31 -18

lib/retry.ml

··· 70 70 attempt base_delay config.jitter final_delay); 71 71 final_delay 72 72 73 73 - let parse_retry_after value = 73 73 + (** Parse Retry-After header and cap to backoff_max to prevent DoS. 74 74 + Per RFC 9110 Section 10.2.3 and Recommendation #5: 75 75 + Cap server-specified Retry-After values to prevent malicious servers 76 76 + from causing indefinite client blocking. *) 77 77 + let parse_retry_after ?(backoff_max = 120.0) value = 74 78 Log.debug (fun m -> m "Parsing Retry-After header: %s" value); 75 79 76 76 - (* First try to parse as integer (delay in seconds) *) 77 77 - match int_of_string_opt value with 78 78 - | Some seconds -> 79 79 - Log.debug (fun m -> m "Retry-After is %d seconds" seconds); 80 80 - Some (float_of_int seconds) 81 81 - | None -> 82 82 - (* Try to parse as HTTP date (RFC 3339 format) *) 83 83 - match Ptime.of_rfc3339 value with 84 84 - | Ok (time, _tz_offset, _tz_string) -> 85 85 - let now = Unix.time () in 86 86 - let target = Ptime.to_float_s time in 87 87 - let delay = max 0.0 (target -. now) in 88 88 - Log.debug (fun m -> m "Retry-After is HTTP date, delay=%.2f seconds" delay); 89 89 - Some delay 90 90 - | Error _ -> 91 91 - Log.warn (fun m -> m "Failed to parse Retry-After header: %s" value); 92 92 - None 80 80 + let raw_delay = 81 81 + (* First try to parse as integer (delay in seconds) *) 82 82 + match int_of_string_opt value with 83 83 + | Some seconds -> 84 84 + Log.debug (fun m -> m "Retry-After is %d seconds" seconds); 85 85 + Some (float_of_int seconds) 86 86 + | None -> 87 87 + (* Try to parse as HTTP date (RFC 3339 format) *) 88 88 + match Ptime.of_rfc3339 value with 89 89 + | Ok (time, _tz_offset, _tz_string) -> 90 90 + let now = Unix.time () in 91 91 + let target = Ptime.to_float_s time in 92 92 + let delay = max 0.0 (target -. now) in 93 93 + Log.debug (fun m -> m "Retry-After is HTTP date, delay=%.2f seconds" delay); 94 94 + Some delay 95 95 + | Error _ -> 96 96 + Log.warn (fun m -> m "Failed to parse Retry-After header: %s" value); 97 97 + None 98 98 + in 99 99 + (* Cap to backoff_max to prevent DoS from malicious Retry-After values *) 100 100 + match raw_delay with 101 101 + | Some delay when delay > backoff_max -> 102 102 + Log.warn (fun m -> m "Retry-After delay %.2fs exceeds backoff_max %.2fs, capping" 103 103 + delay backoff_max); 104 104 + Some backoff_max 105 105 + | other -> other 93 106 94 107 let with_retry ~sw:_ ~clock ~config ~f ~should_retry_exn = 95 108 let rec attempt_with_retry attempt =

+5 -2

lib/retry.mli

··· 41 41 (** Calculate backoff delay for a given attempt *) 42 42 val calculate_backoff : config:config -> attempt:int -> float 43 43 44 44 - (** Parse Retry-After header value (seconds or HTTP date) *) 45 45 - val parse_retry_after : string -> float option 44 44 + (** Parse Retry-After header value (seconds or HTTP date). 45 45 + Per RFC 9110 Section 10.2.3 and Recommendation #5: 46 46 + Values are capped to [backoff_max] (default 120s) to prevent DoS 47 47 + from malicious servers specifying extremely long delays. *) 48 48 + val parse_retry_after : ?backoff_max:float -> string -> float option 46 49 47 50 (** Execute a request with retry logic *) 48 51 val with_retry :

+20

lib/version.ml

··· 1 1 + (*--------------------------------------------------------------------------- 2 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 3 + SPDX-License-Identifier: ISC 4 4 + ---------------------------------------------------------------------------*) 5 5 + 6 6 + (** Library version and User-Agent header support. 7 7 + Per RFC 9110 Section 10.1.5 and Recommendation #30: 8 8 + Set a default User-Agent to help server-side debugging. *) 9 9 + 10 10 + (** Library version - update this when releasing new versions *) 11 11 + let version = "0.1.0" 12 12 + 13 13 + (** Library name *) 14 14 + let name = "ocaml-requests" 15 15 + 16 16 + (** Default User-Agent header value. 17 17 + Format follows common conventions: library-name/version (runtime-info) 18 18 + Per RFC 9110 Section 10.1.5, this helps with debugging and statistics. *) 19 19 + let user_agent = 20 20 + Printf.sprintf "%s/%s (OCaml %s)" name version Sys.ocaml_version

+23

lib/version.mli

··· 1 1 + (*--------------------------------------------------------------------------- 2 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 3 + SPDX-License-Identifier: ISC 4 4 + ---------------------------------------------------------------------------*) 5 5 + 6 6 + (** Library version and User-Agent header support. 7 7 + Per RFC 9110 Section 10.1.5 and Recommendation #30: 8 8 + Provides a default User-Agent header for HTTP requests. *) 9 9 + 10 10 + val version : string 11 11 + (** Library version string (e.g., "0.1.0") *) 12 12 + 13 13 + val name : string 14 14 + (** Library name ("ocaml-requests") *) 15 15 + 16 16 + val user_agent : string 17 17 + (** Default User-Agent header value. 18 18 + Format: "ocaml-requests/VERSION (OCaml OCAML_VERSION)" 19 19 + Example: "ocaml-requests/0.1.0 (OCaml 5.2.0)" 20 20 + 21 21 + Per RFC 9110 Section 10.1.5, this helps server-side debugging 22 22 + and monitoring. The User-Agent is automatically added to requests 23 23 + unless the user provides their own. *)