anil.recoil.org
OpenAPI generator for OCaml with Requests/Eio/Jsont
1(** Runtime utilities for generated OpenAPI clients.
2
3 This module provides utilities used by generated client code:
4 - Path template rendering
5 - Query parameter building
6 - JSON encoding/decoding helpers
7*)
8
9(** {1 Path Templates} *)
10
11module Path = struct
12 (** Render a path template like "/users/{id}/posts/{postId}" with parameters *)
13 let render ~(params : (string * string) list) (template : string) : string =
14 List.fold_left
15 (fun path (name, value) ->
16 match String.split_on_char '{' path with
17 | [only] -> only
18 | parts ->
19 String.concat "" (List.mapi (fun i part ->
20 if i = 0 then part
21 else
22 match String.split_on_char '}' part with
23 | [var; rest] when var = name -> value ^ rest
24 | _ -> "{" ^ part
25 ) parts))
26 template params
27
28 (** Extract parameter names from a path template *)
29 let parameters (template : string) : string list =
30 let rec extract acc s =
31 match String.index_opt s '{' with
32 | None -> List.rev acc
33 | Some i ->
34 let rest = String.sub s (i + 1) (String.length s - i - 1) in
35 match String.index_opt rest '}' with
36 | None -> List.rev acc
37 | Some j ->
38 let name = String.sub rest 0 j in
39 let remaining = String.sub rest (j + 1) (String.length rest - j - 1) in
40 extract (name :: acc) remaining
41 in
42 extract [] template
43end
44
45(** {1 Query Parameters} *)
46
47module Query = struct
48 type param = string * string
49
50 (** Helper for optional parameters with custom stringifier *)
51 let optional_with ~key ~value ~to_string : param list =
52 Option.fold ~none:[] ~some:(fun v -> [(key, to_string v)]) value
53
54 let singleton ~key ~value : param list = [(key, value)]
55
56 let optional ~key ~value : param list =
57 optional_with ~key ~value ~to_string:Fun.id
58
59 let list ~key ~values : param list =
60 List.map (fun v -> (key, v)) values
61
62 let int ~key ~value : param list = [(key, string_of_int value)]
63
64 let int_opt ~key ~value : param list =
65 optional_with ~key ~value ~to_string:string_of_int
66
67 let bool ~key ~value : param list =
68 [(key, if value then "true" else "false")]
69
70 let bool_opt ~key ~value : param list =
71 optional_with ~key ~value ~to_string:(fun b -> if b then "true" else "false")
72
73 let float ~key ~value : param list = [(key, string_of_float value)]
74
75 let float_opt ~key ~value : param list =
76 optional_with ~key ~value ~to_string:string_of_float
77
78 let encode (params : param list) : string =
79 if params = [] then ""
80 else
81 "?" ^
82 String.concat "&" (List.map (fun (k, v) ->
83 (* URL encode the value *)
84 let encode_char c =
85 match c with
86 | 'A'..'Z' | 'a'..'z' | '0'..'9' | '-' | '_' | '.' | '~' ->
87 String.make 1 c
88 | c ->
89 Printf.sprintf "%%%02X" (Char.code c)
90 in
91 let encoded_v = String.to_seq v
92 |> Seq.map encode_char
93 |> List.of_seq
94 |> String.concat ""
95 in
96 k ^ "=" ^ encoded_v
97 ) params)
98end
99
100(** {1 JSON Helpers} *)
101
102module Json = struct
103 let decode codec s =
104 Jsont_bytesrw.decode_string codec s
105
106 let decode' codec s =
107 Jsont_bytesrw.decode_string' codec s
108
109 let encode codec v =
110 Jsont_bytesrw.encode_string codec v
111
112 let encode' codec v =
113 Jsont_bytesrw.encode_string' codec v
114
115 let encode_compact codec v =
116 Jsont_bytesrw.encode_string ~format:Jsont.Minify codec v
117
118 (** Decode a Jsont.json value through a codec.
119 Encodes to string then decodes - not optimal but works. *)
120 let decode_json (codec : 'a Jsont.t) (json : Jsont.json) : ('a, string) result =
121 match Jsont_bytesrw.encode_string Jsont.json json with
122 | Ok s -> Jsont_bytesrw.decode_string codec s
123 | Error e -> Error e
124
125 (** Decode a Jsont.json value, raising on error *)
126 let decode_json_exn (codec : 'a Jsont.t) (json : Jsont.json) : 'a =
127 match decode_json codec json with
128 | Ok v -> v
129 | Error e -> failwith e
130
131 (** Encode a value to Jsont.json *)
132 let encode_json (codec : 'a Jsont.t) (v : 'a) : Jsont.json =
133 match Jsont_bytesrw.encode_string codec v with
134 | Ok s ->
135 (match Jsont_bytesrw.decode_string Jsont.json s with
136 | Ok json -> json
137 | Error _ -> Jsont.Null ((), Jsont.Meta.none))
138 | Error _ -> Jsont.Null ((), Jsont.Meta.none)
139end
140
141(** {1 HTTP Method} *)
142
143type http_method = Get | Post | Put | Patch | Delete | Head | Options
144
145let string_of_method = function
146 | Get -> "GET"
147 | Post -> "POST"
148 | Put -> "PUT"
149 | Patch -> "PATCH"
150 | Delete -> "DELETE"
151 | Head -> "HEAD"
152 | Options -> "OPTIONS"
153
154(** {1 Common Types} *)
155
156(** ISO 8601 date-time codec *)
157let ptime_jsont : Ptime.t Jsont.t =
158 Jsont.map Jsont.string ~kind:"datetime"
159 ~dec:(fun s ->
160 match Ptime.of_rfc3339 s with
161 | Ok (t, _, _) -> t
162 | Error _ -> Jsont.Error.msgf Jsont.Meta.none "Invalid datetime: %s" s)
163 ~enc:(fun t -> Ptime.to_rfc3339 t)
164
165(** UUID as string *)
166let uuid_jsont : string Jsont.t = Jsont.string
167
168(** Base64 encoded bytes *)
169let base64_jsont : string Jsont.t = Jsont.string
170
171(** {1 Nullable wrapper} *)
172
173let nullable (codec : 'a Jsont.t) : 'a option Jsont.t =
174 Jsont.option codec
175
176(** Nullable combinator that handles explicit JSON null values.
177 Use this for fields marked as "nullable: true" in OpenAPI specs.
178 Unlike Jsont.option, this properly decodes explicit null as None. *)
179let nullable_any (base_codec : 'a Jsont.t) : 'a option Jsont.t =
180 let null_codec = Jsont.null None in
181 let some_codec = Jsont.map base_codec
182 ~kind:"nullable_some"
183 ~dec:(fun v -> Some v)
184 ~enc:(function Some v -> v | None -> failwith "unreachable")
185 in
186 (* Use Jsont.any to dispatch based on the JSON value type *)
187 Jsont.any
188 ~dec_null:null_codec
189 ~dec_string:some_codec
190 ~dec_number:some_codec
191 ~dec_bool:some_codec
192 ~dec_array:some_codec
193 ~dec_object:some_codec
194 ~enc:(function
195 | None -> null_codec
196 | Some _ -> some_codec)
197 ()
198
199(** Nullable string that handles both absent and explicit null *)
200let nullable_string : string option Jsont.t =
201 nullable_any Jsont.string
202
203(** Nullable ptime that handles both absent and explicit null *)
204let nullable_ptime : Ptime.t option Jsont.t =
205 nullable_any ptime_jsont
206
207(** Nullable int that handles both absent and explicit null *)
208let nullable_int : int option Jsont.t =
209 nullable_any Jsont.int
210
211(** Nullable float that handles both absent and explicit null *)
212let nullable_float : float option Jsont.t =
213 nullable_any Jsont.number
214
215(** Nullable bool that handles both absent and explicit null *)
216let nullable_bool : bool option Jsont.t =
217 nullable_any Jsont.bool
218
219(** {1 Any JSON value wrapper} *)
220
221type json = Jsont.json
222
223let json_jsont : json Jsont.t = Jsont.json
224
225(** {1 Validation} *)
226
227(** Validation error type *)
228type validation_error =
229 | Min_length of { actual: int; min: int }
230 | Max_length of { actual: int; max: int }
231 | Pattern_mismatch of { value: string; pattern: string }
232 | Min_value of { actual: float; min: float; exclusive: bool }
233 | Max_value of { actual: float; max: float; exclusive: bool }
234 | Min_items of { actual: int; min: int }
235 | Max_items of { actual: int; max: int }
236 | Duplicate_items of { count: int }
237
238let validation_error_to_string = function
239 | Min_length { actual; min } ->
240 Printf.sprintf "string too short: %d < %d" actual min
241 | Max_length { actual; max } ->
242 Printf.sprintf "string too long: %d > %d" actual max
243 | Pattern_mismatch { value; pattern } ->
244 Printf.sprintf "value %S does not match pattern %S" value pattern
245 | Min_value { actual; min; exclusive } ->
246 if exclusive then Printf.sprintf "value %g must be > %g" actual min
247 else Printf.sprintf "value %g must be >= %g" actual min
248 | Max_value { actual; max; exclusive } ->
249 if exclusive then Printf.sprintf "value %g must be < %g" actual max
250 else Printf.sprintf "value %g must be <= %g" actual max
251 | Min_items { actual; min } ->
252 Printf.sprintf "array too short: %d < %d items" actual min
253 | Max_items { actual; max } ->
254 Printf.sprintf "array too long: %d > %d items" actual max
255 | Duplicate_items { count } ->
256 Printf.sprintf "array contains %d duplicate items" count
257
258(** Validated string codec with optional length and pattern constraints.
259 Pattern validation uses the Re library with PCRE syntax. *)
260let validated_string
261 ?min_length ?max_length ?pattern
262 (base : string Jsont.t) : string Jsont.t =
263 (* Compile regex if pattern is provided *)
264 let pattern_re = Option.map (fun p ->
265 try Some (Re.compile (Re.Pcre.re p))
266 with _ -> None (* Invalid regex - skip validation *)
267 ) pattern in
268 Jsont.map base ~kind:"validated_string"
269 ~dec:(fun s ->
270 let len = String.length s in
271 (match min_length with
272 | Some min when len < min ->
273 Jsont.Error.msgf Jsont.Meta.none "%s"
274 (validation_error_to_string (Min_length { actual = len; min }))
275 | _ -> ());
276 (match max_length with
277 | Some max when len > max ->
278 Jsont.Error.msgf Jsont.Meta.none "%s"
279 (validation_error_to_string (Max_length { actual = len; max }))
280 | _ -> ());
281 (match pattern_re, pattern with
282 | Some (Some re), Some pat ->
283 if not (Re.execp re s) then
284 Jsont.Error.msgf Jsont.Meta.none "%s"
285 (validation_error_to_string (Pattern_mismatch { value = s; pattern = pat }))
286 | _ -> ());
287 s)
288 ~enc:Fun.id
289
290(** Validated int codec with optional min/max constraints *)
291let validated_int
292 ?minimum ?maximum ?exclusive_minimum ?exclusive_maximum
293 (base : int Jsont.t) : int Jsont.t =
294 Jsont.map base ~kind:"validated_int"
295 ~dec:(fun n ->
296 let f = float_of_int n in
297 (match exclusive_minimum with
298 | Some min when f <= min ->
299 Jsont.Error.msgf Jsont.Meta.none "%s"
300 (validation_error_to_string (Min_value { actual = f; min; exclusive = true }))
301 | _ -> ());
302 (match minimum with
303 | Some min when f < min ->
304 Jsont.Error.msgf Jsont.Meta.none "%s"
305 (validation_error_to_string (Min_value { actual = f; min; exclusive = false }))
306 | _ -> ());
307 (match exclusive_maximum with
308 | Some max when f >= max ->
309 Jsont.Error.msgf Jsont.Meta.none "%s"
310 (validation_error_to_string (Max_value { actual = f; max; exclusive = true }))
311 | _ -> ());
312 (match maximum with
313 | Some max when f > max ->
314 Jsont.Error.msgf Jsont.Meta.none "%s"
315 (validation_error_to_string (Max_value { actual = f; max; exclusive = false }))
316 | _ -> ());
317 n)
318 ~enc:Fun.id
319
320(** Validated float codec with optional min/max constraints *)
321let validated_float
322 ?minimum ?maximum ?exclusive_minimum ?exclusive_maximum
323 (base : float Jsont.t) : float Jsont.t =
324 Jsont.map base ~kind:"validated_float"
325 ~dec:(fun f ->
326 (match exclusive_minimum with
327 | Some min when f <= min ->
328 Jsont.Error.msgf Jsont.Meta.none "%s"
329 (validation_error_to_string (Min_value { actual = f; min; exclusive = true }))
330 | _ -> ());
331 (match minimum with
332 | Some min when f < min ->
333 Jsont.Error.msgf Jsont.Meta.none "%s"
334 (validation_error_to_string (Min_value { actual = f; min; exclusive = false }))
335 | _ -> ());
336 (match exclusive_maximum with
337 | Some max when f >= max ->
338 Jsont.Error.msgf Jsont.Meta.none "%s"
339 (validation_error_to_string (Max_value { actual = f; max; exclusive = true }))
340 | _ -> ());
341 (match maximum with
342 | Some max when f > max ->
343 Jsont.Error.msgf Jsont.Meta.none "%s"
344 (validation_error_to_string (Max_value { actual = f; max; exclusive = false }))
345 | _ -> ());
346 f)
347 ~enc:Fun.id
348
349(** Validated list codec with optional min/max items and uniqueness constraints *)
350let validated_list
351 ?min_items ?max_items ?(unique_items = false)
352 (elem_codec : 'a Jsont.t) : 'a list Jsont.t =
353 let base = Jsont.list elem_codec in
354 Jsont.map base ~kind:"validated_list"
355 ~dec:(fun lst ->
356 let len = List.length lst in
357 (match min_items with
358 | Some min when len < min ->
359 Jsont.Error.msgf Jsont.Meta.none "%s"
360 (validation_error_to_string (Min_items { actual = len; min }))
361 | _ -> ());
362 (match max_items with
363 | Some max when len > max ->
364 Jsont.Error.msgf Jsont.Meta.none "%s"
365 (validation_error_to_string (Max_items { actual = len; max }))
366 | _ -> ());
367 (* Check for unique items using structural equality *)
368 (if unique_items then
369 let rec count_duplicates seen count = function
370 | [] -> count
371 | x :: xs ->
372 if List.exists (( = ) x) seen then
373 count_duplicates seen (count + 1) xs
374 else
375 count_duplicates (x :: seen) count xs
376 in
377 let dup_count = count_duplicates [] 0 lst in
378 if dup_count > 0 then
379 Jsont.Error.msgf Jsont.Meta.none "%s"
380 (validation_error_to_string (Duplicate_items { count = dup_count })));
381 lst)
382 ~enc:Fun.id
383
384(** {1 Polymorphic Variant Codecs for Union Types} *)
385
386(** Create a try-each decoder for polymorphic variant union types.
387 Attempts each decoder in order until one succeeds. *)
388let poly_union_decoder (decoders : (Jsont.json -> 'a option) list) (json : Jsont.json) : 'a =
389 match List.find_map (fun dec -> dec json) decoders with
390 | Some v -> v
391 | None -> Jsont.Error.msgf Jsont.Meta.none "No variant matched for union type"
392
393(** {1 API Errors} *)
394
395(** Parsed error body, in increasing levels of typed-ness *)
396type error_body =
397 | Raw of string (** Unparsed string *)
398 | Json of Jsont.json (** Parsed but untyped JSON *)
399 | Typed of string * Jsont.json (** schema_name, typed value as JSON *)
400
401(** Error raised when an API call fails with a non-2xx status code *)
402type api_error = {
403 operation : string;
404 method_ : string;
405 url : string;
406 status : int;
407 body : string; (** Always keep raw body for debugging *)
408 parsed_body : error_body option; (** Parsed/typed body if available *)
409}
410
411exception Api_error of api_error
412
413let () =
414 Printexc.register_printer (function
415 | Api_error e ->
416 let parsed_info = match e.parsed_body with
417 | None -> ""
418 | Some (Raw _) -> " (raw)"
419 | Some (Json _) -> " (json)"
420 | Some (Typed (schema, _)) -> Printf.sprintf " (typed: %s)" schema
421 in
422 Some (Printf.sprintf "Api_error: %s %s returned %d%s: %s"
423 e.method_ e.url e.status parsed_info e.body)
424 | _ -> None)
425
426(** Helper to try parsing error body with a list of status-keyed parsers *)
427let try_parse_error_body ~status ~body
428 (parsers : (string * (string -> (Jsont.json, string) result)) list) : error_body option =
429 let status_str = string_of_int status in
430 (* Try exact status match first, then wildcard, then default *)
431 let try_parser key =
432 List.find_map (fun (k, parser) ->
433 if k = key then
434 match parser body with
435 | Ok json -> Some json
436 | Error _ -> None
437 else None
438 ) parsers
439 in
440 match try_parser status_str with
441 | Some json -> Some (Json json)
442 | None ->
443 let wildcard = String.make 1 status_str.[0] ^ "XX" in
444 match try_parser wildcard with
445 | Some json -> Some (Json json)
446 | None ->
447 match try_parser "default" with
448 | Some json -> Some (Json json)
449 | None ->
450 (* Try parsing as generic JSON *)
451 match Jsont_bytesrw.decode_string Jsont.json body with
452 | Ok json -> Some (Json json)
453 | Error _ -> Some (Raw body)