Stripe API client for OCaml
codec: let open Json.Codec in cleanup across hermest + oci + stripe
Extend the encodings-skill cleanup to three more codec-heavy files,
using the accessor-functions idiom for records whose field names
clash with `Json.Codec.mem_map`.
The pattern: when a record has fields like `id` or `name` that also
exist in `mem_map`, OCaml's record disambiguation under
`let open Json.Codec in` would resolve `t.id` to `mem_map.id`. Hoist
the field accessors above the open, annotated only where needed:
let id (t : t) = t.id (* `id` clashes -> annotation needed *)
let name (t : t) = t.name (* `name` clashes -> annotation needed *)
let other t = t.other (* unique field -> no annotation *)
Then the codec body uses `~enc:id` / `~enc:name` / `~enc:other` and
the open is harmless. The `.mli` hides accessors by signature.
Files changed:
- ocaml-atp/hermest/lib/lexicon_types.ml (220 usages, 15 codec defs +
12 mutually-recursive `and X_json_lazy` defs): each body opens
`Json.Codec`. The lazy block building `type_def_json` annotates
`(String s : type_def)` / `(Array s : type_def)` / `(Object s :
type_def)` because `Json.Codec.t`'s GADT carries the same variant
names. The `enc_case` match is rewritten as `let enc_case (td :
type_def) = match td with ...` so subsequent constructor patterns
resolve to `type_def` rather than `Json.Codec.t`. `def_entry_json`
and `lexicon_doc_json` also use `(s : ...)` annotations because
their records carry `name` / `id` fields.
- ocaml-oci/lib/spec/config.ml (102 usages, 8 codec defs): opens
applied to every body. `Docker.t` carries an `id` field; hoisted
17 field accessors so `~enc:id`, `~enc:parent`, etc. read cleanly
and the long `Object.opt_mem` chain shrinks dramatically.
- ocaml-stripe/lib/stripe.ml (64 usages, 8 codec defs): every
Customer/Product/Price/Subscription/Checkout/Portal/Webhook record
has `id` (and most have `name`). Hoisted accessors per module.
The trivial `let metadata_jsont = Json.Codec.Object.as_string_map
Json.Codec.string` stays qualified -- not worth a wrapper for a
single combinator call.
+111
-94
+111
-94
lib/stripe.ml
+111
-94
lib/stripe.ml
···
27
27
exception Stripe_error of error
28
28
29
29
let error_jsont =
30
-
Json.Codec.Object.map (fun error_type message code ->
30
+
let open Json.Codec in
31
+
Object.map (fun error_type message code ->
31
32
{ error_type; message; code; status = 0 })
32
-
|> Json.Codec.Object.mem "type" Json.Codec.string ~dec_absent:""
33
-
~enc:(fun e -> e.error_type)
34
-
|> Json.Codec.Object.mem "message" Json.Codec.string ~dec_absent:""
35
-
~enc:(fun e -> e.message)
36
-
|> Json.Codec.Object.mem "code" Json.Codec.string ~dec_absent:""
37
-
~enc:(fun e -> e.code)
38
-
|> Json.Codec.Object.finish
33
+
|> Object.mem "type" string ~dec_absent:"" ~enc:(fun e -> e.error_type)
34
+
|> Object.mem "message" string ~dec_absent:"" ~enc:(fun e -> e.message)
35
+
|> Object.mem "code" string ~dec_absent:"" ~enc:(fun e -> e.code)
36
+
|> Object.finish
39
37
40
38
let error_wrapper_jsont =
41
-
Json.Codec.Object.map Fun.id
42
-
|> Json.Codec.Object.mem "error" error_jsont ~enc:Fun.id
43
-
|> Json.Codec.Object.finish
39
+
let open Json.Codec in
40
+
Object.map Fun.id
41
+
|> Object.mem "error" error_jsont ~enc:Fun.id
42
+
|> Object.finish
44
43
45
44
(* {1 Common types} *)
46
45
···
83
82
| Error e -> Fmt.failwith "Stripe JSON decode: %s" (Loc.Error.to_string e)
84
83
85
84
let list_jsont item_jsont =
86
-
Json.Codec.Object.map (fun data has_more -> (data, has_more))
87
-
|> Json.Codec.Object.mem "data" (Json.Codec.list item_jsont)
88
-
~enc:(fun (d, _) -> d)
89
-
|> Json.Codec.Object.mem "has_more" Json.Codec.bool ~enc:(fun (_, h) -> h)
90
-
|> Json.Codec.Object.finish
85
+
let open Json.Codec in
86
+
Object.map (fun data has_more -> (data, has_more))
87
+
|> Object.mem "data" (list item_jsont) ~enc:(fun (d, _) -> d)
88
+
|> Object.mem "has_more" bool ~enc:(fun (_, h) -> h)
89
+
|> Object.finish
91
90
92
91
(* {1 Customers} *)
93
92
···
101
100
}
102
101
103
102
let pp ppf c = Fmt.pf ppf "customer(%s, %s, %s)" c.id c.email c.name
103
+
let id (c : t) = c.id
104
+
let email c = c.email
105
+
let name (c : t) = c.name
106
+
let metadata c = c.metadata
107
+
let created c = c.created
104
108
105
109
let jsont =
106
-
Json.Codec.Object.map (fun id email name metadata created ->
110
+
let open Json.Codec in
111
+
Object.map (fun id email name metadata created ->
107
112
{ id; email; name; metadata; created })
108
-
|> Json.Codec.Object.mem "id" Json.Codec.string ~enc:(fun c -> c.id)
109
-
|> Json.Codec.Object.mem "email" Json.Codec.string ~dec_absent:""
110
-
~enc:(fun c -> c.email)
111
-
|> Json.Codec.Object.mem "name" Json.Codec.string ~dec_absent:""
112
-
~enc:(fun c -> c.name)
113
-
|> Json.Codec.Object.mem "metadata" metadata_jsont ~dec_absent:Smap.empty
114
-
~enc:(fun c -> c.metadata)
115
-
|> Json.Codec.Object.mem "created" Json.Codec.int ~dec_absent:0
116
-
~enc:(fun c -> c.created)
117
-
|> Json.Codec.Object.finish
113
+
|> Object.mem "id" string ~enc:id
114
+
|> Object.mem "email" string ~dec_absent:"" ~enc:email
115
+
|> Object.mem "name" string ~dec_absent:"" ~enc:name
116
+
|> Object.mem "metadata" metadata_jsont ~dec_absent:Smap.empty ~enc:metadata
117
+
|> Object.mem "created" int ~dec_absent:0 ~enc:created
118
+
|> Object.finish
118
119
119
120
let create cfg ~email ?name ?metadata () =
120
121
let body =
···
147
148
type t = { id : string; name : string; active : bool; metadata : metadata }
148
149
149
150
let pp ppf p = Fmt.pf ppf "product(%s, %s)" p.id p.name
151
+
let id (p : t) = p.id
152
+
let name (p : t) = p.name
153
+
let active p = p.active
154
+
let metadata p = p.metadata
150
155
151
156
let jsont =
152
-
Json.Codec.Object.map (fun id name active metadata ->
153
-
{ id; name; active; metadata })
154
-
|> Json.Codec.Object.mem "id" Json.Codec.string ~enc:(fun p -> p.id)
155
-
|> Json.Codec.Object.mem "name" Json.Codec.string ~enc:(fun p -> p.name)
156
-
|> Json.Codec.Object.mem "active" Json.Codec.bool ~dec_absent:true
157
-
~enc:(fun p -> p.active)
158
-
|> Json.Codec.Object.mem "metadata" metadata_jsont ~dec_absent:Smap.empty
159
-
~enc:(fun p -> p.metadata)
160
-
|> Json.Codec.Object.finish
157
+
let open Json.Codec in
158
+
Object.map (fun id name active metadata -> { id; name; active; metadata })
159
+
|> Object.mem "id" string ~enc:id
160
+
|> Object.mem "name" string ~enc:name
161
+
|> Object.mem "active" bool ~dec_absent:true ~enc:active
162
+
|> Object.mem "metadata" metadata_jsont ~dec_absent:Smap.empty ~enc:metadata
163
+
|> Object.finish
161
164
162
165
let create cfg ~name ?metadata () =
163
166
let body =
···
179
182
type recurring = { interval : string; interval_count : int }
180
183
181
184
let recurring_jsont =
182
-
Json.Codec.Object.map (fun interval interval_count ->
183
-
{ interval; interval_count })
184
-
|> Json.Codec.Object.mem "interval" Json.Codec.string ~enc:(fun r ->
185
-
r.interval)
186
-
|> Json.Codec.Object.mem "interval_count" Json.Codec.int ~dec_absent:1
187
-
~enc:(fun r -> r.interval_count)
188
-
|> Json.Codec.Object.finish
185
+
let open Json.Codec in
186
+
Object.map (fun interval interval_count -> { interval; interval_count })
187
+
|> Object.mem "interval" string ~enc:(fun r -> r.interval)
188
+
|> Object.mem "interval_count" int ~dec_absent:1 ~enc:(fun r ->
189
+
r.interval_count)
190
+
|> Object.finish
189
191
190
192
type t = {
191
193
id : string;
···
197
199
}
198
200
199
201
let pp ppf p = Fmt.pf ppf "price(%s, %d %s)" p.id p.unit_amount p.currency
202
+
let id (p : t) = p.id
203
+
let product p = p.product
204
+
let unit_amount p = p.unit_amount
205
+
let currency p = p.currency
206
+
let recurring p = p.recurring
207
+
let active p = p.active
200
208
201
209
let jsont =
202
-
Json.Codec.Object.map
203
-
(fun id product unit_amount currency recurring active ->
210
+
let open Json.Codec in
211
+
Object.map (fun id product unit_amount currency recurring active ->
204
212
{ id; product; unit_amount; currency; recurring; active })
205
-
|> Json.Codec.Object.mem "id" Json.Codec.string ~enc:(fun p -> p.id)
206
-
|> Json.Codec.Object.mem "product" Json.Codec.string ~enc:(fun p ->
207
-
p.product)
208
-
|> Json.Codec.Object.mem "unit_amount" Json.Codec.int ~dec_absent:0
209
-
~enc:(fun p -> p.unit_amount)
210
-
|> Json.Codec.Object.mem "currency" Json.Codec.string ~enc:(fun p ->
211
-
p.currency)
212
-
|> Json.Codec.Object.mem "recurring" (Json.Codec.option recurring_jsont)
213
-
~dec_absent:None ~enc:(fun p -> p.recurring)
214
-
|> Json.Codec.Object.mem "active" Json.Codec.bool ~dec_absent:true
215
-
~enc:(fun p -> p.active)
216
-
|> Json.Codec.Object.finish
213
+
|> Object.mem "id" string ~enc:id
214
+
|> Object.mem "product" string ~enc:product
215
+
|> Object.mem "unit_amount" int ~dec_absent:0 ~enc:unit_amount
216
+
|> Object.mem "currency" string ~enc:currency
217
+
|> Object.mem "recurring" (option recurring_jsont) ~dec_absent:None
218
+
~enc:recurring
219
+
|> Object.mem "active" bool ~dec_absent:true ~enc:active
220
+
|> Object.finish
217
221
218
222
let create cfg ~product ~unit_amount ~currency ?interval ?interval_count () =
219
223
let body =
···
249
253
}
250
254
251
255
let pp ppf s = Fmt.pf ppf "subscription(%s, %s, %s)" s.id s.customer s.status
256
+
let id (s : t) = s.id
257
+
let customer s = s.customer
258
+
let status s = s.status
259
+
let current_period_start s = s.current_period_start
260
+
let current_period_end s = s.current_period_end
261
+
let cancel_at_period_end s = s.cancel_at_period_end
262
+
let metadata s = s.metadata
252
263
253
264
let jsont =
254
-
Json.Codec.Object.map
265
+
let open Json.Codec in
266
+
Object.map
255
267
(fun
256
268
id
257
269
customer
···
270
282
cancel_at_period_end;
271
283
metadata;
272
284
})
273
-
|> Json.Codec.Object.mem "id" Json.Codec.string ~enc:(fun s -> s.id)
274
-
|> Json.Codec.Object.mem "customer" Json.Codec.string ~enc:(fun s ->
275
-
s.customer)
276
-
|> Json.Codec.Object.mem "status" Json.Codec.string ~enc:(fun s -> s.status)
277
-
|> Json.Codec.Object.mem "current_period_start" Json.Codec.int ~dec_absent:0
278
-
~enc:(fun s -> s.current_period_start)
279
-
|> Json.Codec.Object.mem "current_period_end" Json.Codec.int ~dec_absent:0
280
-
~enc:(fun s -> s.current_period_end)
281
-
|> Json.Codec.Object.mem "cancel_at_period_end" Json.Codec.bool
282
-
~dec_absent:false ~enc:(fun s -> s.cancel_at_period_end)
283
-
|> Json.Codec.Object.mem "metadata" metadata_jsont ~dec_absent:Smap.empty
284
-
~enc:(fun s -> s.metadata)
285
-
|> Json.Codec.Object.finish
285
+
|> Object.mem "id" string ~enc:id
286
+
|> Object.mem "customer" string ~enc:customer
287
+
|> Object.mem "status" string ~enc:status
288
+
|> Object.mem "current_period_start" int ~dec_absent:0
289
+
~enc:current_period_start
290
+
|> Object.mem "current_period_end" int ~dec_absent:0 ~enc:current_period_end
291
+
|> Object.mem "cancel_at_period_end" bool ~dec_absent:false
292
+
~enc:cancel_at_period_end
293
+
|> Object.mem "metadata" metadata_jsont ~dec_absent:Smap.empty ~enc:metadata
294
+
|> Object.finish
286
295
287
296
let create cfg ~customer ~price ?metadata () =
288
297
let body =
···
314
323
}
315
324
316
325
let pp ppf c = Fmt.pf ppf "checkout(%s, %s)" c.id c.status
326
+
let id (c : t) = c.id
327
+
let url c = c.url
328
+
let customer c = c.customer
329
+
let subscription c = c.subscription
330
+
let status c = c.status
317
331
318
332
let jsont =
319
-
Json.Codec.Object.map (fun id url customer subscription status ->
333
+
let open Json.Codec in
334
+
Object.map (fun id url customer subscription status ->
320
335
{ id; url; customer; subscription; status })
321
-
|> Json.Codec.Object.mem "id" Json.Codec.string ~enc:(fun c -> c.id)
322
-
|> Json.Codec.Object.mem "url" Json.Codec.string ~dec_absent:""
323
-
~enc:(fun c -> c.url)
324
-
|> Json.Codec.Object.mem "customer" Json.Codec.string ~dec_absent:""
325
-
~enc:(fun c -> c.customer)
326
-
|> Json.Codec.Object.mem "subscription" Json.Codec.string ~dec_absent:""
327
-
~enc:(fun c -> c.subscription)
328
-
|> Json.Codec.Object.mem "status" Json.Codec.string ~dec_absent:""
329
-
~enc:(fun c -> c.status)
330
-
|> Json.Codec.Object.finish
336
+
|> Object.mem "id" string ~enc:id
337
+
|> Object.mem "url" string ~dec_absent:"" ~enc:url
338
+
|> Object.mem "customer" string ~dec_absent:"" ~enc:customer
339
+
|> Object.mem "subscription" string ~dec_absent:"" ~enc:subscription
340
+
|> Object.mem "status" string ~dec_absent:"" ~enc:status
341
+
|> Object.finish
331
342
332
343
let create cfg ?customer ?customer_email ~price ~success_url ~cancel_url () =
333
344
let body =
···
355
366
type t = { id : string; url : string }
356
367
357
368
let pp ppf p = Fmt.pf ppf "portal(%s)" p.id
369
+
let id (p : t) = p.id
370
+
let url p = p.url
358
371
359
372
let jsont =
360
-
Json.Codec.Object.map (fun id url -> { id; url })
361
-
|> Json.Codec.Object.mem "id" Json.Codec.string ~enc:(fun p -> p.id)
362
-
|> Json.Codec.Object.mem "url" Json.Codec.string ~enc:(fun p -> p.url)
363
-
|> Json.Codec.Object.finish
373
+
let open Json.Codec in
374
+
Object.map (fun id url -> { id; url })
375
+
|> Object.mem "id" string ~enc:id
376
+
|> Object.mem "url" string ~enc:url
377
+
|> Object.finish
364
378
365
379
let create cfg ~customer ~return_url =
366
380
let body = [ ("customer", customer); ("return_url", return_url) ] in
···
378
392
}
379
393
380
394
let pp_event ppf e = Fmt.pf ppf "event(%s, %s)" e.id e.event_type
395
+
let event_id (e : event) = e.id
396
+
let event_type e = e.event_type
397
+
let event_created e = e.created
398
+
let event_data e = e.data
381
399
382
400
let event_jsont =
383
-
Json.Codec.Object.map (fun id event_type created data ->
401
+
let open Json.Codec in
402
+
Object.map (fun id event_type created data ->
384
403
{ id; event_type; created; data })
385
-
|> Json.Codec.Object.mem "id" Json.Codec.string ~enc:(fun e -> e.id)
386
-
|> Json.Codec.Object.mem "type" Json.Codec.string ~enc:(fun e ->
387
-
e.event_type)
388
-
|> Json.Codec.Object.mem "created" Json.Codec.int ~dec_absent:0
389
-
~enc:(fun e -> e.created)
390
-
|> Json.Codec.Object.mem "data" Json.Codec.Value.t ~enc:(fun e -> e.data)
391
-
|> Json.Codec.Object.finish
404
+
|> Object.mem "id" string ~enc:event_id
405
+
|> Object.mem "type" string ~enc:event_type
406
+
|> Object.mem "created" int ~dec_absent:0 ~enc:event_created
407
+
|> Object.mem "data" Value.t ~enc:event_data
408
+
|> Object.finish
392
409
393
410
(* Stripe webhook signature verification.
394
411
Header format: t=<timestamp>,v1=<sig1>,v1=<sig2>,...