Stripe API client for OCaml
Migrate from vendored crowbar to opam-pinned alcobar
- Remove vendored crowbar/ directory
- Replace all Crowbar references with Alcobar across 176 .ml files
- Update all fuzz dune files: crowbar → alcobar in libraries
- Remove 77 gen_corpus.ml files (alcobar handles corpus internally)
- Update dune-project files: crowbar → alcobar in dependencies
- Update merlint rules (e705, e726): Crowbar → Alcobar in checks,
docs, and examples
- Update merlint generated docs (index.html)
428 files changed, ~1200 lines removed net.
+936
+1
.ocamlformat
+1
.ocamlformat
···
1
+
version = 0.28.1
+26
dune-project
+26
dune-project
···
1
+
(lang dune 3.21)
2
+
3
+
(name stripe)
4
+
5
+
(generate_opam_files true)
6
+
7
+
(license MIT)
8
+
(authors "Thomas Gazagnaire <thomas@gazagnaire.org>")
9
+
(maintainers "Thomas Gazagnaire <thomas@gazagnaire.org>")
10
+
11
+
(source (tangled gazagnaire.org/ocaml-stripe))
12
+
13
+
(package
14
+
(name stripe)
15
+
(synopsis "Stripe API client for OCaml")
16
+
(description
17
+
"Minimal Stripe API client for SaaS billing: customers, products, prices, \
18
+
subscriptions, checkout sessions, and webhook verification. Uses \
19
+
ocaml-requests for HTTP and jsont for JSON codec.")
20
+
(depends
21
+
(ocaml (>= 4.14))
22
+
(requests (>= 0.1))
23
+
(jsont (>= 0.1))
24
+
(jsont-bytesrw (>= 0.1))
25
+
(digestif (>= 1.0))
26
+
(alcotest :with-test)))
+4
lib/dune
+4
lib/dune
+468
lib/stripe.ml
+468
lib/stripe.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2026 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(* {1 Configuration} *)
7
+
8
+
let base_url = "https://api.stripe.com/v1"
9
+
10
+
type config = {
11
+
secret_key : string;
12
+
session : Requests.t;
13
+
}
14
+
15
+
let config ~secret_key session = { secret_key; session }
16
+
17
+
(* {1 Errors} *)
18
+
19
+
type error = {
20
+
error_type : string;
21
+
message : string;
22
+
code : string;
23
+
status : int;
24
+
}
25
+
26
+
let pp_error ppf e =
27
+
Format.fprintf ppf "Stripe error %d (%s): %s [%s]"
28
+
e.status e.error_type e.message e.code
29
+
30
+
exception Stripe_error of error
31
+
32
+
let error_jsont =
33
+
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)
37
+
|> Jsont.Object.mem "code" Jsont.string ~dec_absent:"" ~enc:(fun e -> e.code)
38
+
|> Jsont.Object.finish
39
+
40
+
let error_wrapper_jsont =
41
+
Jsont.Object.map Fun.id
42
+
|> Jsont.Object.mem "error" error_jsont ~enc:Fun.id
43
+
|> Jsont.Object.finish
44
+
45
+
(* {1 Common types} *)
46
+
47
+
type metadata = (string * string) list
48
+
49
+
let metadata_jsont =
50
+
Jsont.Object.map Fun.id
51
+
|> Jsont.Object.keep_unknown Jsont.string
52
+
~enc:(fun md -> List.to_seq md)
53
+
|> Jsont.Object.finish
54
+
55
+
(* {1 HTTP helpers} *)
56
+
57
+
let auth_headers cfg =
58
+
[ ("Authorization", "Bearer " ^ cfg.secret_key) ]
59
+
60
+
let post cfg path body =
61
+
let url = base_url ^ path in
62
+
let resp =
63
+
Requests.post cfg.session url
64
+
~headers:(auth_headers cfg)
65
+
~body:(Requests.Body.form body)
66
+
in
67
+
let status = Requests.Response.status_code resp in
68
+
let text = Requests.Response.text resp in
69
+
if status >= 400 then begin
70
+
let err =
71
+
match Jsont_bytesrw.decode_string error_wrapper_jsont text with
72
+
| Ok e -> { e with status }
73
+
| Error _ -> { error_type = "api_error"; message = text;
74
+
code = ""; status }
75
+
in
76
+
raise (Stripe_error err)
77
+
end;
78
+
text
79
+
80
+
let get cfg path params =
81
+
let query =
82
+
match params with
83
+
| [] -> ""
84
+
| ps ->
85
+
"?" ^ String.concat "&"
86
+
(List.map (fun (k, v) ->
87
+
Printf.sprintf "%s=%s" k v) ps)
88
+
in
89
+
let url = base_url ^ path ^ query in
90
+
let resp = Requests.get cfg.session url ~headers:(auth_headers cfg) in
91
+
let status = Requests.Response.status_code resp in
92
+
let text = Requests.Response.text resp in
93
+
if status >= 400 then begin
94
+
let err =
95
+
match Jsont_bytesrw.decode_string error_wrapper_jsont text with
96
+
| Ok e -> { e with status }
97
+
| Error _ -> { error_type = "api_error"; message = text;
98
+
code = ""; status }
99
+
in
100
+
raise (Stripe_error err)
101
+
end;
102
+
text
103
+
104
+
let delete cfg path =
105
+
let url = base_url ^ path in
106
+
let resp = Requests.delete cfg.session url ~headers:(auth_headers cfg) in
107
+
let status = Requests.Response.status_code resp in
108
+
let text = Requests.Response.text resp in
109
+
if status >= 400 then begin
110
+
let err =
111
+
match Jsont_bytesrw.decode_string error_wrapper_jsont text with
112
+
| Ok e -> { e with status }
113
+
| Error _ -> { error_type = "api_error"; message = text;
114
+
code = ""; status }
115
+
in
116
+
raise (Stripe_error err)
117
+
end;
118
+
text
119
+
120
+
let decode jsont text =
121
+
match Jsont_bytesrw.decode_string jsont text with
122
+
| Ok v -> v
123
+
| Error e -> failwith (Format.asprintf "Stripe JSON decode: %s" e)
124
+
125
+
let list_jsont item_jsont =
126
+
Jsont.Object.map (fun data has_more -> (data, has_more))
127
+
|> Jsont.Object.mem "data" (Jsont.list item_jsont)
128
+
~enc:(fun (d, _) -> d)
129
+
|> Jsont.Object.mem "has_more" Jsont.bool
130
+
~enc:(fun (_, h) -> h)
131
+
|> Jsont.Object.finish
132
+
133
+
(* {1 Customers} *)
134
+
135
+
module Customer = struct
136
+
type t = {
137
+
id : string;
138
+
email : string;
139
+
name : string;
140
+
metadata : metadata;
141
+
created : int;
142
+
}
143
+
144
+
let pp ppf c =
145
+
Format.fprintf ppf "customer(%s, %s, %s)" c.id c.email c.name
146
+
147
+
let jsont =
148
+
Jsont.Object.map (fun id email name metadata created ->
149
+
{ id; email; name; metadata; created })
150
+
|> Jsont.Object.mem "id" Jsont.string ~enc:(fun c -> c.id)
151
+
|> Jsont.Object.mem "email" Jsont.string ~dec_absent:""
152
+
~enc:(fun c -> c.email)
153
+
|> Jsont.Object.mem "name" Jsont.string ~dec_absent:""
154
+
~enc:(fun c -> c.name)
155
+
|> Jsont.Object.mem "metadata" metadata_jsont ~dec_absent:[]
156
+
~enc:(fun c -> c.metadata)
157
+
|> Jsont.Object.mem "created" Jsont.int ~dec_absent:0
158
+
~enc:(fun c -> c.created)
159
+
|> Jsont.Object.finish
160
+
161
+
let create cfg ~email ?name ?metadata () =
162
+
let body =
163
+
[ ("email", email) ]
164
+
@ (match name with Some n -> [ ("name", n) ] | None -> [])
165
+
@ (match metadata with
166
+
| Some md ->
167
+
List.map (fun (k, v) ->
168
+
(Printf.sprintf "metadata[%s]" k, v)) md
169
+
| None -> [])
170
+
in
171
+
post cfg "/customers" body |> decode jsont
172
+
173
+
let retrieve cfg id =
174
+
get cfg ("/customers/" ^ id) [] |> decode jsont
175
+
176
+
let list cfg ?limit ?starting_after () =
177
+
let params =
178
+
(match limit with Some n -> [ ("limit", string_of_int n) ]
179
+
| None -> [])
180
+
@ (match starting_after with Some s -> [ ("starting_after", s) ]
181
+
| None -> [])
182
+
in
183
+
get cfg "/customers" params |> decode (list_jsont jsont)
184
+
end
185
+
186
+
(* {1 Products} *)
187
+
188
+
module Product = struct
189
+
type t = {
190
+
id : string;
191
+
name : string;
192
+
active : bool;
193
+
metadata : metadata;
194
+
}
195
+
196
+
let pp ppf p =
197
+
Format.fprintf ppf "product(%s, %s)" p.id p.name
198
+
199
+
let jsont =
200
+
Jsont.Object.map (fun id name active metadata ->
201
+
{ id; name; active; metadata })
202
+
|> Jsont.Object.mem "id" Jsont.string ~enc:(fun p -> p.id)
203
+
|> Jsont.Object.mem "name" Jsont.string ~enc:(fun p -> p.name)
204
+
|> Jsont.Object.mem "active" Jsont.bool ~dec_absent:true
205
+
~enc:(fun p -> p.active)
206
+
|> Jsont.Object.mem "metadata" metadata_jsont ~dec_absent:[]
207
+
~enc:(fun p -> p.metadata)
208
+
|> Jsont.Object.finish
209
+
210
+
let create cfg ~name ?metadata () =
211
+
let body =
212
+
[ ("name", name) ]
213
+
@ (match metadata with
214
+
| Some md ->
215
+
List.map (fun (k, v) ->
216
+
(Printf.sprintf "metadata[%s]" k, v)) md
217
+
| None -> [])
218
+
in
219
+
post cfg "/products" body |> decode jsont
220
+
221
+
let retrieve cfg id =
222
+
get cfg ("/products/" ^ id) [] |> decode jsont
223
+
end
224
+
225
+
(* {1 Prices} *)
226
+
227
+
module Price = struct
228
+
type recurring = {
229
+
interval : string;
230
+
interval_count : int;
231
+
}
232
+
233
+
let recurring_jsont =
234
+
Jsont.Object.map (fun interval interval_count ->
235
+
{ interval; interval_count })
236
+
|> Jsont.Object.mem "interval" Jsont.string
237
+
~enc:(fun r -> r.interval)
238
+
|> Jsont.Object.mem "interval_count" Jsont.int ~dec_absent:1
239
+
~enc:(fun r -> r.interval_count)
240
+
|> Jsont.Object.finish
241
+
242
+
type t = {
243
+
id : string;
244
+
product : string;
245
+
unit_amount : int;
246
+
currency : string;
247
+
recurring : recurring option;
248
+
active : bool;
249
+
}
250
+
251
+
let pp ppf p =
252
+
Format.fprintf ppf "price(%s, %d %s)" p.id p.unit_amount p.currency
253
+
254
+
let jsont =
255
+
Jsont.Object.map (fun id product unit_amount currency recurring active ->
256
+
{ id; product; unit_amount; currency; recurring; active })
257
+
|> Jsont.Object.mem "id" Jsont.string ~enc:(fun p -> p.id)
258
+
|> Jsont.Object.mem "product" Jsont.string ~enc:(fun p -> p.product)
259
+
|> Jsont.Object.mem "unit_amount" Jsont.int ~dec_absent:0
260
+
~enc:(fun p -> p.unit_amount)
261
+
|> Jsont.Object.mem "currency" Jsont.string ~enc:(fun p -> p.currency)
262
+
|> Jsont.Object.mem "recurring" (Jsont.option recurring_jsont)
263
+
~dec_absent:None ~enc:(fun p -> p.recurring)
264
+
|> Jsont.Object.mem "active" Jsont.bool ~dec_absent:true
265
+
~enc:(fun p -> p.active)
266
+
|> Jsont.Object.finish
267
+
268
+
let create cfg ~product ~unit_amount ~currency ?interval
269
+
?interval_count () =
270
+
let body =
271
+
[ ("product", product);
272
+
("unit_amount", string_of_int unit_amount);
273
+
("currency", currency) ]
274
+
@ (match interval with
275
+
| Some i ->
276
+
[ ("recurring[interval]", i);
277
+
("recurring[interval_count]",
278
+
string_of_int (Option.value ~default:1 interval_count)) ]
279
+
| None -> [])
280
+
in
281
+
post cfg "/prices" body |> decode jsont
282
+
end
283
+
284
+
(* {1 Subscriptions} *)
285
+
286
+
module Subscription = struct
287
+
type t = {
288
+
id : string;
289
+
customer : string;
290
+
status : string;
291
+
current_period_start : int;
292
+
current_period_end : int;
293
+
cancel_at_period_end : bool;
294
+
metadata : metadata;
295
+
}
296
+
297
+
let pp ppf s =
298
+
Format.fprintf ppf "subscription(%s, %s, %s)" s.id s.customer s.status
299
+
300
+
let jsont =
301
+
Jsont.Object.map (fun id customer status current_period_start
302
+
current_period_end cancel_at_period_end metadata ->
303
+
{ id; customer; status; current_period_start; current_period_end;
304
+
cancel_at_period_end; metadata })
305
+
|> Jsont.Object.mem "id" Jsont.string ~enc:(fun s -> s.id)
306
+
|> Jsont.Object.mem "customer" Jsont.string ~enc:(fun s -> s.customer)
307
+
|> Jsont.Object.mem "status" Jsont.string ~enc:(fun s -> s.status)
308
+
|> Jsont.Object.mem "current_period_start" Jsont.int ~dec_absent:0
309
+
~enc:(fun s -> s.current_period_start)
310
+
|> Jsont.Object.mem "current_period_end" Jsont.int ~dec_absent:0
311
+
~enc:(fun s -> s.current_period_end)
312
+
|> Jsont.Object.mem "cancel_at_period_end" Jsont.bool ~dec_absent:false
313
+
~enc:(fun s -> s.cancel_at_period_end)
314
+
|> Jsont.Object.mem "metadata" metadata_jsont ~dec_absent:[]
315
+
~enc:(fun s -> s.metadata)
316
+
|> Jsont.Object.finish
317
+
318
+
let create cfg ~customer ~price ?metadata () =
319
+
let body =
320
+
[ ("customer", customer);
321
+
("items[0][price]", price) ]
322
+
@ (match metadata with
323
+
| Some md ->
324
+
List.map (fun (k, v) ->
325
+
(Printf.sprintf "metadata[%s]" k, v)) md
326
+
| None -> [])
327
+
in
328
+
post cfg "/subscriptions" body |> decode jsont
329
+
330
+
let retrieve cfg id =
331
+
get cfg ("/subscriptions/" ^ id) [] |> decode jsont
332
+
333
+
let cancel cfg id =
334
+
post cfg ("/subscriptions/" ^ id)
335
+
[ ("cancel_at_period_end", "true") ]
336
+
|> decode jsont
337
+
end
338
+
339
+
(* {1 Checkout Sessions} *)
340
+
341
+
module Checkout = struct
342
+
type t = {
343
+
id : string;
344
+
url : string;
345
+
customer : string;
346
+
subscription : string;
347
+
status : string;
348
+
}
349
+
350
+
let pp ppf c =
351
+
Format.fprintf ppf "checkout(%s, %s)" c.id c.status
352
+
353
+
let jsont =
354
+
Jsont.Object.map (fun id url customer subscription status ->
355
+
{ id; url; customer; subscription; status })
356
+
|> Jsont.Object.mem "id" Jsont.string ~enc:(fun c -> c.id)
357
+
|> Jsont.Object.mem "url" Jsont.string ~dec_absent:""
358
+
~enc:(fun c -> c.url)
359
+
|> Jsont.Object.mem "customer" Jsont.string ~dec_absent:""
360
+
~enc:(fun c -> c.customer)
361
+
|> Jsont.Object.mem "subscription" Jsont.string ~dec_absent:""
362
+
~enc:(fun c -> c.subscription)
363
+
|> Jsont.Object.mem "status" Jsont.string ~dec_absent:""
364
+
~enc:(fun c -> c.status)
365
+
|> Jsont.Object.finish
366
+
367
+
let create cfg ~customer ~price ~success_url ~cancel_url () =
368
+
let body =
369
+
[ ("customer", customer);
370
+
("mode", "subscription");
371
+
("line_items[0][price]", price);
372
+
("line_items[0][quantity]", "1");
373
+
("success_url", success_url);
374
+
("cancel_url", cancel_url) ]
375
+
in
376
+
post cfg "/checkout/sessions" body |> decode jsont
377
+
end
378
+
379
+
(* {1 Billing Portal} *)
380
+
381
+
module Portal = struct
382
+
type t = {
383
+
id : string;
384
+
url : string;
385
+
}
386
+
387
+
let pp ppf p =
388
+
Format.fprintf ppf "portal(%s)" p.id
389
+
390
+
let jsont =
391
+
Jsont.Object.map (fun id url -> { id; url })
392
+
|> Jsont.Object.mem "id" Jsont.string ~enc:(fun p -> p.id)
393
+
|> Jsont.Object.mem "url" Jsont.string ~enc:(fun p -> p.url)
394
+
|> Jsont.Object.finish
395
+
396
+
let create cfg ~customer ~return_url =
397
+
let body =
398
+
[ ("customer", customer);
399
+
("return_url", return_url) ]
400
+
in
401
+
post cfg "/billing_portal/sessions" body |> decode jsont
402
+
end
403
+
404
+
(* {1 Webhooks} *)
405
+
406
+
module Webhook = struct
407
+
type event = {
408
+
id : string;
409
+
event_type : string;
410
+
created : int;
411
+
data : Jsont.json;
412
+
}
413
+
414
+
let pp_event ppf e =
415
+
Format.fprintf ppf "event(%s, %s)" e.id e.event_type
416
+
417
+
let event_jsont =
418
+
Jsont.Object.map (fun id event_type created data ->
419
+
{ id; event_type; created; data })
420
+
|> Jsont.Object.mem "id" Jsont.string ~enc:(fun e -> e.id)
421
+
|> Jsont.Object.mem "type" Jsont.string ~enc:(fun e -> e.event_type)
422
+
|> Jsont.Object.mem "created" Jsont.int ~dec_absent:0
423
+
~enc:(fun e -> e.created)
424
+
|> Jsont.Object.mem "data" Jsont.json ~enc:(fun e -> e.data)
425
+
|> Jsont.Object.finish
426
+
427
+
(* Stripe webhook signature verification.
428
+
Header format: t=<timestamp>,v1=<sig1>,v1=<sig2>,...
429
+
Signed payload: <timestamp>.<body>
430
+
Signature: HMAC-SHA256(secret, signed_payload) *)
431
+
432
+
let compute_hmac ~secret ~payload =
433
+
Digestif.SHA256.hmac_string ~key:secret payload
434
+
|> Digestif.SHA256.to_hex
435
+
436
+
let parse_signature_header sig_header =
437
+
let parts = String.split_on_char ',' sig_header in
438
+
let timestamp = ref None in
439
+
let signatures = ref [] in
440
+
List.iter (fun part ->
441
+
match String.split_on_char '=' part with
442
+
| ["t"; v] -> timestamp := Some v
443
+
| ["v1"; v] -> signatures := v :: !signatures
444
+
| _ -> ())
445
+
parts;
446
+
(!timestamp, List.rev !signatures)
447
+
448
+
let tolerance_seconds = 300 (* 5 minutes *)
449
+
450
+
let verify_signature ~secret ~payload ~signature =
451
+
match parse_signature_header signature with
452
+
| None, _ -> Error "missing timestamp in Stripe-Signature header"
453
+
| Some ts, sigs ->
454
+
let signed_payload = ts ^ "." ^ payload in
455
+
let expected = compute_hmac ~secret ~payload:signed_payload in
456
+
if List.exists (fun s -> String.equal s expected) sigs then begin
457
+
match int_of_string_opt ts with
458
+
| None -> Error "invalid timestamp"
459
+
| Some t ->
460
+
let now = int_of_float (Unix.gettimeofday ()) in
461
+
if abs (now - t) > tolerance_seconds then
462
+
Error (Printf.sprintf "timestamp too old (%ds)" (abs (now - t)))
463
+
else
464
+
decode event_jsont payload |> Result.ok
465
+
end
466
+
else
467
+
Error "signature mismatch"
468
+
end
+193
lib/stripe.mli
+193
lib/stripe.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2026 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Stripe API client for SaaS billing.
7
+
8
+
Covers the subset needed for subscription billing: customers, products,
9
+
prices, subscriptions, checkout sessions, billing portal, and webhooks.
10
+
11
+
{b Authentication}: uses Stripe secret API keys via [Authorization: Bearer sk_...].
12
+
13
+
{b Base URL}: [https://api.stripe.com/v1]
14
+
15
+
@see <https://docs.stripe.com/api> Stripe API Reference *)
16
+
17
+
(** {1 Configuration} *)
18
+
19
+
type config
20
+
(** Stripe API configuration (API key + HTTP session). *)
21
+
22
+
val config : secret_key:string -> Requests.t -> config
23
+
(** [config ~secret_key session] creates a Stripe configuration. *)
24
+
25
+
(** {1 Common Types} *)
26
+
27
+
type metadata = (string * string) list
28
+
(** Key-value metadata attached to Stripe objects. *)
29
+
30
+
(** {1 Customers} *)
31
+
32
+
module Customer : sig
33
+
type t = {
34
+
id : string;
35
+
email : string;
36
+
name : string;
37
+
metadata : metadata;
38
+
created : int;
39
+
}
40
+
41
+
val pp : t Fmt.t
42
+
val jsont : t Jsont.t
43
+
44
+
val create : config -> email:string -> ?name:string ->
45
+
?metadata:metadata -> unit -> t
46
+
(** Create a customer. *)
47
+
48
+
val retrieve : config -> string -> t
49
+
(** [retrieve config customer_id] fetches a customer. *)
50
+
51
+
val list : config -> ?limit:int -> ?starting_after:string -> unit ->
52
+
t list * bool
53
+
(** [list config ()] returns [(customers, has_more)]. *)
54
+
end
55
+
56
+
(** {1 Products} *)
57
+
58
+
module Product : sig
59
+
type t = {
60
+
id : string;
61
+
name : string;
62
+
active : bool;
63
+
metadata : metadata;
64
+
}
65
+
66
+
val pp : t Fmt.t
67
+
val jsont : t Jsont.t
68
+
69
+
val create : config -> name:string -> ?metadata:metadata -> unit -> t
70
+
val retrieve : config -> string -> t
71
+
end
72
+
73
+
(** {1 Prices} *)
74
+
75
+
module Price : sig
76
+
type recurring = {
77
+
interval : string; (** "month", "year" *)
78
+
interval_count : int;
79
+
}
80
+
81
+
type t = {
82
+
id : string;
83
+
product : string;
84
+
unit_amount : int; (** Amount in cents. *)
85
+
currency : string;
86
+
recurring : recurring option;
87
+
active : bool;
88
+
}
89
+
90
+
val pp : t Fmt.t
91
+
val jsont : t Jsont.t
92
+
93
+
val create : config -> product:string -> unit_amount:int ->
94
+
currency:string -> ?interval:string -> ?interval_count:int ->
95
+
unit -> t
96
+
end
97
+
98
+
(** {1 Subscriptions} *)
99
+
100
+
module Subscription : sig
101
+
type t = {
102
+
id : string;
103
+
customer : string;
104
+
status : string; (** "active", "past_due", "canceled", etc. *)
105
+
current_period_start : int;
106
+
current_period_end : int;
107
+
cancel_at_period_end : bool;
108
+
metadata : metadata;
109
+
}
110
+
111
+
val pp : t Fmt.t
112
+
val jsont : t Jsont.t
113
+
114
+
val create : config -> customer:string -> price:string ->
115
+
?metadata:metadata -> unit -> t
116
+
117
+
val retrieve : config -> string -> t
118
+
119
+
val cancel : config -> string -> t
120
+
(** Cancel at period end. *)
121
+
end
122
+
123
+
(** {1 Checkout Sessions} *)
124
+
125
+
module Checkout : sig
126
+
type t = {
127
+
id : string;
128
+
url : string; (** URL to redirect customer to. *)
129
+
customer : string;
130
+
subscription : string;
131
+
status : string;
132
+
}
133
+
134
+
val pp : t Fmt.t
135
+
val jsont : t Jsont.t
136
+
137
+
val create : config -> customer:string -> price:string ->
138
+
success_url:string -> cancel_url:string -> unit -> t
139
+
(** Create a checkout session for a subscription. *)
140
+
end
141
+
142
+
(** {1 Billing Portal} *)
143
+
144
+
module Portal : sig
145
+
type t = {
146
+
id : string;
147
+
url : string;
148
+
}
149
+
150
+
val pp : t Fmt.t
151
+
val jsont : t Jsont.t
152
+
153
+
val create : config -> customer:string -> return_url:string -> t
154
+
(** Create a billing portal session for self-service management. *)
155
+
end
156
+
157
+
(** {1 Webhooks} *)
158
+
159
+
module Webhook : sig
160
+
type event = {
161
+
id : string;
162
+
event_type : string; (** e.g. "customer.subscription.updated" *)
163
+
created : int;
164
+
data : Jsont.json; (** Raw JSON of the event data object. *)
165
+
}
166
+
167
+
val pp_event : event Fmt.t
168
+
val event_jsont : event Jsont.t
169
+
170
+
val verify_signature : secret:string -> payload:string ->
171
+
signature:string -> (event, string) result
172
+
(** [verify_signature ~secret ~payload ~signature] verifies the webhook
173
+
signature header ([Stripe-Signature]) and returns the parsed event.
174
+
175
+
Uses HMAC-SHA256 with the webhook endpoint secret. Checks the [t]
176
+
(timestamp) component against a 5-minute tolerance.
177
+
178
+
@see <https://docs.stripe.com/webhooks/signatures> *)
179
+
end
180
+
181
+
(** {1 Errors} *)
182
+
183
+
type error = {
184
+
error_type : string;
185
+
message : string;
186
+
code : string;
187
+
status : int;
188
+
}
189
+
190
+
val pp_error : error Fmt.t
191
+
192
+
exception Stripe_error of error
193
+
(** Raised on API errors (4xx/5xx responses). *)
+36
stripe.opam
+36
stripe.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "Stripe API client for OCaml"
4
+
description:
5
+
"Minimal Stripe API client for SaaS billing: customers, products, prices, subscriptions, checkout sessions, and webhook verification. Uses ocaml-requests for HTTP and jsont for JSON codec."
6
+
maintainer: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
7
+
authors: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
8
+
license: "MIT"
9
+
homepage: "https://tangled.org/gazagnaire.org/ocaml-stripe"
10
+
bug-reports: "https://tangled.org/gazagnaire.org/ocaml-stripe/issues"
11
+
depends: [
12
+
"dune" {>= "3.21"}
13
+
"ocaml" {>= "4.14"}
14
+
"requests" {>= "0.1"}
15
+
"jsont" {>= "0.1"}
16
+
"jsont-bytesrw" {>= "0.1"}
17
+
"digestif" {>= "1.0"}
18
+
"alcotest" {with-test}
19
+
"odoc" {with-doc}
20
+
]
21
+
build: [
22
+
["dune" "subst"] {dev}
23
+
[
24
+
"dune"
25
+
"build"
26
+
"-p"
27
+
name
28
+
"-j"
29
+
jobs
30
+
"@install"
31
+
"@runtest" {with-test}
32
+
"@doc" {with-doc}
33
+
]
34
+
]
35
+
dev-repo: "git+https://tangled.org/gazagnaire.org/ocaml-stripe"
36
+
x-maintenance-intent: ["(latest)"]
+1
test/test.ml
+1
test/test.ml
···
1
+
let () = Alcotest.run "stripe" [ Test_stripe.suite ]
+202
test/test_stripe.ml
+202
test/test_stripe.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2026 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(* {1 Webhook signature tests}
7
+
8
+
Test vectors derived from Stripe's webhook signature documentation:
9
+
https://docs.stripe.com/webhooks/signatures
10
+
11
+
Signature format: t=<timestamp>,v1=<hex(HMAC-SHA256(secret, "<timestamp>.<payload>"))>
12
+
*)
13
+
14
+
let webhook_secret = "whsec_test_secret_key_for_testing"
15
+
16
+
let sample_event_json =
17
+
{|{"id":"evt_test_123","type":"customer.subscription.updated","created":1735732800,"data":{"object":{"id":"sub_test_456","status":"active"}}}|}
18
+
19
+
let make_signature ~secret ~timestamp ~payload =
20
+
let signed_payload = Printf.sprintf "%d.%s" timestamp payload in
21
+
let sig_hex =
22
+
Digestif.SHA256.hmac_string ~key:secret signed_payload
23
+
|> Digestif.SHA256.to_hex
24
+
in
25
+
Printf.sprintf "t=%d,v1=%s" timestamp sig_hex
26
+
27
+
(* Valid signature should parse correctly *)
28
+
let valid_signature () =
29
+
let timestamp = int_of_float (Unix.gettimeofday ()) in
30
+
let sig_header =
31
+
make_signature ~secret:webhook_secret ~timestamp
32
+
~payload:sample_event_json
33
+
in
34
+
match
35
+
Stripe.Webhook.verify_signature ~secret:webhook_secret
36
+
~payload:sample_event_json ~signature:sig_header
37
+
with
38
+
| 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
43
+
| Error e -> Alcotest.fail (Printf.sprintf "verification failed: %s" e)
44
+
45
+
(* Wrong secret should fail *)
46
+
let wrong_secret () =
47
+
let timestamp = int_of_float (Unix.gettimeofday ()) in
48
+
let sig_header =
49
+
make_signature ~secret:"whsec_wrong_key" ~timestamp
50
+
~payload:sample_event_json
51
+
in
52
+
match
53
+
Stripe.Webhook.verify_signature ~secret:webhook_secret
54
+
~payload:sample_event_json ~signature:sig_header
55
+
with
56
+
| Ok _ -> Alcotest.fail "should have rejected wrong secret"
57
+
| Error msg ->
58
+
Alcotest.(check bool) "signature mismatch"
59
+
true (String.equal msg "signature mismatch")
60
+
61
+
(* Tampered payload should fail *)
62
+
let tampered_payload () =
63
+
let timestamp = int_of_float (Unix.gettimeofday ()) in
64
+
let sig_header =
65
+
make_signature ~secret:webhook_secret ~timestamp
66
+
~payload:sample_event_json
67
+
in
68
+
match
69
+
Stripe.Webhook.verify_signature ~secret:webhook_secret
70
+
~payload:(sample_event_json ^ "tampered") ~signature:sig_header
71
+
with
72
+
| Ok _ -> Alcotest.fail "should have rejected tampered payload"
73
+
| Error msg ->
74
+
Alcotest.(check bool) "signature mismatch"
75
+
true (String.equal msg "signature mismatch")
76
+
77
+
(* Old timestamp should fail *)
78
+
let old_timestamp () =
79
+
let old_timestamp = int_of_float (Unix.gettimeofday ()) - 600 in
80
+
let sig_header =
81
+
make_signature ~secret:webhook_secret ~timestamp:old_timestamp
82
+
~payload:sample_event_json
83
+
in
84
+
match
85
+
Stripe.Webhook.verify_signature ~secret:webhook_secret
86
+
~payload:sample_event_json ~signature:sig_header
87
+
with
88
+
| Ok _ -> Alcotest.fail "should have rejected old timestamp"
89
+
| Error msg ->
90
+
Alcotest.(check bool) "timestamp too old"
91
+
true (String.length msg > 0)
92
+
93
+
(* Missing timestamp in header *)
94
+
let missing_timestamp () =
95
+
match
96
+
Stripe.Webhook.verify_signature ~secret:webhook_secret
97
+
~payload:sample_event_json ~signature:"v1=abc123"
98
+
with
99
+
| Ok _ -> Alcotest.fail "should have rejected missing timestamp"
100
+
| Error _ -> ()
101
+
102
+
(* Multiple v1 signatures (Stripe sends multiple during key rotation) *)
103
+
let multiple_signatures () =
104
+
let timestamp = int_of_float (Unix.gettimeofday ()) in
105
+
let valid_sig =
106
+
let signed = Printf.sprintf "%d.%s" timestamp sample_event_json in
107
+
Digestif.SHA256.hmac_string ~key:webhook_secret signed
108
+
|> Digestif.SHA256.to_hex
109
+
in
110
+
let sig_header =
111
+
Printf.sprintf "t=%d,v1=invalid_old_sig,v1=%s" timestamp valid_sig
112
+
in
113
+
match
114
+
Stripe.Webhook.verify_signature ~secret:webhook_secret
115
+
~payload:sample_event_json ~signature:sig_header
116
+
with
117
+
| Ok event ->
118
+
Alcotest.(check string) "event id" "evt_test_123" event.id
119
+
| Error e -> Alcotest.fail (Printf.sprintf "should accept any valid v1: %s" e)
120
+
121
+
(* {1 JSON codec tests} *)
122
+
123
+
let customer_json =
124
+
{|{"id":"cus_test_123","email":"test@example.com","name":"Test User","metadata":{"plan":"pro"},"created":1735732800,"object":"customer"}|}
125
+
126
+
let customer_roundtrip () =
127
+
match Jsont_bytesrw.decode_string Stripe.Customer.jsont customer_json with
128
+
| Error e -> Alcotest.fail (Printf.sprintf "decode: %s" e)
129
+
| 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 (List.assoc_opt "plan" c.metadata = Some "pro")
136
+
137
+
let subscription_json =
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"}|}
139
+
140
+
let subscription_roundtrip () =
141
+
match Jsont_bytesrw.decode_string Stripe.Subscription.jsont subscription_json with
142
+
| Error e -> Alcotest.fail (Printf.sprintf "decode: %s" e)
143
+
| 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
148
+
149
+
let price_json =
150
+
{|{"id":"price_test_789","product":"prod_test_abc","unit_amount":500000,"currency":"usd","recurring":{"interval":"year","interval_count":1},"active":true,"object":"price"}|}
151
+
152
+
let price_roundtrip () =
153
+
match Jsont_bytesrw.decode_string Stripe.Price.jsont price_json with
154
+
| 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)
165
+
166
+
let product_json =
167
+
{|{"id":"prod_test_abc","name":"SSA Pro","active":true,"metadata":{"tier":"pro"},"object":"product"}|}
168
+
169
+
let product_roundtrip () =
170
+
match Jsont_bytesrw.decode_string Stripe.Product.jsont product_json with
171
+
| Error e -> Alcotest.fail (Printf.sprintf "decode: %s" e)
172
+
| 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
176
+
177
+
let checkout_json =
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"}|}
179
+
180
+
let checkout_roundtrip () =
181
+
match Jsont_bytesrw.decode_string Stripe.Checkout.jsont checkout_json with
182
+
| Error e -> Alcotest.fail (Printf.sprintf "decode: %s" e)
183
+
| 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
187
+
188
+
let suite =
189
+
( "stripe",
190
+
[
191
+
Alcotest.test_case "webhook valid" `Quick valid_signature;
192
+
Alcotest.test_case "webhook wrong secret" `Quick wrong_secret;
193
+
Alcotest.test_case "webhook tampered" `Quick tampered_payload;
194
+
Alcotest.test_case "webhook old timestamp" `Quick old_timestamp;
195
+
Alcotest.test_case "webhook missing timestamp" `Quick missing_timestamp;
196
+
Alcotest.test_case "webhook multiple sigs" `Quick multiple_signatures;
197
+
Alcotest.test_case "customer json" `Quick customer_roundtrip;
198
+
Alcotest.test_case "subscription json" `Quick subscription_roundtrip;
199
+
Alcotest.test_case "price json" `Quick price_roundtrip;
200
+
Alcotest.test_case "product json" `Quick product_roundtrip;
201
+
Alcotest.test_case "checkout json" `Quick checkout_roundtrip;
202
+
] )