My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1let src = Logs.Src.create "requests.headers" ~doc:"HTTP Headers"
2module Log = (val Logs.src_log src : Logs.LOG)
3
4(* Use a map with lowercase keys for case-insensitive lookup *)
5module StringMap = Map.Make(String)
6
7type t = (string * string list) StringMap.t
8
9let empty = StringMap.empty
10
11let normalize_key k = String.lowercase_ascii k
12
13let add key value t =
14 let nkey = normalize_key key in
15 Log.debug (fun m -> m "Adding header %s: %s" key value);
16 let existing =
17 match StringMap.find_opt nkey t with
18 | Some (_, values) -> values
19 | None -> []
20 in
21 StringMap.add nkey (key, value :: existing) t
22
23let set key value t =
24 let nkey = normalize_key key in
25 StringMap.add nkey (key, [value]) t
26
27let get key t =
28 let nkey = normalize_key key in
29 match StringMap.find_opt nkey t with
30 | Some (_, values) -> List.nth_opt values 0
31 | None -> None
32
33let get_all key t =
34 let nkey = normalize_key key in
35 match StringMap.find_opt nkey t with
36 | Some (_, values) -> List.rev values
37 | None -> []
38
39let remove key t =
40 let nkey = normalize_key key in
41 StringMap.remove nkey t
42
43let mem key t =
44 let nkey = normalize_key key in
45 StringMap.mem nkey t
46
47let of_list lst =
48 List.fold_left (fun acc (k, v) -> add k v acc) empty lst
49
50let to_list t =
51 StringMap.fold (fun _ (orig_key, values) acc ->
52 List.fold_left (fun acc v -> (orig_key, v) :: acc) acc (List.rev values)
53 ) t []
54
55let merge t1 t2 =
56 StringMap.union (fun _ _ v2 -> Some v2) t1 t2
57
58(* Common header builders *)
59
60let content_type mime t =
61 set "Content-Type" (Mime.to_string mime) t
62
63let content_length len t =
64 set "Content-Length" (Int64.to_string len) t
65
66let accept mime t =
67 set "Accept" (Mime.to_string mime) t
68
69let authorization value t =
70 set "Authorization" value t
71
72let bearer token t =
73 set "Authorization" (Printf.sprintf "Bearer %s" token) t
74
75let basic ~username ~password t =
76 let credentials = Printf.sprintf "%s:%s" username password in
77 let encoded = Base64.encode_exn credentials in
78 set "Authorization" (Printf.sprintf "Basic %s" encoded) t
79
80let user_agent ua t =
81 set "User-Agent" ua t
82
83let host h t =
84 set "Host" h t
85
86let cookie name value t =
87 add "Cookie" (Printf.sprintf "%s=%s" name value) t
88
89let range ~start ?end_ () t =
90 let range_value = match end_ with
91 | None -> Printf.sprintf "bytes=%Ld-" start
92 | Some e -> Printf.sprintf "bytes=%Ld-%Ld" start e
93 in
94 set "Range" range_value t
95
96(* Additional helper for getting multiple header values *)
97let get_multi key t = get_all key t
98
99(* Pretty printer for headers *)
100let pp ppf t =
101 Format.fprintf ppf "@[<v>Headers:@,";
102 let headers = to_list t in
103 List.iter (fun (k, v) ->
104 Format.fprintf ppf " %s: %s@," k v
105 ) headers;
106 Format.fprintf ppf "@]"
107
108let pp_brief ppf t =
109 let headers = to_list t in
110 let count = List.length headers in
111 Format.fprintf ppf "Headers(%d entries)" count