anil.recoil.org
JSON web tokens in OCaml
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6(** JSON Web Token (JWT) - RFC 7519
7
8 This module implements JSON Web Tokens as specified in
9 {{:https://datatracker.ietf.org/doc/html/rfc7519}RFC 7519}.
10
11 JWTs are compact, URL-safe means of representing claims to be transferred
12 between two parties. The claims are encoded as a JSON object that is used as
13 the payload of a JSON Web Signature (JWS) structure, enabling the claims to
14 be digitally signed or integrity protected with a Message Authentication
15 Code (MAC).
16
17 {2 References}
18 - {{:https://datatracker.ietf.org/doc/html/rfc7519}RFC 7519} - JSON Web
19 Token (JWT)
20 - {{:https://datatracker.ietf.org/doc/html/rfc7515}RFC 7515} - JSON Web
21 Signature (JWS)
22 - {{:https://datatracker.ietf.org/doc/html/rfc7517}RFC 7517} - JSON Web Key
23 (JWK)
24 - {{:https://datatracker.ietf.org/doc/html/rfc7518}RFC 7518} - JSON Web
25 Algorithms (JWA) *)
26
27(** {1 Error Handling} *)
28
29type error =
30 | Invalid_json of string (** JSON parsing failed *)
31 | Invalid_base64url of string (** Base64url decoding failed *)
32 | Invalid_structure of string
33 (** Wrong number of parts or malformed structure *)
34 | Invalid_header of string (** Header validation failed *)
35 | Invalid_claims of string (** Claims validation failed *)
36 | Invalid_uri of string
37 (** StringOrURI validation failed per
38 {{:https://datatracker.ietf.org/doc/html/rfc7519#section-2}RFC 7519
39 Section 2} *)
40 | Duplicate_claim of string
41 (** Duplicate claim name found in strict mode per
42 {{:https://datatracker.ietf.org/doc/html/rfc7519#section-4}RFC 7519
43 Section 4} *)
44 | Unsupported_algorithm of string (** Unknown algorithm identifier *)
45 | Algorithm_not_allowed of string
46 (** Algorithm rejected by allowed_algs policy *)
47 | Signature_mismatch (** Signature verification failed *)
48 | Token_expired
49 (** exp claim validation failed per
50 {{:https://datatracker.ietf.org/doc/html/rfc7519#section-4.1.4}RFC
51 7519 Section 4.1.4} *)
52 | Token_not_yet_valid
53 (** nbf claim validation failed per
54 {{:https://datatracker.ietf.org/doc/html/rfc7519#section-4.1.5}RFC
55 7519 Section 4.1.5} *)
56 | Invalid_issuer
57 (** iss claim mismatch per
58 {{:https://datatracker.ietf.org/doc/html/rfc7519#section-4.1.1}RFC
59 7519 Section 4.1.1} *)
60 | Invalid_audience
61 (** aud claim mismatch per
62 {{:https://datatracker.ietf.org/doc/html/rfc7519#section-4.1.3}RFC
63 7519 Section 4.1.3} *)
64 | Key_type_mismatch of string (** Key doesn't match algorithm *)
65 | Unsecured_not_allowed
66 (** alg:none used without explicit opt-in per
67 {{:https://datatracker.ietf.org/doc/html/rfc7519#section-6}RFC 7519
68 Section 6} *)
69 | Nesting_too_deep (** Nested JWT exceeds max_depth *)
70
71val pp_error : Format.formatter -> error -> unit
72(** Pretty-print an error. *)
73
74val error_to_string : error -> string
75(** Convert error to human-readable string. *)
76
77(** {1 Algorithms}
78
79 Signature and MAC algorithms for JWT. See
80 {{:https://datatracker.ietf.org/doc/html/rfc7518#section-3}RFC 7518 Section
81 3}. *)
82
83module Algorithm : sig
84 type t =
85 | None
86 (** No digital signature or MAC per
87 {{:https://datatracker.ietf.org/doc/html/rfc7518#section-3.6}RFC
88 7518 Section 3.6} *)
89 | HS256
90 (** HMAC using SHA-256 per
91 {{:https://datatracker.ietf.org/doc/html/rfc7518#section-3.2}RFC
92 7518 Section 3.2} *)
93 | HS384 (** HMAC using SHA-384 *)
94 | HS512 (** HMAC using SHA-512 *)
95 | RS256
96 (** RSASSA-PKCS1-v1_5 using SHA-256 per
97 {{:https://datatracker.ietf.org/doc/html/rfc7518#section-3.3}RFC
98 7518 Section 3.3} *)
99 | RS384 (** RSASSA-PKCS1-v1_5 using SHA-384 *)
100 | RS512 (** RSASSA-PKCS1-v1_5 using SHA-512 *)
101 | ES256
102 (** ECDSA using P-256 and SHA-256 per
103 {{:https://datatracker.ietf.org/doc/html/rfc7518#section-3.4}RFC
104 7518 Section 3.4} *)
105 | ES384 (** ECDSA using P-384 and SHA-384 *)
106 | ES512 (** ECDSA using P-521 and SHA-512 *)
107 | EdDSA
108 (** EdDSA using Ed25519 per
109 {{:https://datatracker.ietf.org/doc/html/rfc8037}RFC 8037} *)
110
111 val to_string : t -> string
112 (** Convert algorithm to JWA identifier string. *)
113
114 val of_string : string -> (t, error) result
115 (** Parse algorithm from JWA identifier string. *)
116
117 val all : t list
118 (** All supported algorithms (excluding None). *)
119
120 val all_with_none : t list
121 (** All supported algorithms (including None). *)
122end
123
124(** {1 JSON Web Key}
125
126 Key representation for JWT signature verification. See
127 {{:https://datatracker.ietf.org/doc/html/rfc7517}RFC 7517}. *)
128
129module Jwk : sig
130 (** Key type per
131 {{:https://datatracker.ietf.org/doc/html/rfc7517#section-4.1}RFC 7517
132 Section 4.1}. *)
133 type kty =
134 | Oct (** Octet sequence (symmetric key) *)
135 | Rsa (** RSA key *)
136 | Ec (** Elliptic Curve key *)
137 | Okp (** Octet Key Pair (Ed25519, X25519) *)
138
139 (** Elliptic curve identifiers per
140 {{:https://datatracker.ietf.org/doc/html/rfc7518#section-6.2.1.1}RFC 7518
141 Section 6.2.1.1}. *)
142 type crv =
143 | P256 (** NIST P-256 curve *)
144 | P384 (** NIST P-384 curve *)
145 | P521 (** NIST P-521 curve *)
146 | Ed25519
147 (** Ed25519 curve per
148 {{:https://datatracker.ietf.org/doc/html/rfc8037}RFC 8037} *)
149
150 type t
151 (** A JSON Web Key. *)
152
153 (** {2 Constructors} *)
154
155 val symmetric : string -> t
156 (** [symmetric k] creates a symmetric key from raw bytes. Used for HMAC
157 algorithms (HS256, HS384, HS512). *)
158
159 val ed25519_pub : string -> t
160 (** [ed25519_pub pub] creates an Ed25519 public key from 32-byte public key.
161 *)
162
163 val ed25519_priv : pub:string -> priv:string -> t
164 (** [ed25519_priv ~pub ~priv] creates an Ed25519 private key. *)
165
166 val p256_pub : x:string -> y:string -> t
167 (** [p256_pub ~x ~y] creates a P-256 public key from coordinates. *)
168
169 val p256_priv : x:string -> y:string -> d:string -> t
170 (** [p256_priv ~x ~y ~d] creates a P-256 private key. *)
171
172 val p384_pub : x:string -> y:string -> t
173 (** [p384_pub ~x ~y] creates a P-384 public key from coordinates. *)
174
175 val p384_priv : x:string -> y:string -> d:string -> t
176 (** [p384_priv ~x ~y ~d] creates a P-384 private key. *)
177
178 val p521_pub : x:string -> y:string -> t
179 (** [p521_pub ~x ~y] creates a P-521 public key from coordinates. *)
180
181 val p521_priv : x:string -> y:string -> d:string -> t
182 (** [p521_priv ~x ~y ~d] creates a P-521 private key. *)
183
184 val rsa_pub : n:string -> e:string -> t
185 (** [rsa_pub ~n ~e] creates an RSA public key from modulus and exponent. *)
186
187 val rsa_priv :
188 n:string ->
189 e:string ->
190 d:string ->
191 p:string ->
192 q:string ->
193 dp:string ->
194 dq:string ->
195 qi:string ->
196 t
197 (** [rsa_priv ~n ~e ~d ~p ~q ~dp ~dq ~qi] creates an RSA private key. *)
198
199 (** {2 Accessors} *)
200
201 val kty : t -> kty
202 (** Get the key type. *)
203
204 val kid : t -> string option
205 (** Get the key ID if set. *)
206
207 val alg : t -> Algorithm.t option
208 (** Get the intended algorithm if set. *)
209
210 val with_kid : string -> t -> t
211 (** [with_kid id key] returns key with kid set to [id]. *)
212
213 val with_alg : Algorithm.t -> t -> t
214 (** [with_alg alg key] returns key with alg set to [alg]. *)
215
216 (** {2 Serialization} *)
217
218 val of_json : string -> (t, error) result
219 (** Parse a JWK from JSON string. *)
220
221 val to_json : t -> string
222 (** Serialize a JWK to JSON string. *)
223end
224
225(** {1 JOSE Header}
226
227 The JOSE (JSON Object Signing and Encryption) Header. See
228 {{:https://datatracker.ietf.org/doc/html/rfc7519#section-5}RFC 7519 Section
229 5}. *)
230
231module Header : sig
232 type t = {
233 alg : Algorithm.t; (** Algorithm used (REQUIRED) *)
234 typ : string option;
235 (** Type - RECOMMENDED to be "JWT" per
236 {{:https://datatracker.ietf.org/doc/html/rfc7519#section-5.1}RFC
237 7519 Section 5.1} *)
238 kid : string option; (** Key ID for key lookup *)
239 cty : string option;
240 (** Content type - MUST be "JWT" for nested JWTs per
241 {{:https://datatracker.ietf.org/doc/html/rfc7519#section-5.2}RFC
242 7519 Section 5.2} *)
243 }
244
245 val make : ?typ:string -> ?kid:string -> ?cty:string -> Algorithm.t -> t
246 (** [make ?typ ?kid ?cty alg] creates a JOSE header. *)
247
248 val of_json : string -> (t, error) result
249 (** Parse header from JSON string. *)
250
251 val to_json : t -> string
252 (** Serialize header to JSON string. *)
253
254 val is_nested : t -> bool
255 (** [is_nested h] returns true if [cty] is "JWT" (case-insensitive),
256 indicating a nested JWT. *)
257end
258
259(** {1 Claims}
260
261 JWT Claims Set. See
262 {{:https://datatracker.ietf.org/doc/html/rfc7519#section-4}RFC 7519 Section
263 4}. *)
264
265module Claims : sig
266 type t
267
268 (** {2 Registered Claim Names}
269
270 See
271 {{:https://datatracker.ietf.org/doc/html/rfc7519#section-4.1}RFC 7519
272 Section 4.1}. *)
273
274 val iss : t -> string option
275 (** Issuer claim per
276 {{:https://datatracker.ietf.org/doc/html/rfc7519#section-4.1.1}Section
277 4.1.1}. *)
278
279 val sub : t -> string option
280 (** Subject claim per
281 {{:https://datatracker.ietf.org/doc/html/rfc7519#section-4.1.2}Section
282 4.1.2}. *)
283
284 val aud : t -> string list
285 (** Audience claim per
286 {{:https://datatracker.ietf.org/doc/html/rfc7519#section-4.1.3}Section
287 4.1.3}. Returns empty list if not present. May be single string or array
288 in JWT. *)
289
290 val exp : t -> Ptime.t option
291 (** Expiration time claim per
292 {{:https://datatracker.ietf.org/doc/html/rfc7519#section-4.1.4}Section
293 4.1.4}. *)
294
295 val nbf : t -> Ptime.t option
296 (** Not Before claim per
297 {{:https://datatracker.ietf.org/doc/html/rfc7519#section-4.1.5}Section
298 4.1.5}. *)
299
300 val iat : t -> Ptime.t option
301 (** Issued At claim per
302 {{:https://datatracker.ietf.org/doc/html/rfc7519#section-4.1.6}Section
303 4.1.6}. *)
304
305 val jti : t -> string option
306 (** JWT ID claim per
307 {{:https://datatracker.ietf.org/doc/html/rfc7519#section-4.1.7}Section
308 4.1.7}. *)
309
310 (** {2 Custom Claims}
311
312 For Public and Private claims per
313 {{:https://datatracker.ietf.org/doc/html/rfc7519#section-4.2}Sections 4.2}
314 and {{:https://datatracker.ietf.org/doc/html/rfc7519#section-4.3}4.3}. *)
315
316 val get : string -> t -> Jsont.json option
317 (** [get name claims] returns the value of custom claim [name]. *)
318
319 val get_string : string -> t -> string option
320 (** [get_string name claims] returns the string value of custom claim [name].
321 *)
322
323 val get_int : string -> t -> int option
324 (** [get_int name claims] returns the integer value of custom claim [name]. *)
325
326 val get_bool : string -> t -> bool option
327 (** [get_bool name claims] returns the boolean value of custom claim [name].
328 *)
329
330 (** {2 Construction} *)
331
332 type builder
333 (** Builder for constructing claims. *)
334
335 val empty : builder
336 (** Empty claims builder. *)
337
338 val set_iss : string -> builder -> builder
339 (** Set issuer claim. Value is validated as StringOrURI. *)
340
341 val set_sub : string -> builder -> builder
342 (** Set subject claim. Value is validated as StringOrURI. *)
343
344 val set_aud : string list -> builder -> builder
345 (** Set audience claim. *)
346
347 val set_exp : Ptime.t -> builder -> builder
348 (** Set expiration time claim. *)
349
350 val set_nbf : Ptime.t -> builder -> builder
351 (** Set not-before claim. *)
352
353 val set_iat : Ptime.t -> builder -> builder
354 (** Set issued-at claim. *)
355
356 val set_jti : string -> builder -> builder
357 (** Set JWT ID claim. *)
358
359 val set : string -> Jsont.json -> builder -> builder
360 (** [set name value builder] sets a custom claim. *)
361
362 val set_string : string -> string -> builder -> builder
363 (** Set a custom string claim. *)
364
365 val set_int : string -> int -> builder -> builder
366 (** Set a custom integer claim. *)
367
368 val set_bool : string -> bool -> builder -> builder
369 (** Set a custom boolean claim. *)
370
371 val build : builder -> t
372 (** Build the claims set. *)
373
374 (** {2 Serialization} *)
375
376 val of_json : ?strict:bool -> string -> (t, error) result
377 (** [of_json ?strict json] parses claims from JSON string.
378 @param strict
379 If true (default), reject duplicate claim names per
380 {{:https://datatracker.ietf.org/doc/html/rfc7519#section-4}RFC 7519
381 Section 4}. If false, use lexically last duplicate. *)
382
383 val to_json : t -> string
384 (** Serialize claims to JSON string. *)
385end
386
387(** {1 JWT Token} *)
388
389type t = {
390 header : Header.t; (** JOSE header *)
391 claims : Claims.t; (** Claims set *)
392 signature : string; (** Raw signature bytes *)
393 raw : string; (** Original compact serialization *)
394}
395(** A parsed JWT token. *)
396
397(** {2 Parsing}
398
399 See
400 {{:https://datatracker.ietf.org/doc/html/rfc7519#section-7.2}RFC 7519
401 Section 7.2}. *)
402
403val parse : ?strict:bool -> string -> (t, error) result
404(** [parse ?strict token_string] parses a JWT from its compact serialization.
405
406 This parses the token structure but does NOT verify the signature. Use
407 {!verify} to validate the signature after parsing.
408
409 @param strict If true (default), reject duplicate claim names. *)
410
411val parse_unsafe : string -> (t, error) result
412(** [parse_unsafe token_string] parses a JWT without strict validation.
413 Equivalent to [parse ~strict:false]. *)
414
415(** {2 Nested JWTs}
416
417 See
418 {{:https://datatracker.ietf.org/doc/html/rfc7519#section-7.2}RFC 7519
419 Section 7.2 step 8} and
420 {{:https://datatracker.ietf.org/doc/html/rfc7519#appendix-A.2}Appendix A.2}.
421*)
422
423val parse_nested :
424 ?strict:bool -> ?max_depth:int -> string -> (t list, error) result
425(** [parse_nested ?strict ?max_depth token] parses a potentially nested JWT.
426 Returns a list of JWTs from outermost to innermost.
427 @param max_depth Maximum nesting depth (default 5). *)
428
429val is_nested : t -> bool
430(** [is_nested t] returns true if the JWT has [cty: "JWT"] header, indicating it
431 contains a nested JWT. *)
432
433(** {2 Accessors} *)
434
435val header : t -> Header.t
436(** [header t] returns the JOSE header. *)
437
438val claims : t -> Claims.t
439(** [claims t] returns the claims set. *)
440
441val signature : t -> string
442(** [signature t] returns the raw signature bytes. *)
443
444val raw : t -> string
445(** [raw t] returns the original token string. *)
446
447(** {2 Verification}
448
449 See
450 {{:https://datatracker.ietf.org/doc/html/rfc7519#section-7.2}RFC 7519
451 Section 7.2}. *)
452
453val verify :
454 key:Jwk.t ->
455 ?allow_none:bool ->
456 ?allowed_algs:Algorithm.t list ->
457 t ->
458 (unit, error) result
459(** [verify ~key ?allow_none ?allowed_algs t] verifies the JWT signature.
460
461 @param key The key to verify with (must match algorithm)
462 @param allow_none
463 If true, accept [alg:"none"]. Default: false. Per
464 {{:https://datatracker.ietf.org/doc/html/rfc7519#section-6}RFC 7519
465 Section 6}, unsecured JWTs should only be used when security is provided
466 by other means.
467 @param allowed_algs
468 List of acceptable algorithms. Default: all except none. Note: "none" is
469 only allowed if BOTH in this list AND [allow_none=true]. *)
470
471val validate :
472 now:Ptime.t ->
473 ?iss:string ->
474 ?aud:string ->
475 ?leeway:Ptime.Span.t ->
476 t ->
477 (unit, error) result
478(** [validate ~now ?iss ?aud ?leeway t] validates JWT claims.
479
480 @param now Current time (required, no implicit clock)
481 @param iss Expected issuer (if provided, must match exactly)
482 @param aud Expected audience (if provided, must be in audience list)
483 @param leeway Clock skew tolerance for exp/nbf checks (default 0s) *)
484
485val verify_and_validate :
486 key:Jwk.t ->
487 now:Ptime.t ->
488 ?allow_none:bool ->
489 ?allowed_algs:Algorithm.t list ->
490 ?iss:string ->
491 ?aud:string ->
492 ?leeway:Ptime.Span.t ->
493 t ->
494 (unit, error) result
495(** [verify_and_validate ~key ~now ...] verifies signature and validates claims.
496*)
497
498(** {2 Creation}
499
500 See
501 {{:https://datatracker.ietf.org/doc/html/rfc7519#section-7.1}RFC 7519
502 Section 7.1}. *)
503
504val create :
505 header:Header.t -> claims:Claims.t -> key:Jwk.t -> (t, error) result
506(** [create ~header ~claims ~key] creates and signs a new JWT.
507
508 The [key] must be appropriate for the algorithm specified in [header]. For
509 [alg:none], pass any key (it will be ignored). *)
510
511val encode : t -> string
512(** [encode t] returns the compact serialization of the JWT. *)
513
514(** {1 Utilities} *)
515
516val is_expired : now:Ptime.t -> ?leeway:Ptime.Span.t -> t -> bool
517(** [is_expired ~now ?leeway t] checks if the token has expired. Returns false
518 if no exp claim present. *)
519
520val time_to_expiry : now:Ptime.t -> t -> Ptime.Span.t option
521(** [time_to_expiry ~now t] returns time until expiration, or [None] if no
522 expiration claim or already expired. *)
523
524(** {1 Base64url Utilities}
525
526 Exposed for testing with RFC test vectors. *)
527
528val base64url_encode : string -> string
529(** Base64url encode without padding per
530 {{:https://datatracker.ietf.org/doc/html/rfc7515#appendix-C}RFC 7515
531 Appendix C}. *)
532
533val base64url_decode : string -> (string, error) result
534(** Base64url decode, handling missing padding. *)
535
536(** {1 CBOR Web Token (CWT)}
537
538 See {{:https://datatracker.ietf.org/doc/html/rfc8392}RFC 8392}. *)
539
540module Cwt = Cwt