jon.recoil.org
forked from
anil.recoil.org/monopam-myspace
My aggregated monorepo of OCaml code, automaintained
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6(** HTTP Link header parsing per RFC 8288
7
8 This module parses Link headers for pagination, API discovery, and
9 relationship navigation. Per Recommendation #19.
10
11 Link header example:
12 {[
13 Link: <https://api.example.com/users?page=2>; rel="next",
14 <https://api.example.com/users?page=5>; rel="last"
15 ]}
16*)
17
18let src = Logs.Src.create "requests.link" ~doc:"HTTP Link header parsing"
19module Log = (val Logs.src_log src : Logs.LOG)
20
21(** A parsed Link header entry *)
22type t = {
23 uri : string; (** The target URI *)
24 rel : string option; (** The relation type (e.g., "next", "prev", "last") *)
25 title : string option; (** Human-readable title *)
26 media_type : string option; (** Media type hint *)
27 hreflang : string option; (** Language hint *)
28 params : (string * string) list; (** Additional parameters *)
29}
30
31let make ~uri ?rel ?title ?media_type ?hreflang ?(params=[]) () =
32 { uri; rel; title; media_type; hreflang; params }
33
34let uri t = t.uri
35let rel t = t.rel
36let title t = t.title
37let media_type t = t.media_type
38let hreflang t = t.hreflang
39let params t = t.params
40
41(** Parse a single link value from a Link header segment.
42 Format: <uri>; param1=value1; param2="value2" *)
43let parse_link_value str =
44 let str = String.trim str in
45
46 (* Find the URI in angle brackets *)
47 if String.length str = 0 || str.[0] <> '<' then begin
48 Log.debug (fun m -> m "Invalid link value, missing '<': %s" str);
49 None
50 end else begin
51 match String.index_opt str '>' with
52 | None ->
53 Log.debug (fun m -> m "Invalid link value, missing '>': %s" str);
54 None
55 | Some close_idx ->
56 let uri = String.sub str 1 (close_idx - 1) in
57 let params_str =
58 if close_idx + 1 < String.length str then
59 String.sub str (close_idx + 1) (String.length str - close_idx - 1)
60 else ""
61 in
62
63 (* Parse parameters *)
64 let params = String.split_on_char ';' params_str in
65 let parsed_params = List.filter_map (fun param ->
66 let param = String.trim param in
67 if param = "" then None
68 else begin
69 match String.index_opt param '=' with
70 | None -> None
71 | Some eq_idx ->
72 let key = String.trim (String.sub param 0 eq_idx) in
73 let value_raw = String.trim (String.sub param (eq_idx + 1) (String.length param - eq_idx - 1)) in
74 (* Remove quotes if present *)
75 let value =
76 if String.length value_raw >= 2 &&
77 value_raw.[0] = '"' &&
78 value_raw.[String.length value_raw - 1] = '"' then
79 String.sub value_raw 1 (String.length value_raw - 2)
80 else
81 value_raw
82 in
83 Some (String.lowercase_ascii key, value)
84 end
85 ) params in
86
87 (* Extract known parameters *)
88 let rel = List.assoc_opt "rel" parsed_params in
89 let title = List.assoc_opt "title" parsed_params in
90 let media_type = List.assoc_opt "type" parsed_params in
91 let hreflang = List.assoc_opt "hreflang" parsed_params in
92
93 (* Keep other params *)
94 let other_params = List.filter (fun (k, _) ->
95 not (List.mem k ["rel"; "title"; "type"; "hreflang"])
96 ) parsed_params in
97
98 Log.debug (fun m -> m "Parsed link: uri=%s rel=%s"
99 uri (Option.value rel ~default:"<none>"));
100
101 Some { uri; rel; title; media_type; hreflang; params = other_params }
102 end
103
104(** Parse a complete Link header value (may contain multiple links) *)
105let parse header_value =
106 Log.debug (fun m -> m "Parsing Link header: %s" header_value);
107
108 (* Split on commas, but be careful of commas inside quotes *)
109 let rec split_links str acc current in_quotes =
110 if String.length str = 0 then
111 let final = String.trim current in
112 if final = "" then List.rev acc else List.rev (final :: acc)
113 else
114 let c = str.[0] in
115 let rest = String.sub str 1 (String.length str - 1) in
116 if c = '"' then
117 split_links rest acc (current ^ String.make 1 c) (not in_quotes)
118 else if c = ',' && not in_quotes then
119 let trimmed = String.trim current in
120 if trimmed = "" then
121 split_links rest acc "" false
122 else
123 split_links rest (trimmed :: acc) "" false
124 else
125 split_links rest acc (current ^ String.make 1 c) in_quotes
126 in
127
128 let link_strs = split_links header_value [] "" false in
129 List.filter_map parse_link_value link_strs
130
131(** Parse Link header from response headers *)
132let from_headers headers =
133 match Headers.get `Link headers with
134 | None -> []
135 | Some value -> parse value
136
137(** Find a link by relation type *)
138let find_rel rel links =
139 List.find_opt (fun l -> l.rel = Some rel) links
140
141(** Find all links with a specific relation type *)
142let filter_rel rel links =
143 List.filter (fun l -> l.rel = Some rel) links
144
145(** Get pagination links from headers.
146 Returns (first, prev, next, last) where each is optional. *)
147let pagination headers =
148 let links = from_headers headers in
149 let first = find_rel "first" links |> Option.map uri in
150 let prev = find_rel "prev" links |> Option.map uri in
151 let next = find_rel "next" links |> Option.map uri in
152 let last = find_rel "last" links |> Option.map uri in
153 (first, prev, next, last)
154
155(** Check if there are more pages (next link exists) *)
156let has_next headers =
157 let links = from_headers headers in
158 Option.is_some (find_rel "next" links)
159
160(** Get the next page URL if available *)
161let next_url headers =
162 let links = from_headers headers in
163 find_rel "next" links |> Option.map uri
164
165(** Get the previous page URL if available *)
166let prev_url headers =
167 let links = from_headers headers in
168 find_rel "prev" links |> Option.map uri
169
170(** Pretty-print a link *)
171let pp ppf link =
172 Format.fprintf ppf "<%s>" link.uri;
173 Option.iter (fun r -> Format.fprintf ppf "; rel=\"%s\"" r) link.rel;
174 Option.iter (fun t -> Format.fprintf ppf "; title=\"%s\"" t) link.title;
175 Option.iter (fun t -> Format.fprintf ppf "; type=\"%s\"" t) link.media_type;
176 Option.iter (fun h -> Format.fprintf ppf "; hreflang=\"%s\"" h) link.hreflang;
177 List.iter (fun (k, v) -> Format.fprintf ppf "; %s=\"%s\"" k v) link.params
178
179let to_string link =
180 Format.asprintf "%a" pp link