gazagnaire.org
forked from
anil.recoil.org/ocaml-requests
A batteries included HTTP/1.1 client in OCaml
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6(** HTTP 100-Continue configuration
7
8 Configuration for the HTTP 100-Continue protocol, which allows clients to
9 check if the server will accept a request before sending a large body. Per
10 RFC 9110 Section 10.1.1 (Expect) and Section 15.2.1 (100 Continue). *)
11
12type config =
13 [ `Disabled (** Never use 100-continue *)
14 | `Always (** Always use 100-continue regardless of body size *)
15 | `Threshold of int64 (** Use 100-continue for bodies >= threshold bytes *)
16 ]
17(** User-facing configuration as a polymorphic variant *)
18
19type t = { enabled : bool; threshold : int64; timeout : float }
20(** Internal representation *)
21
22let default_threshold = 1_048_576L (* 1MB *)
23
24let default =
25 {
26 enabled = true;
27 threshold = default_threshold;
28 timeout = 1.0;
29 (* 1 second *)
30 }
31
32let of_config ?(timeout = 1.0) (config : config) : t =
33 match config with
34 | `Disabled -> { enabled = false; threshold = 0L; timeout }
35 | `Always -> { enabled = true; threshold = 0L; timeout }
36 | `Threshold n -> { enabled = true; threshold = n; timeout }
37
38let v ?(enabled = true) ?(threshold = 1_048_576L) ?(timeout = 1.0) () =
39 { enabled; threshold; timeout }
40
41let disabled = { enabled = false; threshold = 0L; timeout = 0.0 }
42let enabled t = t.enabled
43let threshold t = t.threshold
44let timeout t = t.timeout
45let should_use t body_size = t.enabled && body_size >= t.threshold
46
47let pp fmt t =
48 if not t.enabled then Fmt.pf fmt "100-continue: disabled"
49 else if t.threshold = 0L then
50 Fmt.pf fmt "100-continue: always (timeout: %.2fs)" t.timeout
51 else
52 Fmt.pf fmt "100-continue: threshold %Ld bytes (timeout: %.2fs)" t.threshold
53 t.timeout
54
55let to_string t = Fmt.str "%a" pp t
56
57let pp_config fmt (config : config) =
58 match config with
59 | `Disabled -> Fmt.pf fmt "`Disabled"
60 | `Always -> Fmt.pf fmt "`Always"
61 | `Threshold n -> Fmt.pf fmt "`Threshold %Ld" n