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(** CBOR Web Token (CWT) - RFC 8392
7
8 This module implements CBOR Web Tokens as specified in
9 {{:https://datatracker.ietf.org/doc/html/rfc8392}RFC 8392}.
10
11 CWTs are the CBOR-based equivalent of JWTs, designed for constrained
12 environments where compact binary representation is important. CWTs use COSE
13 ({{:https://datatracker.ietf.org/doc/html/rfc9052}RFC 9052}) for
14 cryptographic protection.
15
16 {2 Quick Start}
17
18 {[
19 (* Create claims *)
20 let claims =
21 Cwt.Claims.(
22 empty
23 |> set_iss "https://example.com"
24 |> set_sub "user123"
25 |> set_exp
26 (Ptime.add_span (Ptime_clock.now ()) (Ptime.Span.of_int_s 3600)
27 |> Option.get)
28 |> build)
29
30 (* Create a symmetric key *)
31 let key =
32 Cwt.Cose_key.symmetric
33 (Bytes.of_string "my-secret-key-32-bytes-long!!!!!")
34
35 (* Create and encode the CWT *)
36 let cwt =
37 Cwt.create ~algorithm:Cwt.Algorithm.HMAC_256 ~claims ~key
38 |> Result.get_ok
39
40 let encoded = Cwt.encode cwt
41
42 (* Parse and verify *)
43 let parsed = Cwt.parse encoded |> Result.get_ok
44 let () = Cwt.verify ~key parsed |> Result.get_ok
45 ]}
46
47 {2 References}
48 - {{:https://datatracker.ietf.org/doc/html/rfc8392}RFC 8392} - CBOR Web
49 Token (CWT)
50 - {{:https://datatracker.ietf.org/doc/html/rfc9052}RFC 9052} - CBOR Object
51 Signing and Encryption (COSE) Structures
52 - {{:https://datatracker.ietf.org/doc/html/rfc9053}RFC 9053} - CBOR Object
53 Signing and Encryption (COSE) Algorithms
54 - {{:https://datatracker.ietf.org/doc/html/rfc8949}RFC 8949} - Concise
55 Binary Object Representation (CBOR) *)
56
57(** {1 Error Handling} *)
58
59type error =
60 | Invalid_cbor of string (** CBOR parsing failed *)
61 | Invalid_cose of string (** COSE structure validation failed *)
62 | Invalid_claims of string (** Claims validation failed *)
63 | Unsupported_algorithm of string (** Unknown COSE algorithm identifier *)
64 | Algorithm_not_allowed of string
65 (** Algorithm rejected by allowed_algs policy *)
66 | Signature_mismatch (** Signature/MAC verification failed *)
67 | Token_expired
68 (** exp claim validation failed per
69 {{:https://datatracker.ietf.org/doc/html/rfc8392#section-3.1.4}RFC
70 8392 Section 3.1.4} *)
71 | Token_not_yet_valid
72 (** nbf claim validation failed per
73 {{:https://datatracker.ietf.org/doc/html/rfc8392#section-3.1.5}RFC
74 8392 Section 3.1.5} *)
75 | Invalid_issuer
76 (** iss claim mismatch per
77 {{:https://datatracker.ietf.org/doc/html/rfc8392#section-3.1.1}RFC
78 8392 Section 3.1.1} *)
79 | Invalid_audience
80 (** aud claim mismatch per
81 {{:https://datatracker.ietf.org/doc/html/rfc8392#section-3.1.3}RFC
82 8392 Section 3.1.3} *)
83 | Key_type_mismatch of string (** Key doesn't match algorithm *)
84
85val pp_error : Format.formatter -> error -> unit
86(** Pretty-print an error. *)
87
88val error_to_string : error -> string
89(** Convert error to human-readable string. *)
90
91(** {1 COSE Algorithms}
92
93 Cryptographic algorithms for COSE as specified in
94 {{:https://datatracker.ietf.org/doc/html/rfc9053}RFC 9053}.
95
96 Each algorithm has a registered integer identifier in the IANA COSE
97 Algorithms registry. *)
98
99module Algorithm : sig
100 type t =
101 | ES256 (** ECDSA w/ SHA-256, COSE alg = -7 *)
102 | ES384 (** ECDSA w/ SHA-384, COSE alg = -35 *)
103 | ES512 (** ECDSA w/ SHA-512, COSE alg = -36 *)
104 | EdDSA (** EdDSA (Ed25519), COSE alg = -8 *)
105 | HMAC_256_64 (** HMAC w/ SHA-256 truncated to 64 bits, COSE alg = 4 *)
106 | HMAC_256 (** HMAC w/ SHA-256 (256 bits), COSE alg = 5 *)
107 | HMAC_384 (** HMAC w/ SHA-384, COSE alg = 6 *)
108 | HMAC_512 (** HMAC w/ SHA-512, COSE alg = 7 *)
109
110 val to_cose_int : t -> int
111 (** Convert to COSE algorithm identifier (negative for signatures). *)
112
113 val of_cose_int : int -> (t, error) result
114 (** Parse from COSE algorithm identifier. *)
115
116 val to_string : t -> string
117 (** Human-readable name for the algorithm. *)
118
119 val all : t list
120 (** All supported algorithms. *)
121end
122
123(** {1 COSE Key}
124
125 Key representation for COSE operations. See
126 {{:https://datatracker.ietf.org/doc/html/rfc9052#section-7}RFC 9052 Section
127 7} and {{:https://datatracker.ietf.org/doc/html/rfc9053}RFC 9053}. *)
128
129module Cose_key : sig
130 (** Key type per COSE Key Type registry. See
131 {{:https://www.iana.org/assignments/cose/cose.xhtml#key-type}IANA COSE Key
132 Types}. *)
133 type kty =
134 | Okp (** Octet Key Pair (kty = 1), used for EdDSA *)
135 | Ec2 (** Elliptic Curve with x,y coordinates (kty = 2) *)
136 | Symmetric (** Symmetric key (kty = 4) *)
137
138 type t
139 (** A COSE key.
140
141 Supported key types and curves:
142 - Symmetric keys for HMAC algorithms
143 - P-256 (NIST, crv = 1) for ES256
144 - P-384 (NIST, crv = 2) for ES384
145 - P-521 (NIST, crv = 3) for ES512
146 - Ed25519 (crv = 6) for EdDSA *)
147
148 (** {2 Constructors} *)
149
150 val symmetric : string -> t
151 (** [symmetric k] creates a symmetric COSE key from raw bytes. Used for HMAC
152 algorithms. The key should be at least as long as the hash output (32
153 bytes for HMAC_256, etc.). *)
154
155 val ed25519_pub : string -> t
156 (** [ed25519_pub pub] creates an Ed25519 public key from the 32-byte public
157 key value. *)
158
159 val ed25519_priv : pub:string -> priv:string -> t
160 (** [ed25519_priv ~pub ~priv] creates an Ed25519 private key. [pub] is the
161 32-byte public key, [priv] is the 32-byte seed. *)
162
163 val p256_pub : x:string -> y:string -> t
164 (** [p256_pub ~x ~y] creates a P-256 public key from the x and y coordinates
165 (each 32 bytes). *)
166
167 val p256_priv : x:string -> y:string -> d:string -> t
168 (** [p256_priv ~x ~y ~d] creates a P-256 private key. [d] is the 32-byte
169 private key value. *)
170
171 val p384_pub : x:string -> y:string -> t
172 (** [p384_pub ~x ~y] creates a P-384 public key (coordinates are 48 bytes
173 each). *)
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 (coordinates are 66 bytes
180 each). *)
181
182 val p521_priv : x:string -> y:string -> d:string -> t
183 (** [p521_priv ~x ~y ~d] creates a P-521 private key. *)
184
185 (** {2 Accessors} *)
186
187 val kty : t -> kty
188 (** Get the key type. *)
189
190 val kid : t -> string option
191 (** Get the key ID if set (COSE label 2). *)
192
193 val alg : t -> Algorithm.t option
194 (** Get the intended algorithm if set (COSE label 3). *)
195
196 val with_kid : string -> t -> t
197 (** [with_kid id key] returns key with kid set to [id]. *)
198
199 val with_alg : Algorithm.t -> t -> t
200 (** [with_alg alg key] returns key with alg set to [alg]. *)
201
202 (** {2 Serialization} *)
203
204 val of_cbor : string -> (t, error) result
205 (** Parse a COSE key from CBOR bytes. *)
206
207 val to_cbor : t -> string
208 (** Serialize a COSE key to CBOR bytes. *)
209end
210
211(** {1 CWT Claims}
212
213 CWT Claims Set using CBOR integer keys for compactness. See
214 {{:https://datatracker.ietf.org/doc/html/rfc8392#section-3}RFC 8392 Section
215 3}.
216
217 {2 Claim Key Mapping}
218
219 | Claim | Integer Key | Type | |-------|-------------|------| | iss | 1 |
220 text string | | sub | 2 | text string | | aud | 3 | text string | | exp | 4
221 | integer (NumericDate) | | nbf | 5 | integer (NumericDate) | | iat | 6 |
222 integer (NumericDate) | | cti | 7 | byte string | *)
223
224module Claims : sig
225 type t
226
227 (** {2 Registered Claim Names}
228
229 See
230 {{:https://datatracker.ietf.org/doc/html/rfc8392#section-3.1}RFC 8392
231 Section 3.1}. *)
232
233 val iss : t -> string option
234 (** Issuer claim (key 1) per
235 {{:https://datatracker.ietf.org/doc/html/rfc8392#section-3.1.1}Section
236 3.1.1}. *)
237
238 val sub : t -> string option
239 (** Subject claim (key 2) per
240 {{:https://datatracker.ietf.org/doc/html/rfc8392#section-3.1.2}Section
241 3.1.2}. *)
242
243 val aud : t -> string list
244 (** Audience claim (key 3) per
245 {{:https://datatracker.ietf.org/doc/html/rfc8392#section-3.1.3}Section
246 3.1.3}. Returns empty list if not present. May be single string or array
247 in CWT. *)
248
249 val exp : t -> Ptime.t option
250 (** Expiration time claim (key 4) per
251 {{:https://datatracker.ietf.org/doc/html/rfc8392#section-3.1.4}Section
252 3.1.4}. *)
253
254 val nbf : t -> Ptime.t option
255 (** Not Before claim (key 5) per
256 {{:https://datatracker.ietf.org/doc/html/rfc8392#section-3.1.5}Section
257 3.1.5}. *)
258
259 val iat : t -> Ptime.t option
260 (** Issued At claim (key 6) per
261 {{:https://datatracker.ietf.org/doc/html/rfc8392#section-3.1.6}Section
262 3.1.6}. *)
263
264 val cti : t -> string option
265 (** CWT ID claim (key 7) per
266 {{:https://datatracker.ietf.org/doc/html/rfc8392#section-3.1.7}Section
267 3.1.7}. Note: Unlike JWT's jti which is a string, CWT's cti is a byte
268 string. *)
269
270 (** {2 Custom Claims}
271
272 CWT supports both integer and text string keys for custom claims. *)
273
274 val get_int_key : int -> t -> Cbort.Cbor.t option
275 (** [get_int_key key claims] returns the CBOR value of custom claim with
276 integer key [key]. *)
277
278 val get_string_key : string -> t -> Cbort.Cbor.t option
279 (** [get_string_key key claims] returns the CBOR value of custom claim with
280 string key [key]. *)
281
282 (** {2 Construction} *)
283
284 type builder
285 (** Builder for constructing claims. *)
286
287 val empty : builder
288 (** Empty claims builder. *)
289
290 val set_iss : string -> builder -> builder
291 (** Set issuer claim. *)
292
293 val set_sub : string -> builder -> builder
294 (** Set subject claim. *)
295
296 val set_aud : string list -> builder -> builder
297 (** Set audience claim. *)
298
299 val set_exp : Ptime.t -> builder -> builder
300 (** Set expiration time claim. *)
301
302 val set_nbf : Ptime.t -> builder -> builder
303 (** Set not-before claim. *)
304
305 val set_iat : Ptime.t -> builder -> builder
306 (** Set issued-at claim. *)
307
308 val set_cti : string -> builder -> builder
309 (** Set CWT ID claim (raw bytes). *)
310
311 val set_int_key : int -> Cbort.Cbor.t -> builder -> builder
312 (** [set_int_key key value builder] sets a custom claim with integer key.
313 [value] is a CBOR value that will be serialized. *)
314
315 val set_string_key : string -> Cbort.Cbor.t -> builder -> builder
316 (** [set_string_key key value builder] sets a custom claim with string key.
317 [value] is a CBOR value that will be serialized. *)
318
319 val build : builder -> t
320 (** Build the claims set. *)
321
322 (** {2 Serialization} *)
323
324 val of_cbor : string -> (t, error) result
325 (** Parse claims from CBOR-encoded CWT Claims Set. *)
326
327 val to_cbor : t -> string
328 (** Serialize claims to CBOR-encoded CWT Claims Set. *)
329end
330
331(** {1 CWT Token} *)
332
333type t
334(** A parsed CWT token (COSE_Sign1 or COSE_Mac0 structure). Note: COSE_Encrypt0
335 is not currently supported. *)
336
337(** {2 Parsing}
338
339 Parse CWT from CBOR bytes. The CWT may be tagged (with COSE tag) or untagged
340 per
341 {{:https://datatracker.ietf.org/doc/html/rfc8392#section-2}RFC 8392 Section
342 2}. *)
343
344val parse : string -> (t, error) result
345(** [parse cwt_bytes] parses a CWT from CBOR bytes.
346
347 This parses the COSE structure and extracts the claims, but does NOT verify
348 the signature/MAC. Use {!verify} to validate cryptographic protection after
349 parsing. *)
350
351(** {2 Accessors} *)
352
353val claims : t -> Claims.t
354(** [claims t] returns the claims set. *)
355
356val algorithm : t -> Algorithm.t option
357(** [algorithm t] returns the COSE algorithm from the protected header. *)
358
359val kid : t -> string option
360(** [kid t] returns the key ID from headers if present. *)
361
362val raw : t -> string
363(** [raw t] returns the original CBOR bytes. *)
364
365(** {2 Verification}
366
367 Verify cryptographic protection and validate claims. *)
368
369val verify :
370 key:Cose_key.t -> ?allowed_algs:Algorithm.t list -> t -> (unit, error) result
371(** [verify ~key ?allowed_algs t] verifies the COSE signature or MAC.
372
373 @param key The key to verify with (must match algorithm)
374 @param allowed_algs List of acceptable algorithms. Default: all. *)
375
376val validate :
377 now:Ptime.t ->
378 ?iss:string ->
379 ?aud:string ->
380 ?leeway:Ptime.Span.t ->
381 t ->
382 (unit, error) result
383(** [validate ~now ?iss ?aud ?leeway t] validates CWT claims.
384
385 @param now Current time (required, no implicit clock)
386 @param iss Expected issuer (if provided, must match exactly)
387 @param aud Expected audience (if provided, must be in audience list)
388 @param leeway Clock skew tolerance for exp/nbf checks (default 0s) *)
389
390val verify_and_validate :
391 key:Cose_key.t ->
392 now:Ptime.t ->
393 ?allowed_algs:Algorithm.t list ->
394 ?iss:string ->
395 ?aud:string ->
396 ?leeway:Ptime.Span.t ->
397 t ->
398 (unit, error) result
399(** [verify_and_validate ~key ~now ...] verifies signature and validates claims.
400*)
401
402(** {2 Creation}
403
404 Create and sign CWTs. *)
405
406val create :
407 algorithm:Algorithm.t ->
408 claims:Claims.t ->
409 key:Cose_key.t ->
410 (t, error) result
411(** [create ~algorithm ~claims ~key] creates and signs a new CWT.
412
413 Creates a COSE_Sign1 structure for signature algorithms (ES256, ES384,
414 ES512, EdDSA) or COSE_Mac0 for MAC algorithms (HMAC_256, HMAC_384,
415 HMAC_512).
416
417 The [key] must be appropriate for the algorithm:
418 - HMAC algorithms: symmetric key
419 - ES256: P-256 private key
420 - ES384: P-384 private key
421 - ES512: P-521 private key
422 - EdDSA: Ed25519 private key *)
423
424val encode : t -> string
425(** [encode t] returns the CBOR serialization of the CWT. The result is a tagged
426 COSE structure (COSE_Sign1 or COSE_Mac0). *)
427
428(** {1 Utilities} *)
429
430val is_expired : now:Ptime.t -> ?leeway:Ptime.Span.t -> t -> bool
431(** [is_expired ~now ?leeway t] checks if the token has expired. Returns false
432 if no exp claim present. *)
433
434val time_to_expiry : now:Ptime.t -> t -> Ptime.Span.t option
435(** [time_to_expiry ~now t] returns time until expiration, or [None] if no
436 expiration claim or already expired. *)