Stripe API client for OCaml
wal, block, sse, zephyr: remove [mutable] from never-reassigned fields
Warning 69 (unused-field, mutable-never-assigned). Four independent
record fields were flagged as mutable but the code only mutates their
referents in place, never rebinds the record slot itself:
- ocaml-wal/lib/wal.ml: [t.file] (the Eio file resource; methods call
Eio.File.pwrite_all etc., the slot is set once at open time).
- ocaml-block/lib/block.ml: [Memory.state.data] (the backing bytes,
written via Bytes.blit_string; [Bytes.t] is already mutable).
- ocaml-sse/lib/sse.ml: [Parser.t.data_buf] (a Buffer.t, written via
Buffer.add_*; the slot never changes).
- ocaml-zephyr/lib/zephyr.ml: drop [mode : Read | Write] entirely —
set at open-time, read nowhere. The open_read / open_write
constructors already distinguish the two call shapes, so mode
tracking was redundant.
+86
-83
+1
-1
dune-project
+1
-1
dune-project
+1
-1
lib/dune
+1
-1
lib/dune
+67
-67
lib/stripe.ml
+67
-67
lib/stripe.ml
···
27
27
exception Stripe_error of error
28
28
29
29
let error_jsont =
30
-
Jsont.Object.map (fun error_type message code ->
30
+
Json.Object.map (fun error_type message code ->
31
31
{ error_type; message; code; status = 0 })
32
-
|> Jsont.Object.mem "type" Jsont.string ~dec_absent:"" ~enc:(fun e ->
32
+
|> Json.Object.mem "type" Json.string ~dec_absent:"" ~enc:(fun e ->
33
33
e.error_type)
34
-
|> Jsont.Object.mem "message" Jsont.string ~dec_absent:"" ~enc:(fun e ->
34
+
|> Json.Object.mem "message" Json.string ~dec_absent:"" ~enc:(fun e ->
35
35
e.message)
36
-
|> Jsont.Object.mem "code" Jsont.string ~dec_absent:"" ~enc:(fun e -> e.code)
37
-
|> Jsont.Object.finish
36
+
|> Json.Object.mem "code" Json.string ~dec_absent:"" ~enc:(fun e -> e.code)
37
+
|> Json.Object.finish
38
38
39
39
let error_wrapper_jsont =
40
-
Jsont.Object.map Fun.id
41
-
|> Jsont.Object.mem "error" error_jsont ~enc:Fun.id
42
-
|> Jsont.Object.finish
40
+
Json.Object.map Fun.id
41
+
|> Json.Object.mem "error" error_jsont ~enc:Fun.id
42
+
|> Json.Object.finish
43
43
44
44
(* {1 Common types} *)
45
45
···
47
47
48
48
type metadata = string Smap.t
49
49
50
-
let metadata_jsont = Jsont.Object.as_string_map Jsont.string
50
+
let metadata_jsont = Json.Object.as_string_map Json.string
51
51
52
52
(* {1 HTTP helpers} *)
53
53
···
58
58
let text = Requests.Response.text resp in
59
59
if status >= 400 then begin
60
60
let err =
61
-
match Jsont_bytesrw.decode_string error_wrapper_jsont text with
61
+
match Json_bytesrw.decode_string error_wrapper_jsont text with
62
62
| Ok e -> { e with status }
63
63
| Error _ ->
64
64
{ error_type = "api_error"; message = text; code = ""; status }
···
81
81
Requests.delete cfg.session url ~auth:(auth cfg) |> check_response
82
82
83
83
let decode jsont text =
84
-
match Jsont_bytesrw.decode_string jsont text with
84
+
match Json_bytesrw.decode_string jsont text with
85
85
| Ok v -> v
86
86
| Error e -> Fmt.failwith "Stripe JSON decode: %s" e
87
87
88
88
let list_jsont item_jsont =
89
-
Jsont.Object.map (fun data has_more -> (data, has_more))
90
-
|> Jsont.Object.mem "data" (Jsont.list item_jsont) ~enc:(fun (d, _) -> d)
91
-
|> Jsont.Object.mem "has_more" Jsont.bool ~enc:(fun (_, h) -> h)
92
-
|> Jsont.Object.finish
89
+
Json.Object.map (fun data has_more -> (data, has_more))
90
+
|> Json.Object.mem "data" (Json.list item_jsont) ~enc:(fun (d, _) -> d)
91
+
|> Json.Object.mem "has_more" Json.bool ~enc:(fun (_, h) -> h)
92
+
|> Json.Object.finish
93
93
94
94
(* {1 Customers} *)
95
95
···
105
105
let pp ppf c = Fmt.pf ppf "customer(%s, %s, %s)" c.id c.email c.name
106
106
107
107
let jsont =
108
-
Jsont.Object.map (fun id email name metadata created ->
108
+
Json.Object.map (fun id email name metadata created ->
109
109
{ id; email; name; metadata; created })
110
-
|> Jsont.Object.mem "id" Jsont.string ~enc:(fun c -> c.id)
111
-
|> Jsont.Object.mem "email" Jsont.string ~dec_absent:"" ~enc:(fun c ->
110
+
|> Json.Object.mem "id" Json.string ~enc:(fun c -> c.id)
111
+
|> Json.Object.mem "email" Json.string ~dec_absent:"" ~enc:(fun c ->
112
112
c.email)
113
-
|> Jsont.Object.mem "name" Jsont.string ~dec_absent:"" ~enc:(fun c ->
113
+
|> Json.Object.mem "name" Json.string ~dec_absent:"" ~enc:(fun c ->
114
114
c.name)
115
-
|> Jsont.Object.mem "metadata" metadata_jsont ~dec_absent:Smap.empty
115
+
|> Json.Object.mem "metadata" metadata_jsont ~dec_absent:Smap.empty
116
116
~enc:(fun c -> c.metadata)
117
-
|> Jsont.Object.mem "created" Jsont.int ~dec_absent:0 ~enc:(fun c ->
117
+
|> Json.Object.mem "created" Json.int ~dec_absent:0 ~enc:(fun c ->
118
118
c.created)
119
-
|> Jsont.Object.finish
119
+
|> Json.Object.finish
120
120
121
121
let create cfg ~email ?name ?metadata () =
122
122
let body =
···
151
151
let pp ppf p = Fmt.pf ppf "product(%s, %s)" p.id p.name
152
152
153
153
let jsont =
154
-
Jsont.Object.map (fun id name active metadata ->
154
+
Json.Object.map (fun id name active metadata ->
155
155
{ id; name; active; metadata })
156
-
|> Jsont.Object.mem "id" Jsont.string ~enc:(fun p -> p.id)
157
-
|> Jsont.Object.mem "name" Jsont.string ~enc:(fun p -> p.name)
158
-
|> Jsont.Object.mem "active" Jsont.bool ~dec_absent:true ~enc:(fun p ->
156
+
|> Json.Object.mem "id" Json.string ~enc:(fun p -> p.id)
157
+
|> Json.Object.mem "name" Json.string ~enc:(fun p -> p.name)
158
+
|> Json.Object.mem "active" Json.bool ~dec_absent:true ~enc:(fun p ->
159
159
p.active)
160
-
|> Jsont.Object.mem "metadata" metadata_jsont ~dec_absent:Smap.empty
160
+
|> Json.Object.mem "metadata" metadata_jsont ~dec_absent:Smap.empty
161
161
~enc:(fun p -> p.metadata)
162
-
|> Jsont.Object.finish
162
+
|> Json.Object.finish
163
163
164
164
let create cfg ~name ?metadata () =
165
165
let body =
···
181
181
type recurring = { interval : string; interval_count : int }
182
182
183
183
let recurring_jsont =
184
-
Jsont.Object.map (fun interval interval_count ->
184
+
Json.Object.map (fun interval interval_count ->
185
185
{ interval; interval_count })
186
-
|> Jsont.Object.mem "interval" Jsont.string ~enc:(fun r -> r.interval)
187
-
|> Jsont.Object.mem "interval_count" Jsont.int ~dec_absent:1 ~enc:(fun r ->
186
+
|> Json.Object.mem "interval" Json.string ~enc:(fun r -> r.interval)
187
+
|> Json.Object.mem "interval_count" Json.int ~dec_absent:1 ~enc:(fun r ->
188
188
r.interval_count)
189
-
|> Jsont.Object.finish
189
+
|> Json.Object.finish
190
190
191
191
type t = {
192
192
id : string;
···
200
200
let pp ppf p = Fmt.pf ppf "price(%s, %d %s)" p.id p.unit_amount p.currency
201
201
202
202
let jsont =
203
-
Jsont.Object.map (fun id product unit_amount currency recurring active ->
203
+
Json.Object.map (fun id product unit_amount currency recurring active ->
204
204
{ id; product; unit_amount; currency; recurring; active })
205
-
|> Jsont.Object.mem "id" Jsont.string ~enc:(fun p -> p.id)
206
-
|> Jsont.Object.mem "product" Jsont.string ~enc:(fun p -> p.product)
207
-
|> Jsont.Object.mem "unit_amount" Jsont.int ~dec_absent:0 ~enc:(fun p ->
205
+
|> Json.Object.mem "id" Json.string ~enc:(fun p -> p.id)
206
+
|> Json.Object.mem "product" Json.string ~enc:(fun p -> p.product)
207
+
|> Json.Object.mem "unit_amount" Json.int ~dec_absent:0 ~enc:(fun p ->
208
208
p.unit_amount)
209
-
|> Jsont.Object.mem "currency" Jsont.string ~enc:(fun p -> p.currency)
210
-
|> Jsont.Object.mem "recurring" (Jsont.option recurring_jsont)
209
+
|> Json.Object.mem "currency" Json.string ~enc:(fun p -> p.currency)
210
+
|> Json.Object.mem "recurring" (Json.option recurring_jsont)
211
211
~dec_absent:None ~enc:(fun p -> p.recurring)
212
-
|> Jsont.Object.mem "active" Jsont.bool ~dec_absent:true ~enc:(fun p ->
212
+
|> Json.Object.mem "active" Json.bool ~dec_absent:true ~enc:(fun p ->
213
213
p.active)
214
-
|> Jsont.Object.finish
214
+
|> Json.Object.finish
215
215
216
216
let create cfg ~product ~unit_amount ~currency ?interval ?interval_count () =
217
217
let body =
···
249
249
let pp ppf s = Fmt.pf ppf "subscription(%s, %s, %s)" s.id s.customer s.status
250
250
251
251
let jsont =
252
-
Jsont.Object.map
252
+
Json.Object.map
253
253
(fun
254
254
id
255
255
customer
···
268
268
cancel_at_period_end;
269
269
metadata;
270
270
})
271
-
|> Jsont.Object.mem "id" Jsont.string ~enc:(fun s -> s.id)
272
-
|> Jsont.Object.mem "customer" Jsont.string ~enc:(fun s -> s.customer)
273
-
|> Jsont.Object.mem "status" Jsont.string ~enc:(fun s -> s.status)
274
-
|> Jsont.Object.mem "current_period_start" Jsont.int ~dec_absent:0
271
+
|> Json.Object.mem "id" Json.string ~enc:(fun s -> s.id)
272
+
|> Json.Object.mem "customer" Json.string ~enc:(fun s -> s.customer)
273
+
|> Json.Object.mem "status" Json.string ~enc:(fun s -> s.status)
274
+
|> Json.Object.mem "current_period_start" Json.int ~dec_absent:0
275
275
~enc:(fun s -> s.current_period_start)
276
-
|> Jsont.Object.mem "current_period_end" Jsont.int ~dec_absent:0
276
+
|> Json.Object.mem "current_period_end" Json.int ~dec_absent:0
277
277
~enc:(fun s -> s.current_period_end)
278
-
|> Jsont.Object.mem "cancel_at_period_end" Jsont.bool ~dec_absent:false
278
+
|> Json.Object.mem "cancel_at_period_end" Json.bool ~dec_absent:false
279
279
~enc:(fun s -> s.cancel_at_period_end)
280
-
|> Jsont.Object.mem "metadata" metadata_jsont ~dec_absent:Smap.empty
280
+
|> Json.Object.mem "metadata" metadata_jsont ~dec_absent:Smap.empty
281
281
~enc:(fun s -> s.metadata)
282
-
|> Jsont.Object.finish
282
+
|> Json.Object.finish
283
283
284
284
let create cfg ~customer ~price ?metadata () =
285
285
let body =
···
313
313
let pp ppf c = Fmt.pf ppf "checkout(%s, %s)" c.id c.status
314
314
315
315
let jsont =
316
-
Jsont.Object.map (fun id url customer subscription status ->
316
+
Json.Object.map (fun id url customer subscription status ->
317
317
{ id; url; customer; subscription; status })
318
-
|> Jsont.Object.mem "id" Jsont.string ~enc:(fun c -> c.id)
319
-
|> Jsont.Object.mem "url" Jsont.string ~dec_absent:"" ~enc:(fun c -> c.url)
320
-
|> Jsont.Object.mem "customer" Jsont.string ~dec_absent:"" ~enc:(fun c ->
318
+
|> Json.Object.mem "id" Json.string ~enc:(fun c -> c.id)
319
+
|> Json.Object.mem "url" Json.string ~dec_absent:"" ~enc:(fun c -> c.url)
320
+
|> Json.Object.mem "customer" Json.string ~dec_absent:"" ~enc:(fun c ->
321
321
c.customer)
322
-
|> Jsont.Object.mem "subscription" Jsont.string ~dec_absent:""
322
+
|> Json.Object.mem "subscription" Json.string ~dec_absent:""
323
323
~enc:(fun c -> c.subscription)
324
-
|> Jsont.Object.mem "status" Jsont.string ~dec_absent:"" ~enc:(fun c ->
324
+
|> Json.Object.mem "status" Json.string ~dec_absent:"" ~enc:(fun c ->
325
325
c.status)
326
-
|> Jsont.Object.finish
326
+
|> Json.Object.finish
327
327
328
328
let create cfg ?customer ?customer_email ~price ~success_url ~cancel_url () =
329
329
let body =
···
353
353
let pp ppf p = Fmt.pf ppf "portal(%s)" p.id
354
354
355
355
let jsont =
356
-
Jsont.Object.map (fun id url -> { id; url })
357
-
|> Jsont.Object.mem "id" Jsont.string ~enc:(fun p -> p.id)
358
-
|> Jsont.Object.mem "url" Jsont.string ~enc:(fun p -> p.url)
359
-
|> Jsont.Object.finish
356
+
Json.Object.map (fun id url -> { id; url })
357
+
|> Json.Object.mem "id" Json.string ~enc:(fun p -> p.id)
358
+
|> Json.Object.mem "url" Json.string ~enc:(fun p -> p.url)
359
+
|> Json.Object.finish
360
360
361
361
let create cfg ~customer ~return_url =
362
362
let body = [ ("customer", customer); ("return_url", return_url) ] in
···
370
370
id : string;
371
371
event_type : string;
372
372
created : int;
373
-
data : Jsont.json;
373
+
data : Json.t;
374
374
}
375
375
376
376
let pp_event ppf e = Fmt.pf ppf "event(%s, %s)" e.id e.event_type
377
377
378
378
let event_jsont =
379
-
Jsont.Object.map (fun id event_type created data ->
379
+
Json.Object.map (fun id event_type created data ->
380
380
{ id; event_type; created; data })
381
-
|> Jsont.Object.mem "id" Jsont.string ~enc:(fun e -> e.id)
382
-
|> Jsont.Object.mem "type" Jsont.string ~enc:(fun e -> e.event_type)
383
-
|> Jsont.Object.mem "created" Jsont.int ~dec_absent:0 ~enc:(fun e ->
381
+
|> Json.Object.mem "id" Json.string ~enc:(fun e -> e.id)
382
+
|> Json.Object.mem "type" Json.string ~enc:(fun e -> e.event_type)
383
+
|> Json.Object.mem "created" Json.int ~dec_absent:0 ~enc:(fun e ->
384
384
e.created)
385
-
|> Jsont.Object.mem "data" Jsont.json ~enc:(fun e -> e.data)
386
-
|> Jsont.Object.finish
385
+
|> Json.Object.mem "data" Json.json ~enc:(fun e -> e.data)
386
+
|> Json.Object.finish
387
387
388
388
(* Stripe webhook signature verification.
389
389
Header format: t=<timestamp>,v1=<sig1>,v1=<sig2>,...
+8
-8
lib/stripe.mli
+8
-8
lib/stripe.mli
···
45
45
val pp : t Fmt.t
46
46
(** Pretty-print a customer. *)
47
47
48
-
val jsont : t Jsont.t
48
+
val jsont : t Json.codec
49
49
(** JSON codec for customers. *)
50
50
51
51
val create :
···
68
68
val pp : t Fmt.t
69
69
(** Pretty-print a product. *)
70
70
71
-
val jsont : t Jsont.t
71
+
val jsont : t Json.codec
72
72
(** JSON codec for products. *)
73
73
74
74
val create : config -> name:string -> ?metadata:metadata -> unit -> t
···
98
98
val pp : t Fmt.t
99
99
(** Pretty-print a price. *)
100
100
101
-
val jsont : t Jsont.t
101
+
val jsont : t Json.codec
102
102
(** JSON codec for prices. *)
103
103
104
104
val create :
···
129
129
val pp : t Fmt.t
130
130
(** Pretty-print a subscription. *)
131
131
132
-
val jsont : t Jsont.t
132
+
val jsont : t Json.codec
133
133
(** JSON codec for subscriptions. *)
134
134
135
135
val create :
···
157
157
val pp : t Fmt.t
158
158
(** Pretty-print a checkout session. *)
159
159
160
-
val jsont : t Jsont.t
160
+
val jsont : t Json.codec
161
161
(** JSON codec for checkout sessions. *)
162
162
163
163
val create :
···
191
191
val pp : t Fmt.t
192
192
(** Pretty-print a portal session. *)
193
193
194
-
val jsont : t Jsont.t
194
+
val jsont : t Json.codec
195
195
(** JSON codec for portal sessions. *)
196
196
197
197
val create : config -> customer:string -> return_url:string -> t
···
205
205
id : string;
206
206
event_type : string; (** e.g. "customer.subscription.updated" *)
207
207
created : int;
208
-
data : Jsont.json; (** Raw JSON of the event data object. *)
208
+
data : Json.t; (** Raw JSON of the event data object. *)
209
209
}
210
210
211
211
val pp_event : event Fmt.t
212
212
(** Pretty-print a webhook event. *)
213
213
214
-
val event_jsont : event Jsont.t
214
+
val event_jsont : event Json.codec
215
215
(** JSON codec for webhook events. *)
216
216
217
217
val verify_signature :
+1
-1
stripe.opam
+1
-1
stripe.opam
+5
-5
test/test_stripe.ml
+5
-5
test/test_stripe.ml
···
122
122
{|{"id":"cus_test_123","email":"test@example.com","name":"Test User","metadata":{"plan":"pro"},"created":1735732800,"object":"customer"}|}
123
123
124
124
let customer_roundtrip () =
125
-
match Jsont_bytesrw.decode_string Stripe.Customer.jsont customer_json with
125
+
match Json_bytesrw.decode_string Stripe.Customer.jsont customer_json with
126
126
| Error e -> Alcotest.failf "decode: %s" e
127
127
| Ok c ->
128
128
Alcotest.(check string) "id" "cus_test_123" c.id;
···
138
138
139
139
let subscription_roundtrip () =
140
140
match
141
-
Jsont_bytesrw.decode_string Stripe.Subscription.jsont subscription_json
141
+
Json_bytesrw.decode_string Stripe.Subscription.jsont subscription_json
142
142
with
143
143
| Error e -> Alcotest.failf "decode: %s" e
144
144
| Ok s ->
···
151
151
{|{"id":"price_test_789","product":"prod_test_abc","unit_amount":500000,"currency":"usd","recurring":{"interval":"year","interval_count":1},"active":true,"object":"price"}|}
152
152
153
153
let price_roundtrip () =
154
-
match Jsont_bytesrw.decode_string Stripe.Price.jsont price_json with
154
+
match Json_bytesrw.decode_string Stripe.Price.jsont price_json with
155
155
| Error e -> Alcotest.failf "decode: %s" e
156
156
| Ok p -> (
157
157
Alcotest.(check string) "id" "price_test_789" p.id;
···
168
168
{|{"id":"prod_test_abc","name":"SSA Pro","active":true,"metadata":{"tier":"pro"},"object":"product"}|}
169
169
170
170
let product_roundtrip () =
171
-
match Jsont_bytesrw.decode_string Stripe.Product.jsont product_json with
171
+
match Json_bytesrw.decode_string Stripe.Product.jsont product_json with
172
172
| Error e -> Alcotest.failf "decode: %s" e
173
173
| Ok p ->
174
174
Alcotest.(check string) "id" "prod_test_abc" p.id;
···
179
179
{|{"id":"cs_test_xyz","url":"https://checkout.stripe.com/pay/cs_test_xyz","customer":"cus_test_123","subscription":"sub_test_456","status":"open","object":"checkout.session"}|}
180
180
181
181
let checkout_roundtrip () =
182
-
match Jsont_bytesrw.decode_string Stripe.Checkout.jsont checkout_json with
182
+
match Json_bytesrw.decode_string Stripe.Checkout.jsont checkout_json with
183
183
| Error e -> Alcotest.failf "decode: %s" e
184
184
| Ok c ->
185
185
Alcotest.(check string) "id" "cs_test_xyz" c.id;