Stripe API client for OCaml
fix(ocaml-requests): update tests and fuzz for cstruct→Bytes migration
Test files still referenced Cstruct.t where the API now uses bytes.
Fixed all H2 frame, HPACK, client, and connection tests.
Fixed fuzz test. 330 tests pass.
+218
-220
+2
-1
dune-project
+2
-1
dune-project
+135
-148
lib/stripe.ml
+135
-148
lib/stripe.ml
···
7
7
8
8
let base_url = "https://api.stripe.com/v1"
9
9
10
-
type config = {
11
-
secret_key : string;
12
-
session : Requests.t;
13
-
}
10
+
type config = { secret_key : string; session : Requests.t }
14
11
15
12
let config ~secret_key session = { secret_key; session }
16
13
···
24
21
}
25
22
26
23
let pp_error ppf e =
27
-
Fmt.pf ppf "Stripe error %d (%s): %s [%s]"
28
-
e.status e.error_type e.message e.code
24
+
Fmt.pf ppf "Stripe error %d (%s): %s [%s]" e.status e.error_type e.message
25
+
e.code
29
26
30
27
exception Stripe_error of error
31
28
32
29
let error_jsont =
33
30
Jsont.Object.map (fun error_type message code ->
34
-
{ error_type; message; code; status = 0 })
35
-
|> Jsont.Object.mem "type" Jsont.string ~dec_absent:"" ~enc:(fun e -> e.error_type)
36
-
|> Jsont.Object.mem "message" Jsont.string ~dec_absent:"" ~enc:(fun e -> e.message)
31
+
{ error_type; message; code; status = 0 })
32
+
|> Jsont.Object.mem "type" Jsont.string ~dec_absent:"" ~enc:(fun e ->
33
+
e.error_type)
34
+
|> Jsont.Object.mem "message" Jsont.string ~dec_absent:"" ~enc:(fun e ->
35
+
e.message)
37
36
|> Jsont.Object.mem "code" Jsont.string ~dec_absent:"" ~enc:(fun e -> e.code)
38
37
|> Jsont.Object.finish
39
38
···
61
60
let err =
62
61
match Jsont_bytesrw.decode_string error_wrapper_jsont text with
63
62
| Ok e -> { e with status }
64
-
| Error _ -> { error_type = "api_error"; message = text;
65
-
code = ""; status }
63
+
| Error _ ->
64
+
{ error_type = "api_error"; message = text; code = ""; status }
66
65
in
67
66
raise (Stripe_error err)
68
67
end;
···
70
69
71
70
let post cfg path body =
72
71
let url = base_url ^ path in
73
-
Requests.post cfg.session url ~auth:(auth cfg)
74
-
~body:(Requests.Body.form body)
72
+
Requests.post cfg.session url ~auth:(auth cfg) ~body:(Requests.Body.form body)
75
73
|> check_response
76
74
77
75
let get cfg path params =
78
76
let url = base_url ^ path in
79
-
Requests.get cfg.session url ~auth:(auth cfg) ~params
80
-
|> check_response
77
+
Requests.get cfg.session url ~auth:(auth cfg) ~params |> check_response
81
78
82
79
let delete cfg path =
83
80
let url = base_url ^ path in
84
-
Requests.delete cfg.session url ~auth:(auth cfg)
85
-
|> check_response
81
+
Requests.delete cfg.session url ~auth:(auth cfg) |> check_response
86
82
87
83
let decode jsont text =
88
84
match Jsont_bytesrw.decode_string jsont text with
···
91
87
92
88
let list_jsont item_jsont =
93
89
Jsont.Object.map (fun data has_more -> (data, has_more))
94
-
|> Jsont.Object.mem "data" (Jsont.list item_jsont)
95
-
~enc:(fun (d, _) -> d)
96
-
|> Jsont.Object.mem "has_more" Jsont.bool
97
-
~enc:(fun (_, h) -> h)
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)
98
92
|> Jsont.Object.finish
99
93
100
94
(* {1 Customers} *)
···
108
102
created : int;
109
103
}
110
104
111
-
let pp ppf c =
112
-
Fmt.pf ppf "customer(%s, %s, %s)" c.id c.email c.name
105
+
let pp ppf c = Fmt.pf ppf "customer(%s, %s, %s)" c.id c.email c.name
113
106
114
107
let jsont =
115
108
Jsont.Object.map (fun id email name metadata created ->
116
-
{ id; email; name; metadata; created })
109
+
{ id; email; name; metadata; created })
117
110
|> Jsont.Object.mem "id" Jsont.string ~enc:(fun c -> c.id)
118
-
|> Jsont.Object.mem "email" Jsont.string ~dec_absent:""
119
-
~enc:(fun c -> c.email)
120
-
|> Jsont.Object.mem "name" Jsont.string ~dec_absent:""
121
-
~enc:(fun c -> c.name)
111
+
|> Jsont.Object.mem "email" Jsont.string ~dec_absent:"" ~enc:(fun c ->
112
+
c.email)
113
+
|> Jsont.Object.mem "name" Jsont.string ~dec_absent:"" ~enc:(fun c ->
114
+
c.name)
122
115
|> Jsont.Object.mem "metadata" metadata_jsont ~dec_absent:Smap.empty
123
116
~enc:(fun c -> c.metadata)
124
-
|> Jsont.Object.mem "created" Jsont.int ~dec_absent:0
125
-
~enc:(fun c -> c.created)
117
+
|> Jsont.Object.mem "created" Jsont.int ~dec_absent:0 ~enc:(fun c ->
118
+
c.created)
126
119
|> Jsont.Object.finish
127
120
128
121
let create cfg ~email ?name ?metadata () =
129
122
let body =
130
123
[ ("email", email) ]
131
124
@ (match name with Some n -> [ ("name", n) ] | None -> [])
132
-
@ (match metadata with
133
-
| Some md ->
134
-
Smap.fold (fun k v acc ->
135
-
(Fmt.str "metadata[%s]" k, v) :: acc) md []
136
-
| None -> [])
125
+
@
126
+
match metadata with
127
+
| Some md ->
128
+
Smap.fold (fun k v acc -> (Fmt.str "metadata[%s]" k, v) :: acc) md []
129
+
| None -> []
137
130
in
138
131
post cfg "/customers" body |> decode jsont
139
132
140
-
let retrieve cfg id =
141
-
get cfg ("/customers/" ^ id) [] |> decode jsont
133
+
let retrieve cfg id = get cfg ("/customers/" ^ id) [] |> decode jsont
142
134
143
135
let list cfg ?limit ?starting_after () =
144
136
let params =
145
-
(match limit with Some n -> [ ("limit", string_of_int n) ]
146
-
| None -> [])
147
-
@ (match starting_after with Some s -> [ ("starting_after", s) ]
148
-
| None -> [])
137
+
(match limit with Some n -> [ ("limit", string_of_int n) ] | None -> [])
138
+
@
139
+
match starting_after with
140
+
| Some s -> [ ("starting_after", s) ]
141
+
| None -> []
149
142
in
150
143
get cfg "/customers" params |> decode (list_jsont jsont)
151
144
end
···
153
146
(* {1 Products} *)
154
147
155
148
module Product = struct
156
-
type t = {
157
-
id : string;
158
-
name : string;
159
-
active : bool;
160
-
metadata : metadata;
161
-
}
149
+
type t = { id : string; name : string; active : bool; metadata : metadata }
162
150
163
-
let pp ppf p =
164
-
Fmt.pf ppf "product(%s, %s)" p.id p.name
151
+
let pp ppf p = Fmt.pf ppf "product(%s, %s)" p.id p.name
165
152
166
153
let jsont =
167
154
Jsont.Object.map (fun id name active metadata ->
168
-
{ id; name; active; metadata })
155
+
{ id; name; active; metadata })
169
156
|> Jsont.Object.mem "id" Jsont.string ~enc:(fun p -> p.id)
170
157
|> Jsont.Object.mem "name" Jsont.string ~enc:(fun p -> p.name)
171
-
|> Jsont.Object.mem "active" Jsont.bool ~dec_absent:true
172
-
~enc:(fun p -> p.active)
158
+
|> Jsont.Object.mem "active" Jsont.bool ~dec_absent:true ~enc:(fun p ->
159
+
p.active)
173
160
|> Jsont.Object.mem "metadata" metadata_jsont ~dec_absent:Smap.empty
174
161
~enc:(fun p -> p.metadata)
175
162
|> Jsont.Object.finish
···
177
164
let create cfg ~name ?metadata () =
178
165
let body =
179
166
[ ("name", name) ]
180
-
@ (match metadata with
181
-
| Some md ->
182
-
Smap.fold (fun k v acc ->
183
-
(Fmt.str "metadata[%s]" k, v) :: acc) md []
184
-
| None -> [])
167
+
@
168
+
match metadata with
169
+
| Some md ->
170
+
Smap.fold (fun k v acc -> (Fmt.str "metadata[%s]" k, v) :: acc) md []
171
+
| None -> []
185
172
in
186
173
post cfg "/products" body |> decode jsont
187
174
188
-
let retrieve cfg id =
189
-
get cfg ("/products/" ^ id) [] |> decode jsont
175
+
let retrieve cfg id = get cfg ("/products/" ^ id) [] |> decode jsont
190
176
end
191
177
192
178
(* {1 Prices} *)
193
179
194
180
module Price = struct
195
-
type recurring = {
196
-
interval : string;
197
-
interval_count : int;
198
-
}
181
+
type recurring = { interval : string; interval_count : int }
199
182
200
183
let recurring_jsont =
201
184
Jsont.Object.map (fun interval interval_count ->
202
-
{ interval; interval_count })
203
-
|> Jsont.Object.mem "interval" Jsont.string
204
-
~enc:(fun r -> r.interval)
205
-
|> Jsont.Object.mem "interval_count" Jsont.int ~dec_absent:1
206
-
~enc:(fun r -> r.interval_count)
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 ->
188
+
r.interval_count)
207
189
|> Jsont.Object.finish
208
190
209
191
type t = {
···
215
197
active : bool;
216
198
}
217
199
218
-
let pp ppf p =
219
-
Fmt.pf ppf "price(%s, %d %s)" p.id p.unit_amount p.currency
200
+
let pp ppf p = Fmt.pf ppf "price(%s, %d %s)" p.id p.unit_amount p.currency
220
201
221
202
let jsont =
222
203
Jsont.Object.map (fun id product unit_amount currency recurring active ->
223
-
{ id; product; unit_amount; currency; recurring; active })
204
+
{ id; product; unit_amount; currency; recurring; active })
224
205
|> Jsont.Object.mem "id" Jsont.string ~enc:(fun p -> p.id)
225
206
|> Jsont.Object.mem "product" Jsont.string ~enc:(fun p -> p.product)
226
-
|> Jsont.Object.mem "unit_amount" Jsont.int ~dec_absent:0
227
-
~enc:(fun p -> p.unit_amount)
207
+
|> Jsont.Object.mem "unit_amount" Jsont.int ~dec_absent:0 ~enc:(fun p ->
208
+
p.unit_amount)
228
209
|> Jsont.Object.mem "currency" Jsont.string ~enc:(fun p -> p.currency)
229
210
|> Jsont.Object.mem "recurring" (Jsont.option recurring_jsont)
230
211
~dec_absent:None ~enc:(fun p -> p.recurring)
231
-
|> Jsont.Object.mem "active" Jsont.bool ~dec_absent:true
232
-
~enc:(fun p -> p.active)
212
+
|> Jsont.Object.mem "active" Jsont.bool ~dec_absent:true ~enc:(fun p ->
213
+
p.active)
233
214
|> Jsont.Object.finish
234
215
235
-
let create cfg ~product ~unit_amount ~currency ?interval
236
-
?interval_count () =
216
+
let create cfg ~product ~unit_amount ~currency ?interval ?interval_count () =
237
217
let body =
238
-
[ ("product", product);
218
+
[
219
+
("product", product);
239
220
("unit_amount", string_of_int unit_amount);
240
-
("currency", currency) ]
241
-
@ (match interval with
242
-
| Some i ->
243
-
[ ("recurring[interval]", i);
244
-
("recurring[interval_count]",
245
-
string_of_int (Option.value ~default:1 interval_count)) ]
246
-
| None -> [])
221
+
("currency", currency);
222
+
]
223
+
@
224
+
match interval with
225
+
| Some i ->
226
+
[
227
+
("recurring[interval]", i);
228
+
( "recurring[interval_count]",
229
+
string_of_int (Option.value ~default:1 interval_count) );
230
+
]
231
+
| None -> []
247
232
in
248
233
post cfg "/prices" body |> decode jsont
249
234
end
···
261
246
metadata : metadata;
262
247
}
263
248
264
-
let pp ppf s =
265
-
Fmt.pf ppf "subscription(%s, %s, %s)" s.id s.customer s.status
249
+
let pp ppf s = Fmt.pf ppf "subscription(%s, %s, %s)" s.id s.customer s.status
266
250
267
251
let jsont =
268
-
Jsont.Object.map (fun id customer status current_period_start
269
-
current_period_end cancel_at_period_end metadata ->
270
-
{ id; customer; status; current_period_start; current_period_end;
271
-
cancel_at_period_end; metadata })
252
+
Jsont.Object.map
253
+
(fun
254
+
id
255
+
customer
256
+
status
257
+
current_period_start
258
+
current_period_end
259
+
cancel_at_period_end
260
+
metadata
261
+
->
262
+
{
263
+
id;
264
+
customer;
265
+
status;
266
+
current_period_start;
267
+
current_period_end;
268
+
cancel_at_period_end;
269
+
metadata;
270
+
})
272
271
|> Jsont.Object.mem "id" Jsont.string ~enc:(fun s -> s.id)
273
272
|> Jsont.Object.mem "customer" Jsont.string ~enc:(fun s -> s.customer)
274
273
|> Jsont.Object.mem "status" Jsont.string ~enc:(fun s -> s.status)
···
284
283
285
284
let create cfg ~customer ~price ?metadata () =
286
285
let body =
287
-
[ ("customer", customer);
288
-
("items[0][price]", price) ]
289
-
@ (match metadata with
290
-
| Some md ->
291
-
Smap.fold (fun k v acc ->
292
-
(Fmt.str "metadata[%s]" k, v) :: acc) md []
293
-
| None -> [])
286
+
[ ("customer", customer); ("items[0][price]", price) ]
287
+
@
288
+
match metadata with
289
+
| Some md ->
290
+
Smap.fold (fun k v acc -> (Fmt.str "metadata[%s]" k, v) :: acc) md []
291
+
| None -> []
294
292
in
295
293
post cfg "/subscriptions" body |> decode jsont
296
294
297
-
let retrieve cfg id =
298
-
get cfg ("/subscriptions/" ^ id) [] |> decode jsont
295
+
let retrieve cfg id = get cfg ("/subscriptions/" ^ id) [] |> decode jsont
299
296
300
297
let cancel cfg id =
301
-
post cfg ("/subscriptions/" ^ id)
302
-
[ ("cancel_at_period_end", "true") ]
298
+
post cfg ("/subscriptions/" ^ id) [ ("cancel_at_period_end", "true") ]
303
299
|> decode jsont
304
300
end
305
301
···
314
310
status : string;
315
311
}
316
312
317
-
let pp ppf c =
318
-
Fmt.pf ppf "checkout(%s, %s)" c.id c.status
313
+
let pp ppf c = Fmt.pf ppf "checkout(%s, %s)" c.id c.status
319
314
320
315
let jsont =
321
316
Jsont.Object.map (fun id url customer subscription status ->
322
-
{ id; url; customer; subscription; status })
317
+
{ id; url; customer; subscription; status })
323
318
|> Jsont.Object.mem "id" Jsont.string ~enc:(fun c -> c.id)
324
-
|> Jsont.Object.mem "url" Jsont.string ~dec_absent:""
325
-
~enc:(fun c -> c.url)
326
-
|> Jsont.Object.mem "customer" Jsont.string ~dec_absent:""
327
-
~enc:(fun c -> c.customer)
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 ->
321
+
c.customer)
328
322
|> Jsont.Object.mem "subscription" Jsont.string ~dec_absent:""
329
323
~enc:(fun c -> c.subscription)
330
-
|> Jsont.Object.mem "status" Jsont.string ~dec_absent:""
331
-
~enc:(fun c -> c.status)
324
+
|> Jsont.Object.mem "status" Jsont.string ~dec_absent:"" ~enc:(fun c ->
325
+
c.status)
332
326
|> Jsont.Object.finish
333
327
334
328
let create cfg ~customer ~price ~success_url ~cancel_url () =
335
329
let body =
336
-
[ ("customer", customer);
330
+
[
331
+
("customer", customer);
337
332
("mode", "subscription");
338
333
("line_items[0][price]", price);
339
334
("line_items[0][quantity]", "1");
340
335
("success_url", success_url);
341
-
("cancel_url", cancel_url) ]
336
+
("cancel_url", cancel_url);
337
+
]
342
338
in
343
339
post cfg "/checkout/sessions" body |> decode jsont
344
340
end
···
346
342
(* {1 Billing Portal} *)
347
343
348
344
module Portal = struct
349
-
type t = {
350
-
id : string;
351
-
url : string;
352
-
}
345
+
type t = { id : string; url : string }
353
346
354
-
let pp ppf p =
355
-
Fmt.pf ppf "portal(%s)" p.id
347
+
let pp ppf p = Fmt.pf ppf "portal(%s)" p.id
356
348
357
349
let jsont =
358
350
Jsont.Object.map (fun id url -> { id; url })
···
361
353
|> Jsont.Object.finish
362
354
363
355
let create cfg ~customer ~return_url =
364
-
let body =
365
-
[ ("customer", customer);
366
-
("return_url", return_url) ]
367
-
in
356
+
let body = [ ("customer", customer); ("return_url", return_url) ] in
368
357
post cfg "/billing_portal/sessions" body |> decode jsont
369
358
end
370
359
···
378
367
data : Jsont.json;
379
368
}
380
369
381
-
let pp_event ppf e =
382
-
Fmt.pf ppf "event(%s, %s)" e.id e.event_type
370
+
let pp_event ppf e = Fmt.pf ppf "event(%s, %s)" e.id e.event_type
383
371
384
372
let event_jsont =
385
373
Jsont.Object.map (fun id event_type created data ->
386
-
{ id; event_type; created; data })
374
+
{ id; event_type; created; data })
387
375
|> Jsont.Object.mem "id" Jsont.string ~enc:(fun e -> e.id)
388
376
|> Jsont.Object.mem "type" Jsont.string ~enc:(fun e -> e.event_type)
389
-
|> Jsont.Object.mem "created" Jsont.int ~dec_absent:0
390
-
~enc:(fun e -> e.created)
377
+
|> Jsont.Object.mem "created" Jsont.int ~dec_absent:0 ~enc:(fun e ->
378
+
e.created)
391
379
|> Jsont.Object.mem "data" Jsont.json ~enc:(fun e -> e.data)
392
380
|> Jsont.Object.finish
393
381
···
397
385
Signature: HMAC-SHA256(secret, signed_payload) *)
398
386
399
387
let compute_hmac ~secret ~payload =
400
-
Digestif.SHA256.hmac_string ~key:secret payload
401
-
|> Digestif.SHA256.to_hex
388
+
Digestif.SHA256.hmac_string ~key:secret payload |> Digestif.SHA256.to_hex
402
389
403
390
let parse_signature_header sig_header =
404
391
let parts = String.split_on_char ',' sig_header in
405
392
let timestamp = ref None in
406
393
let signatures = ref [] in
407
-
List.iter (fun part ->
408
-
match String.split_on_char '=' part with
409
-
| ["t"; v] -> timestamp := Some v
410
-
| ["v1"; v] -> signatures := v :: !signatures
411
-
| _ -> ())
394
+
List.iter
395
+
(fun part ->
396
+
match String.split_on_char '=' part with
397
+
| [ "t"; v ] -> timestamp := Some v
398
+
| [ "v1"; v ] -> signatures := v :: !signatures
399
+
| _ -> ())
412
400
parts;
413
401
(!timestamp, List.rev !signatures)
414
402
415
403
let tolerance_seconds = 300 (* 5 minutes *)
416
-
417
404
let err_no_timestamp = Error "missing timestamp in Stripe-Signature header"
418
405
let err_invalid_timestamp = Error "invalid timestamp"
419
406
let err_timestamp_old age = Error (Fmt.str "timestamp too old (%ds)" age)
···
423
410
match parse_signature_header signature with
424
411
| None, _ -> err_no_timestamp
425
412
| Some ts, sigs ->
426
-
let signed_payload = ts ^ "." ^ payload in
427
-
let expected = compute_hmac ~secret ~payload:signed_payload in
428
-
if List.exists (fun s -> String.equal s expected) sigs then begin
429
-
match int_of_string_opt ts with
430
-
| None -> err_invalid_timestamp
431
-
| Some t ->
432
-
let now = int_of_float (Unix.gettimeofday ()) in
433
-
let age = abs (now - t) in
434
-
if age > tolerance_seconds then err_timestamp_old age
435
-
else decode event_jsont payload |> Result.ok
436
-
end
437
-
else err_signature_mismatch
413
+
let signed_payload = ts ^ "." ^ payload in
414
+
let expected = compute_hmac ~secret ~payload:signed_payload in
415
+
if List.exists (fun s -> String.equal s expected) sigs then begin
416
+
match int_of_string_opt ts with
417
+
| None -> err_invalid_timestamp
418
+
| Some t ->
419
+
let now = int_of_float (Unix.gettimeofday ()) in
420
+
let age = abs (now - t) in
421
+
if age > tolerance_seconds then err_timestamp_old age
422
+
else decode event_jsont payload |> Result.ok
423
+
end
424
+
else err_signature_mismatch
438
425
end
+32
-24
lib/stripe.mli
+32
-24
lib/stripe.mli
···
8
8
Covers the subset needed for subscription billing: customers, products,
9
9
prices, subscriptions, checkout sessions, billing portal, and webhooks.
10
10
11
-
{b Authentication}: uses Stripe secret API keys via [Authorization: Bearer sk_...].
11
+
{b Authentication}: uses Stripe secret API keys via
12
+
[Authorization: Bearer sk_...].
12
13
13
14
{b Base URL}: [https://api.stripe.com/v1]
14
15
···
47
48
val jsont : t Jsont.t
48
49
(** JSON codec for customers. *)
49
50
50
-
val create : config -> email:string -> ?name:string ->
51
-
?metadata:metadata -> unit -> t
51
+
val create :
52
+
config -> email:string -> ?name:string -> ?metadata:metadata -> unit -> t
52
53
(** Create a customer. *)
53
54
54
55
val retrieve : config -> string -> t
55
56
(** [retrieve config customer_id] fetches a customer. *)
56
57
57
-
val list : config -> ?limit:int -> ?starting_after:string -> unit ->
58
-
t list * bool
58
+
val list :
59
+
config -> ?limit:int -> ?starting_after:string -> unit -> t list * bool
59
60
(** [list config ()] returns [(customers, has_more)]. *)
60
61
end
61
62
62
63
(** {1 Products} *)
63
64
64
65
module Product : sig
65
-
type t = {
66
-
id : string;
67
-
name : string;
68
-
active : bool;
69
-
metadata : metadata;
70
-
}
66
+
type t = { id : string; name : string; active : bool; metadata : metadata }
71
67
72
68
val pp : t Fmt.t
73
69
(** Pretty-print a product. *)
···
105
101
val jsont : t Jsont.t
106
102
(** JSON codec for prices. *)
107
103
108
-
val create : config -> product:string -> unit_amount:int ->
109
-
currency:string -> ?interval:string -> ?interval_count:int ->
110
-
unit -> t
104
+
val create :
105
+
config ->
106
+
product:string ->
107
+
unit_amount:int ->
108
+
currency:string ->
109
+
?interval:string ->
110
+
?interval_count:int ->
111
+
unit ->
112
+
t
111
113
(** Create a price. *)
112
114
end
113
115
···
130
132
val jsont : t Jsont.t
131
133
(** JSON codec for subscriptions. *)
132
134
133
-
val create : config -> customer:string -> price:string ->
134
-
?metadata:metadata -> unit -> t
135
+
val create :
136
+
config -> customer:string -> price:string -> ?metadata:metadata -> unit -> t
135
137
(** Create a subscription. *)
136
138
137
139
val retrieve : config -> string -> t
···
158
160
val jsont : t Jsont.t
159
161
(** JSON codec for checkout sessions. *)
160
162
161
-
val create : config -> customer:string -> price:string ->
162
-
success_url:string -> cancel_url:string -> unit -> t
163
+
val create :
164
+
config ->
165
+
customer:string ->
166
+
price:string ->
167
+
success_url:string ->
168
+
cancel_url:string ->
169
+
unit ->
170
+
t
163
171
(** Create a checkout session for a subscription. *)
164
172
end
165
173
166
174
(** {1 Billing Portal} *)
167
175
168
176
module Portal : sig
169
-
type t = {
170
-
id : string;
171
-
url : string;
172
-
}
177
+
type t = { id : string; url : string }
173
178
174
179
val pp : t Fmt.t
175
180
(** Pretty-print a portal session. *)
···
197
202
val event_jsont : event Jsont.t
198
203
(** JSON codec for webhook events. *)
199
204
200
-
val verify_signature : secret:string -> payload:string ->
201
-
signature:string -> (event, string) result
205
+
val verify_signature :
206
+
secret:string ->
207
+
payload:string ->
208
+
signature:string ->
209
+
(event, string) result
202
210
(** [verify_signature ~secret ~payload ~signature] verifies the webhook
203
211
signature header ([Stripe-Signature]) and returns the parsed event.
204
212
+2
-1
stripe.opam
+2
-1
stripe.opam
+47
-46
test/test_stripe.ml
+47
-46
test/test_stripe.ml
···
28
28
let valid_signature () =
29
29
let timestamp = int_of_float (Unix.gettimeofday ()) in
30
30
let sig_header =
31
-
signature ~secret:webhook_secret ~timestamp
32
-
~payload:sample_event_json
31
+
signature ~secret:webhook_secret ~timestamp ~payload:sample_event_json
33
32
in
34
33
match
35
34
Stripe.Webhook.verify_signature ~secret:webhook_secret
36
35
~payload:sample_event_json ~signature:sig_header
37
36
with
38
37
| Ok event ->
39
-
Alcotest.(check string) "event id" "evt_test_123" event.id;
40
-
Alcotest.(check string) "event type" "customer.subscription.updated"
41
-
event.event_type;
42
-
Alcotest.(check int) "created" 1735732800 event.created
38
+
Alcotest.(check string) "event id" "evt_test_123" event.id;
39
+
Alcotest.(check string)
40
+
"event type" "customer.subscription.updated" event.event_type;
41
+
Alcotest.(check int) "created" 1735732800 event.created
43
42
| Error e -> Alcotest.fail (Printf.sprintf "verification failed: %s" e)
44
43
45
44
(* Wrong secret should fail *)
46
45
let wrong_secret () =
47
46
let timestamp = int_of_float (Unix.gettimeofday ()) in
48
47
let sig_header =
49
-
signature ~secret:"whsec_wrong_key" ~timestamp
50
-
~payload:sample_event_json
48
+
signature ~secret:"whsec_wrong_key" ~timestamp ~payload:sample_event_json
51
49
in
52
50
match
53
51
Stripe.Webhook.verify_signature ~secret:webhook_secret
···
55
53
with
56
54
| Ok _ -> Alcotest.fail "should have rejected wrong secret"
57
55
| Error msg ->
58
-
Alcotest.(check bool) "signature mismatch"
59
-
true (String.equal msg "signature mismatch")
56
+
Alcotest.(check bool)
57
+
"signature mismatch" true
58
+
(String.equal msg "signature mismatch")
60
59
61
60
(* Tampered payload should fail *)
62
61
let tampered_payload () =
63
62
let timestamp = int_of_float (Unix.gettimeofday ()) in
64
63
let sig_header =
65
-
signature ~secret:webhook_secret ~timestamp
66
-
~payload:sample_event_json
64
+
signature ~secret:webhook_secret ~timestamp ~payload:sample_event_json
67
65
in
68
66
match
69
67
Stripe.Webhook.verify_signature ~secret:webhook_secret
70
-
~payload:(sample_event_json ^ "tampered") ~signature:sig_header
68
+
~payload:(sample_event_json ^ "tampered")
69
+
~signature:sig_header
71
70
with
72
71
| Ok _ -> Alcotest.fail "should have rejected tampered payload"
73
72
| Error msg ->
74
-
Alcotest.(check bool) "signature mismatch"
75
-
true (String.equal msg "signature mismatch")
73
+
Alcotest.(check bool)
74
+
"signature mismatch" true
75
+
(String.equal msg "signature mismatch")
76
76
77
77
(* Old timestamp should fail *)
78
78
let old_timestamp () =
···
87
87
with
88
88
| Ok _ -> Alcotest.fail "should have rejected old timestamp"
89
89
| Error msg ->
90
-
Alcotest.(check bool) "timestamp too old"
91
-
true (String.length msg > 0)
90
+
Alcotest.(check bool) "timestamp too old" true (String.length msg > 0)
92
91
93
92
(* Missing timestamp in header *)
94
93
let missing_timestamp () =
···
114
113
Stripe.Webhook.verify_signature ~secret:webhook_secret
115
114
~payload:sample_event_json ~signature:sig_header
116
115
with
117
-
| Ok event ->
118
-
Alcotest.(check string) "event id" "evt_test_123" event.id
116
+
| Ok event -> Alcotest.(check string) "event id" "evt_test_123" event.id
119
117
| Error e -> Alcotest.fail (Printf.sprintf "should accept any valid v1: %s" e)
120
118
121
119
(* {1 JSON codec tests} *)
···
127
125
match Jsont_bytesrw.decode_string Stripe.Customer.jsont customer_json with
128
126
| Error e -> Alcotest.fail (Printf.sprintf "decode: %s" e)
129
127
| Ok c ->
130
-
Alcotest.(check string) "id" "cus_test_123" c.id;
131
-
Alcotest.(check string) "email" "test@example.com" c.email;
132
-
Alcotest.(check string) "name" "Test User" c.name;
133
-
Alcotest.(check int) "created" 1735732800 c.created;
134
-
Alcotest.(check bool) "metadata plan"
135
-
true (Stripe.Smap.find_opt "plan" c.metadata = Some "pro")
128
+
Alcotest.(check string) "id" "cus_test_123" c.id;
129
+
Alcotest.(check string) "email" "test@example.com" c.email;
130
+
Alcotest.(check string) "name" "Test User" c.name;
131
+
Alcotest.(check int) "created" 1735732800 c.created;
132
+
Alcotest.(check bool)
133
+
"metadata plan" true
134
+
(Stripe.Smap.find_opt "plan" c.metadata = Some "pro")
136
135
137
136
let subscription_json =
138
137
{|{"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"}|}
139
138
140
139
let subscription_roundtrip () =
141
-
match Jsont_bytesrw.decode_string Stripe.Subscription.jsont subscription_json with
140
+
match
141
+
Jsont_bytesrw.decode_string Stripe.Subscription.jsont subscription_json
142
+
with
142
143
| Error e -> Alcotest.fail (Printf.sprintf "decode: %s" e)
143
144
| Ok s ->
144
-
Alcotest.(check string) "id" "sub_test_456" s.id;
145
-
Alcotest.(check string) "customer" "cus_test_123" s.customer;
146
-
Alcotest.(check string) "status" "active" s.status;
147
-
Alcotest.(check bool) "not cancel" false s.cancel_at_period_end
145
+
Alcotest.(check string) "id" "sub_test_456" s.id;
146
+
Alcotest.(check string) "customer" "cus_test_123" s.customer;
147
+
Alcotest.(check string) "status" "active" s.status;
148
+
Alcotest.(check bool) "not cancel" false s.cancel_at_period_end
148
149
149
150
let price_json =
150
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
153
let price_roundtrip () =
153
154
match Jsont_bytesrw.decode_string Stripe.Price.jsont price_json with
154
155
| Error e -> Alcotest.fail (Printf.sprintf "decode: %s" e)
155
-
| Ok p ->
156
-
Alcotest.(check string) "id" "price_test_789" p.id;
157
-
Alcotest.(check string) "product" "prod_test_abc" p.product;
158
-
Alcotest.(check int) "amount" 500000 p.unit_amount;
159
-
Alcotest.(check string) "currency" "usd" p.currency;
160
-
(match p.recurring with
161
-
| None -> Alcotest.fail "expected recurring"
162
-
| Some r ->
163
-
Alcotest.(check string) "interval" "year" r.interval;
164
-
Alcotest.(check int) "interval_count" 1 r.interval_count)
156
+
| Ok p -> (
157
+
Alcotest.(check string) "id" "price_test_789" p.id;
158
+
Alcotest.(check string) "product" "prod_test_abc" p.product;
159
+
Alcotest.(check int) "amount" 500000 p.unit_amount;
160
+
Alcotest.(check string) "currency" "usd" p.currency;
161
+
match p.recurring with
162
+
| None -> Alcotest.fail "expected recurring"
163
+
| Some r ->
164
+
Alcotest.(check string) "interval" "year" r.interval;
165
+
Alcotest.(check int) "interval_count" 1 r.interval_count)
165
166
166
167
let product_json =
167
168
{|{"id":"prod_test_abc","name":"SSA Pro","active":true,"metadata":{"tier":"pro"},"object":"product"}|}
···
170
171
match Jsont_bytesrw.decode_string Stripe.Product.jsont product_json with
171
172
| Error e -> Alcotest.fail (Printf.sprintf "decode: %s" e)
172
173
| Ok p ->
173
-
Alcotest.(check string) "id" "prod_test_abc" p.id;
174
-
Alcotest.(check string) "name" "SSA Pro" p.name;
175
-
Alcotest.(check bool) "active" true p.active
174
+
Alcotest.(check string) "id" "prod_test_abc" p.id;
175
+
Alcotest.(check string) "name" "SSA Pro" p.name;
176
+
Alcotest.(check bool) "active" true p.active
176
177
177
178
let checkout_json =
178
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"}|}
···
181
182
match Jsont_bytesrw.decode_string Stripe.Checkout.jsont checkout_json with
182
183
| Error e -> Alcotest.fail (Printf.sprintf "decode: %s" e)
183
184
| Ok c ->
184
-
Alcotest.(check string) "id" "cs_test_xyz" c.id;
185
-
Alcotest.(check bool) "has url" true (String.length c.url > 0);
186
-
Alcotest.(check string) "customer" "cus_test_123" c.customer
185
+
Alcotest.(check string) "id" "cs_test_xyz" c.id;
186
+
Alcotest.(check bool) "has url" true (String.length c.url > 0);
187
+
Alcotest.(check string) "customer" "cus_test_123" c.customer
187
188
188
189
let suite =
189
190
( "stripe",