Stripe API client for OCaml
claude: complete Err -> Error module rename across call sites
Follow up to the module rename: update the remaining callers that
still referenced [Err] (library [claude.ml{,i}], [client.ml], the test
driver [test.ml]), and fix one stray [^ e] string concatenation in
hermest's CLI that needed [Json.Error.to_string e] now that
[Json.of_string] yields a structured error.
+104
-100
+1
-1
lib/dune
+1
-1
lib/dune
+89
-84
lib/stripe.ml
+89
-84
lib/stripe.ml
···
27
27
exception Stripe_error of error
28
28
29
29
let error_jsont =
30
-
Json.Object.map (fun error_type message code ->
30
+
Json.Codec.Object.map (fun error_type message code ->
31
31
{ error_type; message; code; status = 0 })
32
-
|> Json.Object.mem "type" Json.string ~dec_absent:"" ~enc:(fun e ->
33
-
e.error_type)
34
-
|> Json.Object.mem "message" Json.string ~dec_absent:"" ~enc:(fun e ->
35
-
e.message)
36
-
|> Json.Object.mem "code" Json.string ~dec_absent:"" ~enc:(fun e -> e.code)
37
-
|> Json.Object.finish
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
38
39
39
40
let error_wrapper_jsont =
40
-
Json.Object.map Fun.id
41
-
|> Json.Object.mem "error" error_jsont ~enc:Fun.id
42
-
|> Json.Object.finish
41
+
Json.Codec.Object.map Fun.id
42
+
|> Json.Codec.Object.mem "error" error_jsont ~enc:Fun.id
43
+
|> Json.Codec.Object.finish
43
44
44
45
(* {1 Common types} *)
45
46
···
47
48
48
49
type metadata = string Smap.t
49
50
50
-
let metadata_jsont = Json.Object.as_string_map Json.string
51
+
let metadata_jsont = Json.Codec.Object.as_string_map Json.Codec.string
51
52
52
53
(* {1 HTTP helpers} *)
53
54
···
58
59
let text = Requests.Response.text resp in
59
60
if status >= 400 then begin
60
61
let err =
61
-
match Json_bytesrw.decode_string error_wrapper_jsont text with
62
+
match Json.of_string error_wrapper_jsont text with
62
63
| Ok e -> { e with status }
63
64
| Error _ ->
64
65
{ error_type = "api_error"; message = text; code = ""; status }
···
76
77
let url = base_url ^ path in
77
78
Requests.get cfg.session url ~auth:(auth cfg) ~params |> check_response
78
79
79
-
let delete cfg path =
80
-
let url = base_url ^ path in
81
-
Requests.delete cfg.session url ~auth:(auth cfg) |> check_response
82
-
83
80
let decode jsont text =
84
-
match Json_bytesrw.decode_string jsont text with
81
+
match Json.of_string jsont text with
85
82
| Ok v -> v
86
-
| Error e -> Fmt.failwith "Stripe JSON decode: %s" e
83
+
| Error e -> Fmt.failwith "Stripe JSON decode: %s" (Loc.Error.to_string e)
87
84
88
85
let list_jsont item_jsont =
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
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
93
91
94
92
(* {1 Customers} *)
95
93
···
105
103
let pp ppf c = Fmt.pf ppf "customer(%s, %s, %s)" c.id c.email c.name
106
104
107
105
let jsont =
108
-
Json.Object.map (fun id email name metadata created ->
106
+
Json.Codec.Object.map (fun id email name metadata created ->
109
107
{ id; email; name; metadata; created })
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
-
c.email)
113
-
|> Json.Object.mem "name" Json.string ~dec_absent:"" ~enc:(fun c ->
114
-
c.name)
115
-
|> Json.Object.mem "metadata" metadata_jsont ~dec_absent:Smap.empty
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
116
114
~enc:(fun c -> c.metadata)
117
-
|> Json.Object.mem "created" Json.int ~dec_absent:0 ~enc:(fun c ->
118
-
c.created)
119
-
|> Json.Object.finish
115
+
|> Json.Codec.Object.mem "created" Json.Codec.int ~dec_absent:0
116
+
~enc:(fun c -> c.created)
117
+
|> Json.Codec.Object.finish
120
118
121
119
let create cfg ~email ?name ?metadata () =
122
120
let body =
···
151
149
let pp ppf p = Fmt.pf ppf "product(%s, %s)" p.id p.name
152
150
153
151
let jsont =
154
-
Json.Object.map (fun id name active metadata ->
152
+
Json.Codec.Object.map (fun id name active metadata ->
155
153
{ id; name; active; metadata })
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
-
p.active)
160
-
|> Json.Object.mem "metadata" metadata_jsont ~dec_absent:Smap.empty
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
161
159
~enc:(fun p -> p.metadata)
162
-
|> Json.Object.finish
160
+
|> Json.Codec.Object.finish
163
161
164
162
let create cfg ~name ?metadata () =
165
163
let body =
···
181
179
type recurring = { interval : string; interval_count : int }
182
180
183
181
let recurring_jsont =
184
-
Json.Object.map (fun interval interval_count ->
182
+
Json.Codec.Object.map (fun interval interval_count ->
185
183
{ interval; interval_count })
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
-
r.interval_count)
189
-
|> Json.Object.finish
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
190
189
191
190
type t = {
192
191
id : string;
···
200
199
let pp ppf p = Fmt.pf ppf "price(%s, %d %s)" p.id p.unit_amount p.currency
201
200
202
201
let jsont =
203
-
Json.Object.map (fun id product unit_amount currency recurring active ->
202
+
Json.Codec.Object.map
203
+
(fun id product unit_amount currency recurring active ->
204
204
{ id; product; unit_amount; currency; recurring; active })
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
-
p.unit_amount)
209
-
|> Json.Object.mem "currency" Json.string ~enc:(fun p -> p.currency)
210
-
|> Json.Object.mem "recurring" (Json.option recurring_jsont)
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)
211
213
~dec_absent:None ~enc:(fun p -> p.recurring)
212
-
|> Json.Object.mem "active" Json.bool ~dec_absent:true ~enc:(fun p ->
213
-
p.active)
214
-
|> Json.Object.finish
214
+
|> Json.Codec.Object.mem "active" Json.Codec.bool ~dec_absent:true
215
+
~enc:(fun p -> p.active)
216
+
|> Json.Codec.Object.finish
215
217
216
218
let create cfg ~product ~unit_amount ~currency ?interval ?interval_count () =
217
219
let body =
···
249
251
let pp ppf s = Fmt.pf ppf "subscription(%s, %s, %s)" s.id s.customer s.status
250
252
251
253
let jsont =
252
-
Json.Object.map
254
+
Json.Codec.Object.map
253
255
(fun
254
256
id
255
257
customer
···
268
270
cancel_at_period_end;
269
271
metadata;
270
272
})
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
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
275
278
~enc:(fun s -> s.current_period_start)
276
-
|> Json.Object.mem "current_period_end" Json.int ~dec_absent:0
279
+
|> Json.Codec.Object.mem "current_period_end" Json.Codec.int ~dec_absent:0
277
280
~enc:(fun s -> s.current_period_end)
278
-
|> Json.Object.mem "cancel_at_period_end" Json.bool ~dec_absent:false
279
-
~enc:(fun s -> s.cancel_at_period_end)
280
-
|> Json.Object.mem "metadata" metadata_jsont ~dec_absent:Smap.empty
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
281
284
~enc:(fun s -> s.metadata)
282
-
|> Json.Object.finish
285
+
|> Json.Codec.Object.finish
283
286
284
287
let create cfg ~customer ~price ?metadata () =
285
288
let body =
···
313
316
let pp ppf c = Fmt.pf ppf "checkout(%s, %s)" c.id c.status
314
317
315
318
let jsont =
316
-
Json.Object.map (fun id url customer subscription status ->
319
+
Json.Codec.Object.map (fun id url customer subscription status ->
317
320
{ id; url; customer; subscription; status })
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
-
c.customer)
322
-
|> Json.Object.mem "subscription" Json.string ~dec_absent:""
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:""
323
327
~enc:(fun c -> c.subscription)
324
-
|> Json.Object.mem "status" Json.string ~dec_absent:"" ~enc:(fun c ->
325
-
c.status)
326
-
|> Json.Object.finish
328
+
|> Json.Codec.Object.mem "status" Json.Codec.string ~dec_absent:""
329
+
~enc:(fun c -> c.status)
330
+
|> Json.Codec.Object.finish
327
331
328
332
let create cfg ?customer ?customer_email ~price ~success_url ~cancel_url () =
329
333
let body =
···
353
357
let pp ppf p = Fmt.pf ppf "portal(%s)" p.id
354
358
355
359
let jsont =
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
+
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
360
364
361
365
let create cfg ~customer ~return_url =
362
366
let body = [ ("customer", customer); ("return_url", return_url) ] in
···
376
380
let pp_event ppf e = Fmt.pf ppf "event(%s, %s)" e.id e.event_type
377
381
378
382
let event_jsont =
379
-
Json.Object.map (fun id event_type created data ->
383
+
Json.Codec.Object.map (fun id event_type created data ->
380
384
{ id; event_type; created; data })
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
-
e.created)
385
-
|> Json.Object.mem "data" Json.json ~enc:(fun e -> e.data)
386
-
|> Json.Object.finish
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
387
392
388
393
(* Stripe webhook signature verification.
389
394
Header format: t=<timestamp>,v1=<sig1>,v1=<sig2>,...
+1
-1
test/dune
+1
-1
test/dune
+13
-14
test/test_stripe.ml
+13
-14
test/test_stripe.ml
···
39
39
Alcotest.(check string)
40
40
"event type" "customer.subscription.updated" event.event_type;
41
41
Alcotest.(check int) "created" 1735732800 event.created
42
-
| Error e -> Alcotest.failf "verification failed: %s" e
42
+
| Error e -> Alcotest.failf "verification failed: %s" (Loc.Error.to_string e)
43
43
44
44
(* Wrong secret should fail *)
45
45
let wrong_secret () =
···
114
114
~payload:sample_event_json ~signature:sig_header
115
115
with
116
116
| Ok event -> Alcotest.(check string) "event id" "evt_test_123" event.id
117
-
| Error e -> Alcotest.failf "should accept any valid v1: %s" e
117
+
| Error e ->
118
+
Alcotest.failf "should accept any valid v1: %s" (Loc.Error.to_string e)
118
119
119
120
(* {1 JSON codec tests} *)
120
121
···
122
123
{|{"id":"cus_test_123","email":"test@example.com","name":"Test User","metadata":{"plan":"pro"},"created":1735732800,"object":"customer"}|}
123
124
124
125
let customer_roundtrip () =
125
-
match Json_bytesrw.decode_string Stripe.Customer.jsont customer_json with
126
-
| Error e -> Alcotest.failf "decode: %s" e
126
+
match Json.of_string Stripe.Customer.jsont customer_json with
127
+
| Error e -> Alcotest.failf "decode: %s" (Loc.Error.to_string e)
127
128
| Ok c ->
128
129
Alcotest.(check string) "id" "cus_test_123" c.id;
129
130
Alcotest.(check string) "email" "test@example.com" c.email;
···
137
138
{|{"id":"sub_test_456","customer":"cus_test_123","status":"active","current_period_start":1735732800,"current_period_end":1738411200,"cancel_at_period_end":false,"metadata":{},"object":"subscription"}|}
138
139
139
140
let subscription_roundtrip () =
140
-
match
141
-
Json_bytesrw.decode_string Stripe.Subscription.jsont subscription_json
142
-
with
143
-
| Error e -> Alcotest.failf "decode: %s" e
141
+
match Json.of_string Stripe.Subscription.jsont subscription_json with
142
+
| Error e -> Alcotest.failf "decode: %s" (Loc.Error.to_string e)
144
143
| Ok s ->
145
144
Alcotest.(check string) "id" "sub_test_456" s.id;
146
145
Alcotest.(check string) "customer" "cus_test_123" s.customer;
···
151
150
{|{"id":"price_test_789","product":"prod_test_abc","unit_amount":500000,"currency":"usd","recurring":{"interval":"year","interval_count":1},"active":true,"object":"price"}|}
152
151
153
152
let price_roundtrip () =
154
-
match Json_bytesrw.decode_string Stripe.Price.jsont price_json with
155
-
| Error e -> Alcotest.failf "decode: %s" e
153
+
match Json.of_string Stripe.Price.jsont price_json with
154
+
| Error e -> Alcotest.failf "decode: %s" (Loc.Error.to_string e)
156
155
| Ok p -> (
157
156
Alcotest.(check string) "id" "price_test_789" p.id;
158
157
Alcotest.(check string) "product" "prod_test_abc" p.product;
···
168
167
{|{"id":"prod_test_abc","name":"SSA Pro","active":true,"metadata":{"tier":"pro"},"object":"product"}|}
169
168
170
169
let product_roundtrip () =
171
-
match Json_bytesrw.decode_string Stripe.Product.jsont product_json with
172
-
| Error e -> Alcotest.failf "decode: %s" e
170
+
match Json.of_string Stripe.Product.jsont product_json with
171
+
| Error e -> Alcotest.failf "decode: %s" (Loc.Error.to_string e)
173
172
| Ok p ->
174
173
Alcotest.(check string) "id" "prod_test_abc" p.id;
175
174
Alcotest.(check string) "name" "SSA Pro" p.name;
···
179
178
{|{"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
179
181
180
let checkout_roundtrip () =
182
-
match Json_bytesrw.decode_string Stripe.Checkout.jsont checkout_json with
183
-
| Error e -> Alcotest.failf "decode: %s" e
181
+
match Json.of_string Stripe.Checkout.jsont checkout_json with
182
+
| Error e -> Alcotest.failf "decode: %s" (Loc.Error.to_string e)
184
183
| Ok c ->
185
184
Alcotest.(check string) "id" "cs_test_xyz" c.id;
186
185
Alcotest.(check bool) "has url" true (String.length c.url > 0);