JSON web tokens in OCaml
0
fork

Configure Feed

Select the types of activity you want to include in your feed.

cwt-parse

+437 -329
+400 -297
lib/cwt.ml
··· 36 36 let error_to_string e = 37 37 Format.asprintf "%a" pp_error e 38 38 39 + (* Cbort codec helpers *) 40 + 41 + let cbort_error_to_error e = 42 + Invalid_cbor (Cbort.Error.to_string e) 43 + 39 44 (* COSE Algorithms - RFC 9053 *) 40 45 41 46 module Algorithm = struct ··· 90 95 | Okp 91 96 | Ec2 92 97 | Symmetric 93 - 94 - type crv = 95 - | P256 96 - | P384 97 - | P521 98 - | Ed25519 99 98 100 99 (* COSE key labels *) 101 100 let label_kty = 1 ··· 174 173 let with_kid id t = { t with kid = Some id } 175 174 let with_alg a t = { t with alg = Some a } 176 175 176 + (* Helper to build CBOR map pairs *) 177 + let int_key k = Cbort.Cbor.Int (Z.of_int k) 178 + 177 179 (* CBOR encoding/decoding for COSE keys *) 178 - let of_cbor _bytes = 179 - Error (Invalid_cose "COSE key parsing not yet implemented") 180 + let of_cbor bytes = 181 + match Cbort.decode_string Cbort.any bytes with 182 + | Error e -> Error (cbort_error_to_error e) 183 + | Ok cbor -> 184 + let find_int key = Cbort.Cbor.find (int_key key) cbor in 185 + let find_bytes key = 186 + match find_int key with 187 + | Some (Cbort.Cbor.Bytes s) -> Some s 188 + | _ -> None 189 + in 190 + (* kid can be Text or Bytes per RFC 9052 *) 191 + let find_kid key = 192 + match find_int key with 193 + | Some (Cbort.Cbor.Bytes s) -> Some s 194 + | Some (Cbort.Cbor.Text s) -> Some s 195 + | _ -> None 196 + in 197 + let get_int_value = function 198 + | Some (Cbort.Cbor.Int z) -> Some (Z.to_int z) 199 + | _ -> None 200 + in 201 + let kty_val = get_int_value (find_int label_kty) in 202 + let crv_val = get_int_value (find_int label_crv) in 203 + let kid = find_kid label_kid in 204 + let alg = match get_int_value (find_int label_alg) with 205 + | None -> None 206 + | Some n -> (match Algorithm.of_cose_int n with Ok a -> Some a | Error _ -> None) 207 + in 208 + let x = find_bytes label_x in 209 + let y = find_bytes label_y in 210 + let d = find_bytes label_d in 211 + let k = find_bytes label_k in 212 + let key_data = match kty_val, crv_val, x, y, d, k with 213 + | Some 4, _, _, _, _, Some k -> Ok (Symmetric_key { k }) 214 + | Some 1, Some 6, Some x, _, None, _ -> Ok (Ed25519_pub { x }) 215 + | Some 1, Some 6, Some x, _, Some d, _ -> Ok (Ed25519_priv { x; d }) 216 + | Some 2, Some 1, Some x, Some y, None, _ -> Ok (P256_pub { x; y }) 217 + | Some 2, Some 1, Some x, Some y, Some d, _ -> Ok (P256_priv { x; y; d }) 218 + | Some 2, Some 2, Some x, Some y, None, _ -> Ok (P384_pub { x; y }) 219 + | Some 2, Some 2, Some x, Some y, Some d, _ -> Ok (P384_priv { x; y; d }) 220 + | Some 2, Some 3, Some x, Some y, None, _ -> Ok (P521_pub { x; y }) 221 + | Some 2, Some 3, Some x, Some y, Some d, _ -> Ok (P521_priv { x; y; d }) 222 + | _ -> Error (Invalid_cose "unsupported or invalid COSE key structure") 223 + in 224 + Result.map (fun key_data -> { key_data; kid; alg }) key_data 180 225 181 226 let to_cbor t = 182 - let open Cbort.Rw in 183 - let buf = Buffer.create 128 in 184 - let w = Bytesrw.Bytes.Writer.of_buffer buf in 185 - let e = make_encoder w in 227 + let pairs = ref [] in 228 + let add k v = pairs := (int_key k, v) :: !pairs in 229 + let add_bytes k s = add k (Cbort.Cbor.Bytes s) in 230 + let add_int k i = add k (Cbort.Cbor.Int (Z.of_int i)) in 186 231 187 - (* Count the number of map entries *) 188 - let count = ref 1 in (* kty is always present *) 189 - if Option.is_some t.kid then incr count; 190 - if Option.is_some t.alg then incr count; 232 + (* kty - always present *) 191 233 (match t.key_data with 192 - | Symmetric_key _ -> incr count (* k *) 193 - | Ed25519_pub _ -> count := !count + 2 (* crv, x *) 194 - | Ed25519_priv _ -> count := !count + 3 (* crv, x, d *) 195 - | P256_pub _ | P384_pub _ | P521_pub _ -> count := !count + 3 (* crv, x, y *) 196 - | P256_priv _ | P384_priv _ | P521_priv _ -> count := !count + 4); (* crv, x, y, d *) 197 - 198 - write_map_start e !count; 199 - 200 - (* kty *) 201 - write_int e label_kty; 202 - (match t.key_data with 203 - | Symmetric_key _ -> write_int e kty_symmetric 204 - | Ed25519_pub _ | Ed25519_priv _ -> write_int e kty_okp 205 - | _ -> write_int e kty_ec2); 234 + | Symmetric_key _ -> add_int label_kty kty_symmetric 235 + | Ed25519_pub _ | Ed25519_priv _ -> add_int label_kty kty_okp 236 + | _ -> add_int label_kty kty_ec2); 206 237 207 238 (* kid (optional) *) 208 - Option.iter (fun kid -> 209 - write_int e label_kid; 210 - write_bytes_header e (String.length kid); 211 - write_bytes e kid 212 - ) t.kid; 239 + Option.iter (fun kid -> add_bytes label_kid kid) t.kid; 213 240 214 241 (* alg (optional) *) 215 - Option.iter (fun alg -> 216 - write_int e label_alg; 217 - write_int e (Algorithm.to_cose_int alg) 218 - ) t.alg; 242 + Option.iter (fun alg -> add_int label_alg (Algorithm.to_cose_int alg)) t.alg; 219 243 220 244 (* Key-type specific parameters *) 221 245 (match t.key_data with 222 246 | Symmetric_key { k } -> 223 - write_int e label_k; 224 - write_bytes_header e (String.length k); 225 - write_bytes e k 247 + add_bytes label_k k 226 248 227 249 | Ed25519_pub { x } -> 228 - write_int e label_crv; 229 - write_int e crv_ed25519; 230 - write_int e label_x; 231 - write_bytes_header e (String.length x); 232 - write_bytes e x 250 + add_int label_crv crv_ed25519; 251 + add_bytes label_x x 233 252 234 253 | Ed25519_priv { x; d } -> 235 - write_int e label_crv; 236 - write_int e crv_ed25519; 237 - write_int e label_x; 238 - write_bytes_header e (String.length x); 239 - write_bytes e x; 240 - write_int e label_d; 241 - write_bytes_header e (String.length d); 242 - write_bytes e d 254 + add_int label_crv crv_ed25519; 255 + add_bytes label_x x; 256 + add_bytes label_d d 243 257 244 258 | P256_pub { x; y } -> 245 - write_int e label_crv; 246 - write_int e crv_p256; 247 - write_int e label_x; 248 - write_bytes_header e (String.length x); 249 - write_bytes e x; 250 - write_int e label_y; 251 - write_bytes_header e (String.length y); 252 - write_bytes e y 259 + add_int label_crv crv_p256; 260 + add_bytes label_x x; 261 + add_bytes label_y y 253 262 254 263 | P256_priv { x; y; d } -> 255 - write_int e label_crv; 256 - write_int e crv_p256; 257 - write_int e label_x; 258 - write_bytes_header e (String.length x); 259 - write_bytes e x; 260 - write_int e label_y; 261 - write_bytes_header e (String.length y); 262 - write_bytes e y; 263 - write_int e label_d; 264 - write_bytes_header e (String.length d); 265 - write_bytes e d 264 + add_int label_crv crv_p256; 265 + add_bytes label_x x; 266 + add_bytes label_y y; 267 + add_bytes label_d d 266 268 267 269 | P384_pub { x; y } -> 268 - write_int e label_crv; 269 - write_int e crv_p384; 270 - write_int e label_x; 271 - write_bytes_header e (String.length x); 272 - write_bytes e x; 273 - write_int e label_y; 274 - write_bytes_header e (String.length y); 275 - write_bytes e y 270 + add_int label_crv crv_p384; 271 + add_bytes label_x x; 272 + add_bytes label_y y 276 273 277 274 | P384_priv { x; y; d } -> 278 - write_int e label_crv; 279 - write_int e crv_p384; 280 - write_int e label_x; 281 - write_bytes_header e (String.length x); 282 - write_bytes e x; 283 - write_int e label_y; 284 - write_bytes_header e (String.length y); 285 - write_bytes e y; 286 - write_int e label_d; 287 - write_bytes_header e (String.length d); 288 - write_bytes e d 275 + add_int label_crv crv_p384; 276 + add_bytes label_x x; 277 + add_bytes label_y y; 278 + add_bytes label_d d 289 279 290 280 | P521_pub { x; y } -> 291 - write_int e label_crv; 292 - write_int e crv_p521; 293 - write_int e label_x; 294 - write_bytes_header e (String.length x); 295 - write_bytes e x; 296 - write_int e label_y; 297 - write_bytes_header e (String.length y); 298 - write_bytes e y 281 + add_int label_crv crv_p521; 282 + add_bytes label_x x; 283 + add_bytes label_y y 299 284 300 285 | P521_priv { x; y; d } -> 301 - write_int e label_crv; 302 - write_int e crv_p521; 303 - write_int e label_x; 304 - write_bytes_header e (String.length x); 305 - write_bytes e x; 306 - write_int e label_y; 307 - write_bytes_header e (String.length y); 308 - write_bytes e y; 309 - write_int e label_d; 310 - write_bytes_header e (String.length d); 311 - write_bytes e d); 312 - 313 - flush_encoder e; 314 - Buffer.contents buf 286 + add_int label_crv crv_p521; 287 + add_bytes label_x x; 288 + add_bytes label_y y; 289 + add_bytes label_d d); 315 290 316 - (* Suppress unused warnings *) 317 - let _ = (label_kty, label_kid, label_alg, label_crv, label_x, label_y, label_d, label_k) 318 - let _ = (kty_okp, kty_ec2, kty_symmetric, crv_p256, crv_p384, crv_p521, crv_ed25519) 291 + Cbort.encode_string Cbort.any (Cbort.Cbor.Map (List.rev !pairs)) 319 292 end 320 293 321 294 (* CWT Claims - RFC 8392 Section 3 *) ··· 342 315 nbf : Ptime.t option; 343 316 iat : Ptime.t option; 344 317 cti : string option; 345 - custom : (claim_key * string) list; 318 + custom : (claim_key * Cbort.Cbor.t) list; 346 319 } 347 320 348 321 let iss t = t.iss ··· 383 356 let set_string_key key value t = { t with custom = (String_key key, value) :: t.custom } 384 357 let build t = t 385 358 386 - let of_cbor _bytes = 387 - Error (Invalid_claims "Claims parsing not yet implemented") 359 + (* Standard claim keys *) 360 + let standard_keys = [key_iss; key_sub; key_aud; key_exp; key_nbf; key_iat; key_cti] 388 361 389 - let to_cbor t = 390 - let open Cbort.Rw in 391 - let buf = Buffer.create 128 in 392 - let w = Bytesrw.Bytes.Writer.of_buffer buf in 393 - let e = make_encoder w in 362 + (* Helper to convert claim_key to CBOR *) 363 + let claim_key_to_cbor = function 364 + | Int_key i -> Cbort.Cbor.Int (Z.of_int i) 365 + | String_key s -> Cbort.Cbor.Text s 394 366 395 - (* Count the number of map entries *) 396 - let count = ref 0 in 397 - if Option.is_some t.iss then incr count; 398 - if Option.is_some t.sub then incr count; 399 - if t.aud <> [] then incr count; 400 - if Option.is_some t.exp then incr count; 401 - if Option.is_some t.nbf then incr count; 402 - if Option.is_some t.iat then incr count; 403 - if Option.is_some t.cti then incr count; 404 - count := !count + List.length t.custom; 367 + (* Helper to find value by integer key in CBOR map *) 368 + let find_int_key key pairs = 369 + let target = Cbort.Cbor.Int (Z.of_int key) in 370 + List.find_map (fun (k, v) -> 371 + if Cbort.Cbor.equal k target then Some v else None 372 + ) pairs 405 373 406 - write_map_start e !count; 374 + (* Helper to extract string from CBOR *) 375 + let cbor_to_string = function 376 + | Cbort.Cbor.Text s -> Some s 377 + | _ -> None 407 378 408 - (* iss (1) *) 409 - Option.iter (fun iss -> 410 - write_int e key_iss; 411 - write_text e iss 412 - ) t.iss; 379 + (* Helper to extract bytes from CBOR *) 380 + let cbor_to_bytes = function 381 + | Cbort.Cbor.Bytes s -> Some s 382 + | _ -> None 413 383 414 - (* sub (2) *) 415 - Option.iter (fun sub -> 416 - write_int e key_sub; 417 - write_text e sub 418 - ) t.sub; 384 + (* Helper to extract ptime from CBOR integer *) 385 + let cbor_to_ptime = function 386 + | Cbort.Cbor.Int z -> 387 + Ptime.of_float_s (Z.to_float z) 388 + | _ -> None 419 389 420 - (* aud (3) *) 421 - if t.aud <> [] then begin 422 - write_int e key_aud; 423 - if List.length t.aud = 1 then 424 - write_text e (List.hd t.aud) 425 - else begin 426 - write_array_start e (List.length t.aud); 427 - List.iter (write_text e) t.aud 428 - end 429 - end; 390 + (* Helper to extract audience (string or array of strings) *) 391 + let cbor_to_aud = function 392 + | Cbort.Cbor.Text s -> Some [s] 393 + | Cbort.Cbor.Array items -> 394 + let strings = List.filter_map cbor_to_string items in 395 + if List.length strings = List.length items then Some strings 396 + else None 397 + | _ -> None 430 398 431 - (* exp (4) - NumericDate as integer seconds since epoch *) 432 - Option.iter (fun exp -> 433 - write_int e key_exp; 434 - let secs = Ptime.to_float_s exp |> Float.to_int in 435 - write_int e secs 399 + (* Decode claims from CBOR map pairs *) 400 + let decode_from_pairs pairs = 401 + let iss = Option.bind (find_int_key key_iss pairs) cbor_to_string in 402 + let sub = Option.bind (find_int_key key_sub pairs) cbor_to_string in 403 + let aud = Option.value ~default:[] (Option.bind (find_int_key key_aud pairs) cbor_to_aud) in 404 + let exp = Option.bind (find_int_key key_exp pairs) cbor_to_ptime in 405 + let nbf = Option.bind (find_int_key key_nbf pairs) cbor_to_ptime in 406 + let iat = Option.bind (find_int_key key_iat pairs) cbor_to_ptime in 407 + let cti = Option.bind (find_int_key key_cti pairs) cbor_to_bytes in 408 + (* Collect custom claims (non-standard keys) *) 409 + let custom = List.filter_map (fun (k, v) -> 410 + match k with 411 + | Cbort.Cbor.Int z -> 412 + let i = Z.to_int z in 413 + if List.mem i standard_keys then None 414 + else Some (Int_key i, v) 415 + | Cbort.Cbor.Text s -> Some (String_key s, v) 416 + | _ -> None 417 + ) pairs in 418 + { iss; sub; aud; exp; nbf; iat; cti; custom } 419 + 420 + (* Encode claims to CBOR map pairs *) 421 + let encode_to_pairs t = 422 + let open Cbort.Cbor in 423 + let pairs = ref [] in 424 + let add_int k v = pairs := (Int (Z.of_int k), v) :: !pairs in 425 + (* Standard claims *) 426 + Option.iter (fun v -> add_int key_iss (Text v)) t.iss; 427 + Option.iter (fun v -> add_int key_sub (Text v)) t.sub; 428 + (match t.aud with 429 + | [] -> () 430 + | [s] -> add_int key_aud (Text s) 431 + | lst -> add_int key_aud (Array (List.map (fun s -> Text s) lst))); 432 + Option.iter (fun v -> 433 + add_int key_exp (Int (Z.of_float (Ptime.to_float_s v))) 436 434 ) t.exp; 437 - 438 - (* nbf (5) *) 439 - Option.iter (fun nbf -> 440 - write_int e key_nbf; 441 - let secs = Ptime.to_float_s nbf |> Float.to_int in 442 - write_int e secs 435 + Option.iter (fun v -> 436 + add_int key_nbf (Int (Z.of_float (Ptime.to_float_s v))) 443 437 ) t.nbf; 444 - 445 - (* iat (6) *) 446 - Option.iter (fun iat -> 447 - write_int e key_iat; 448 - let secs = Ptime.to_float_s iat |> Float.to_int in 449 - write_int e secs 438 + Option.iter (fun v -> 439 + add_int key_iat (Int (Z.of_float (Ptime.to_float_s v))) 450 440 ) t.iat; 441 + Option.iter (fun v -> add_int key_cti (Bytes v)) t.cti; 442 + (* Custom claims *) 443 + List.iter (fun (k, v) -> 444 + pairs := (claim_key_to_cbor k, v) :: !pairs 445 + ) t.custom; 446 + List.rev !pairs 451 447 452 - (* cti (7) - byte string *) 453 - Option.iter (fun cti -> 454 - write_int e key_cti; 455 - write_bytes_header e (String.length cti); 456 - write_bytes e cti 457 - ) t.cti; 448 + let claims_not_map_error = "claims must be a CBOR map" 458 449 459 - (* Custom claims *) 460 - List.iter (fun (key, value) -> 461 - (match key with 462 - | Int_key k -> write_int e k 463 - | String_key k -> write_text e k); 464 - (* Value is already CBOR-encoded, write it raw *) 465 - write_bytes e value 466 - ) t.custom; 450 + (** Full codec for claims including custom claims *) 451 + let codec : t Cbort.t = 452 + Cbort.conv 453 + (fun cbor -> 454 + match cbor with 455 + | Cbort.Cbor.Map pairs -> Ok (decode_from_pairs pairs) 456 + | _ -> Error claims_not_map_error) 457 + (fun t -> Cbort.Cbor.Map (encode_to_pairs t)) 458 + Cbort.any 467 459 468 - flush_encoder e; 469 - Buffer.contents buf 460 + let of_cbor bytes = 461 + match Cbort.decode_string codec bytes with 462 + | Ok t -> Ok t 463 + | Error e -> 464 + (* Distinguish CBOR parse errors from claims structure errors *) 465 + let msg = Cbort.Error.to_string e in 466 + if msg = claims_not_map_error then 467 + Error (Invalid_claims msg) 468 + else 469 + Error (Invalid_cbor msg) 470 470 471 - (* Suppress unused warnings *) 472 - let _ = (key_iss, key_sub, key_aud, key_exp, key_nbf, key_iat, key_cti) 471 + let to_cbor t = Cbort.encode_string codec t 473 472 end 474 473 475 474 (* CWT Token *) ··· 496 495 let kid t = t.kid 497 496 let raw t = t.raw 498 497 499 - let parse _bytes = 500 - Error (Invalid_cbor "CWT parsing not yet implemented") 498 + (** Extract kid from header - can be Text or Bytes per RFC 9052 *) 499 + let extract_kid_from_header pairs = 500 + let kid_key = Cbort.Cbor.Int (Z.of_int header_kid) in 501 + List.find_map (fun (k, v) -> 502 + if Cbort.Cbor.equal k kid_key then 503 + match v with 504 + | Cbort.Cbor.Bytes s -> Some s 505 + | Cbort.Cbor.Text s -> Some s 506 + | _ -> None 507 + else None 508 + ) pairs 509 + 510 + (** Decode protected header to extract algorithm and kid *) 511 + let decode_protected_header bytes = 512 + match Cbort.decode_string Cbort.any bytes with 513 + | Error _ -> (None, None) 514 + | Ok (Cbort.Cbor.Map pairs) -> 515 + let alg_key = Cbort.Cbor.Int (Z.of_int header_alg) in 516 + let alg_int = List.find_map (fun (k, v) -> 517 + if Cbort.Cbor.equal k alg_key then 518 + match v with 519 + | Cbort.Cbor.Int z -> Some (Z.to_int z) 520 + | _ -> None 521 + else None 522 + ) pairs in 523 + let algorithm = Option.bind alg_int (fun n -> 524 + match Algorithm.of_cose_int n with 525 + | Ok alg -> Some alg 526 + | Error _ -> None) 527 + in 528 + let kid = extract_kid_from_header pairs in 529 + (algorithm, kid) 530 + | Ok _ -> (None, None) 531 + 532 + (** Extract kid from unprotected header if present *) 533 + let decode_unprotected_header cbor = 534 + match cbor with 535 + | Cbort.Cbor.Map pairs -> extract_kid_from_header pairs 536 + | _ -> None 537 + 538 + let parse bytes = 539 + match Cbort.decode_string Cbort.any bytes with 540 + | Error e -> Error (cbort_error_to_error e) 541 + | Ok cbor -> 542 + (* Handle optional COSE tag and extract the array *) 543 + let cose_array = match cbor with 544 + | Cbort.Cbor.Tag (18, arr) -> Some arr (* COSE_Sign1 *) 545 + | Cbort.Cbor.Tag (17, arr) -> Some arr (* COSE_Mac0 *) 546 + | Cbort.Cbor.Array _ as arr -> Some arr (* Untagged *) 547 + | _ -> None 548 + in 549 + match cose_array with 550 + | None -> Error (Invalid_cose "expected COSE_Sign1 or COSE_Mac0 structure") 551 + | Some (Cbort.Cbor.Array [protected_bstr; unprotected; payload_bstr; sig_bstr]) -> 552 + (* Extract byte strings *) 553 + let protected_header = match protected_bstr with 554 + | Cbort.Cbor.Bytes s -> Some s 555 + | _ -> None 556 + in 557 + let signature = match sig_bstr with 558 + | Cbort.Cbor.Bytes s -> Some s 559 + | _ -> None 560 + in 561 + (match protected_header, signature with 562 + | Some protected_header, Some signature -> 563 + (* Decode protected header for algorithm and kid *) 564 + let (algorithm, protected_kid) = decode_protected_header protected_header in 565 + (* Decode unprotected header for kid - prefer unprotected over protected *) 566 + let unprotected_kid = decode_unprotected_header unprotected in 567 + let kid = match unprotected_kid with 568 + | Some _ -> unprotected_kid 569 + | None -> protected_kid 570 + in 571 + (* Decode claims from payload - handle detached payloads *) 572 + (match payload_bstr with 573 + | Cbort.Cbor.Null -> 574 + (* Detached payload: not currently supported *) 575 + Error (Invalid_cose "detached payloads are not supported") 576 + | Cbort.Cbor.Bytes payload -> 577 + (match Claims.of_cbor payload with 578 + | Error e -> Error e 579 + | Ok claims -> 580 + Ok { claims; algorithm; kid; protected_header; signature; raw = bytes }) 581 + | _ -> Error (Invalid_cose "payload must be a byte string or null")) 582 + | _ -> Error (Invalid_cose "invalid COSE structure fields")) 583 + | Some (Cbort.Cbor.Array _) -> 584 + Error (Invalid_cose "COSE structure must have exactly 4 elements") 585 + | Some _ -> 586 + Error (Invalid_cose "expected COSE array structure") 501 587 502 588 (* Cryptographic operations *) 503 589 ··· 506 592 match alg with 507 593 | Algorithm.HMAC_256_64 -> 508 594 let mac = Hash.SHA256.hmac_string ~key payload in 509 - String.sub (Hash.SHA256.to_raw_string mac) 0 8 595 + Ok (String.sub (Hash.SHA256.to_raw_string mac) 0 8) 510 596 | Algorithm.HMAC_256 -> 511 597 let mac = Hash.SHA256.hmac_string ~key payload in 512 - Hash.SHA256.to_raw_string mac 598 + Ok (Hash.SHA256.to_raw_string mac) 513 599 | Algorithm.HMAC_384 -> 514 600 let mac = Hash.SHA384.hmac_string ~key payload in 515 - Hash.SHA384.to_raw_string mac 601 + Ok (Hash.SHA384.to_raw_string mac) 516 602 | Algorithm.HMAC_512 -> 517 603 let mac = Hash.SHA512.hmac_string ~key payload in 518 - Hash.SHA512.to_raw_string mac 519 - | _ -> failwith "Not an HMAC algorithm" 604 + Ok (Hash.SHA512.to_raw_string mac) 605 + | _ -> Error (Key_type_mismatch "Not an HMAC algorithm") 520 606 521 607 let hmac_verify alg key payload expected_mac = 522 - let computed = hmac_sign alg key payload in 523 - Eqaf.equal computed expected_mac 608 + match hmac_sign alg key payload with 609 + | Error _ -> false 610 + | Ok computed -> Eqaf.equal computed expected_mac 524 611 525 612 let p256_sign ~priv payload = 526 613 match Mirage_crypto_ec.P256.Dsa.priv_of_octets priv with ··· 566 653 | Error _ -> Error (Key_type_mismatch "Invalid Ed25519 private key") 567 654 | Ok priv -> Ok (Mirage_crypto_ec.Ed25519.sign ~key:priv payload) 568 655 656 + (** Build Sig_structure or MAC_structure for COSE operations *) 657 + let build_sig_structure ~context_string ~protected_header ~payload = 658 + let open Cbort.Cbor in 659 + Array [ 660 + Text context_string; 661 + Bytes protected_header; 662 + Bytes ""; (* external_aad = empty *) 663 + Bytes payload; 664 + ] 665 + |> Cbort.encode_string Cbort.any 666 + 667 + (** Expected signature/MAC length for each algorithm *) 668 + let expected_sig_length = function 669 + | Algorithm.ES256 -> 64 (* 32 + 32 *) 670 + | Algorithm.ES384 -> 96 (* 48 + 48 *) 671 + | Algorithm.ES512 -> 132 (* 66 + 66 *) 672 + | Algorithm.EdDSA -> 64 673 + | Algorithm.HMAC_256_64 -> 8 674 + | Algorithm.HMAC_256 -> 32 675 + | Algorithm.HMAC_384 -> 48 676 + | Algorithm.HMAC_512 -> 64 677 + 569 678 let verify ~key ?allowed_algs t = 570 679 (* Check algorithm is allowed *) 571 680 let alg = match t.algorithm with ··· 582 691 if not (List.mem alg allowed) then 583 692 Error (Algorithm_not_allowed (Algorithm.to_string alg)) 584 693 else 585 - (* Build Sig_structure or MAC_structure for verification *) 586 - let sig_structure = 587 - let open Cbort.Rw in 588 - let buf = Buffer.create 128 in 589 - let w = Bytesrw.Bytes.Writer.of_buffer buf in 590 - let e = make_encoder w in 591 - write_array_start e 4; 592 - write_text e (match alg with 694 + (* Validate signature length before attempting to parse it *) 695 + let expected_len = expected_sig_length alg in 696 + let actual_len = String.length t.signature in 697 + if actual_len <> expected_len then 698 + Error (Invalid_cose (Printf.sprintf 699 + "signature length mismatch: expected %d, got %d" expected_len actual_len)) 700 + else 701 + (* Build Sig_structure or MAC_structure for verification *) 702 + let context_string = match alg with 593 703 | Algorithm.HMAC_256_64 | Algorithm.HMAC_256 594 704 | Algorithm.HMAC_384 | Algorithm.HMAC_512 -> "MAC0" 595 - | _ -> "Signature1"); 596 - write_bytes_header e (String.length t.protected_header); 597 - write_bytes e t.protected_header; 598 - write_bytes_header e 0; (* external_aad = empty *) 705 + | _ -> "Signature1" 706 + in 599 707 let payload = Claims.to_cbor t.claims in 600 - write_bytes_header e (String.length payload); 601 - write_bytes e payload; 602 - flush_encoder e; 603 - Buffer.contents buf 604 - in 605 - (* Verify based on algorithm *) 606 - let verified = match alg, key.Cose_key.key_data with 607 - | (Algorithm.HMAC_256_64 | Algorithm.HMAC_256 608 - | Algorithm.HMAC_384 | Algorithm.HMAC_512), Cose_key.Symmetric_key { k } -> 609 - hmac_verify alg k sig_structure t.signature 610 - | Algorithm.EdDSA, (Cose_key.Ed25519_pub { x } | Cose_key.Ed25519_priv { x; _ }) -> 611 - (match Mirage_crypto_ec.Ed25519.pub_of_octets x with 612 - | Ok pub -> 613 - Mirage_crypto_ec.Ed25519.verify ~key:pub t.signature ~msg:sig_structure 614 - | Error _ -> false) 615 - | Algorithm.ES256, (Cose_key.P256_pub { x; y } | Cose_key.P256_priv { x; y; _ }) -> 616 - (match Mirage_crypto_ec.P256.Dsa.pub_of_octets ("\x04" ^ x ^ y) with 617 - | Ok pub -> 618 - let hash = Digestif.SHA256.(digest_string sig_structure |> to_raw_string) in 619 - let r = String.sub t.signature 0 32 in 620 - let s = String.sub t.signature 32 32 in 621 - Mirage_crypto_ec.P256.Dsa.verify ~key:pub (r, s) hash 622 - | Error _ -> false) 623 - | _ -> false 624 - in 625 - if verified then Ok () 626 - else Error Signature_mismatch 708 + let sig_structure = build_sig_structure 709 + ~context_string ~protected_header:t.protected_header ~payload 710 + in 711 + (* Verify based on algorithm - returns Result to distinguish key mismatch from sig failure *) 712 + let verify_result = match alg, key.Cose_key.key_data with 713 + | (Algorithm.HMAC_256_64 | Algorithm.HMAC_256 714 + | Algorithm.HMAC_384 | Algorithm.HMAC_512), Cose_key.Symmetric_key { k } -> 715 + if hmac_verify alg k sig_structure t.signature then Ok () 716 + else Error Signature_mismatch 717 + | Algorithm.EdDSA, (Cose_key.Ed25519_pub { x } | Cose_key.Ed25519_priv { x; _ }) -> 718 + (match Mirage_crypto_ec.Ed25519.pub_of_octets x with 719 + | Ok pub -> 720 + if Mirage_crypto_ec.Ed25519.verify ~key:pub t.signature ~msg:sig_structure 721 + then Ok () 722 + else Error Signature_mismatch 723 + | Error _ -> Error (Key_type_mismatch "Invalid Ed25519 public key")) 724 + | Algorithm.ES256, (Cose_key.P256_pub { x; y } | Cose_key.P256_priv { x; y; _ }) -> 725 + (match Mirage_crypto_ec.P256.Dsa.pub_of_octets ("\x04" ^ x ^ y) with 726 + | Ok pub -> 727 + let hash = Digestif.SHA256.(digest_string sig_structure |> to_raw_string) in 728 + let r = String.sub t.signature 0 32 in 729 + let s = String.sub t.signature 32 32 in 730 + if Mirage_crypto_ec.P256.Dsa.verify ~key:pub (r, s) hash 731 + then Ok () 732 + else Error Signature_mismatch 733 + | Error _ -> Error (Key_type_mismatch "Invalid P-256 public key")) 734 + | Algorithm.ES384, (Cose_key.P384_pub { x; y } | Cose_key.P384_priv { x; y; _ }) -> 735 + (match Mirage_crypto_ec.P384.Dsa.pub_of_octets ("\x04" ^ x ^ y) with 736 + | Ok pub -> 737 + let hash = Digestif.SHA384.(digest_string sig_structure |> to_raw_string) in 738 + let r = String.sub t.signature 0 48 in 739 + let s = String.sub t.signature 48 48 in 740 + if Mirage_crypto_ec.P384.Dsa.verify ~key:pub (r, s) hash 741 + then Ok () 742 + else Error Signature_mismatch 743 + | Error _ -> Error (Key_type_mismatch "Invalid P-384 public key")) 744 + | Algorithm.ES512, (Cose_key.P521_pub { x; y } | Cose_key.P521_priv { x; y; _ }) -> 745 + (match Mirage_crypto_ec.P521.Dsa.pub_of_octets ("\x04" ^ x ^ y) with 746 + | Ok pub -> 747 + let hash = Digestif.SHA512.(digest_string sig_structure |> to_raw_string) in 748 + let r = String.sub t.signature 0 66 in 749 + let s = String.sub t.signature 66 66 in 750 + if Mirage_crypto_ec.P521.Dsa.verify ~key:pub (r, s) hash 751 + then Ok () 752 + else Error Signature_mismatch 753 + | Error _ -> Error (Key_type_mismatch "Invalid P-521 public key")) 754 + | _ -> 755 + Error (Key_type_mismatch 756 + (Printf.sprintf "Key type doesn't match algorithm %s" 757 + (Algorithm.to_string alg))) 758 + in 759 + verify_result 627 760 628 761 let validate ~now ?iss ?aud ?leeway t = 629 762 let leeway = Option.value leeway ~default:Ptime.Span.zero in ··· 677 810 | Error _ as e -> e 678 811 | Ok () -> validate ~now ?iss ?aud ?leeway t 679 812 813 + (** Encode protected header as CBOR map *) 814 + let encode_protected_header algorithm = 815 + let open Cbort.Cbor in 816 + Map [ 817 + (Int (Z.of_int header_alg), Int (Z.of_int (Algorithm.to_cose_int algorithm))); 818 + ] 819 + |> Cbort.encode_string Cbort.any 820 + 821 + (** Encode COSE_Sign1 or COSE_Mac0 structure *) 822 + let encode_cose_message ~cose_tag ~protected_header ~payload ~signature = 823 + Cbort.Cbor.Tag (cose_tag, Cbort.Cbor.Array [ 824 + Cbort.Cbor.Bytes protected_header; 825 + Cbort.Cbor.Map []; (* unprotected header - empty *) 826 + Cbort.Cbor.Bytes payload; 827 + Cbort.Cbor.Bytes signature; 828 + ]) 829 + |> Cbort.encode_string Cbort.any 830 + 680 831 let create ~algorithm ~claims ~key = 681 832 (* Encode protected header *) 682 - let protected_header = 683 - let open Cbort.Rw in 684 - let buf = Buffer.create 32 in 685 - let w = Bytesrw.Bytes.Writer.of_buffer buf in 686 - let e = make_encoder w in 687 - write_map_start e 1; 688 - write_int e header_alg; 689 - write_int e (Algorithm.to_cose_int algorithm); 690 - flush_encoder e; 691 - Buffer.contents buf 692 - in 833 + let protected_header = encode_protected_header algorithm in 693 834 694 835 (* Build Sig_structure or MAC_structure *) 695 - let structure_name = match algorithm with 836 + let context_string = match algorithm with 696 837 | Algorithm.HMAC_256_64 | Algorithm.HMAC_256 697 838 | Algorithm.HMAC_384 | Algorithm.HMAC_512 -> "MAC0" 698 839 | _ -> "Signature1" 699 840 in 700 841 let payload = Claims.to_cbor claims in 701 - let to_be_signed = 702 - let open Cbort.Rw in 703 - let buf = Buffer.create 128 in 704 - let w = Bytesrw.Bytes.Writer.of_buffer buf in 705 - let e = make_encoder w in 706 - write_array_start e 4; 707 - write_text e structure_name; 708 - write_bytes_header e (String.length protected_header); 709 - write_bytes e protected_header; 710 - write_bytes_header e 0; (* external_aad = empty *) 711 - write_bytes_header e (String.length payload); 712 - write_bytes e payload; 713 - flush_encoder e; 714 - Buffer.contents buf 715 - in 842 + let to_be_signed = build_sig_structure ~context_string ~protected_header ~payload in 716 843 717 844 (* Sign or MAC *) 718 845 let signature_result = match algorithm, key.Cose_key.key_data with 719 846 | (Algorithm.HMAC_256_64 | Algorithm.HMAC_256 720 847 | Algorithm.HMAC_384 | Algorithm.HMAC_512), Cose_key.Symmetric_key { k } -> 721 - Ok (hmac_sign algorithm k to_be_signed) 848 + hmac_sign algorithm k to_be_signed 722 849 | Algorithm.EdDSA, Cose_key.Ed25519_priv { d; _ } -> 723 850 ed25519_sign ~priv:d to_be_signed 724 851 | Algorithm.ES256, Cose_key.P256_priv { d; _ } -> ··· 735 862 | Error e -> Error e 736 863 | Ok signature -> 737 864 (* Encode COSE_Sign1 or COSE_Mac0 structure *) 738 - let raw = 739 - let open Cbort.Rw in 740 - let buf = Buffer.create 256 in 741 - let w = Bytesrw.Bytes.Writer.of_buffer buf in 742 - let e = make_encoder w in 743 - (* Tag *) 744 - let tag = match algorithm with 745 - | Algorithm.HMAC_256_64 | Algorithm.HMAC_256 746 - | Algorithm.HMAC_384 | Algorithm.HMAC_512 -> cose_mac0_tag 747 - | _ -> cose_sign1_tag 748 - in 749 - write_type_arg e major_tag tag; 750 - write_array_start e 4; 751 - (* protected header as bstr *) 752 - write_bytes_header e (String.length protected_header); 753 - write_bytes e protected_header; 754 - (* unprotected header (empty map) *) 755 - write_map_start e 0; 756 - (* payload *) 757 - write_bytes_header e (String.length payload); 758 - write_bytes e payload; 759 - (* signature/tag *) 760 - write_bytes_header e (String.length signature); 761 - write_bytes e signature; 762 - flush_encoder e; 763 - Buffer.contents buf 865 + let cose_tag = match algorithm with 866 + | Algorithm.HMAC_256_64 | Algorithm.HMAC_256 867 + | Algorithm.HMAC_384 | Algorithm.HMAC_512 -> cose_mac0_tag 868 + | _ -> cose_sign1_tag 764 869 in 870 + let raw = encode_cose_message ~cose_tag ~protected_header ~payload ~signature in 765 871 Ok { 766 872 claims; 767 873 algorithm = Some algorithm; ··· 789 895 let diff = Ptime.diff exp now in 790 896 if Ptime.Span.compare diff Ptime.Span.zero <= 0 then None 791 897 else Some diff 792 - 793 - (* Suppress unused warnings *) 794 - let _ = (cose_sign1_tag, cose_mac0_tag, header_alg, header_kid)
+17 -16
lib/cwt.mli
··· 125 125 | Ec2 (** Elliptic Curve with x,y coordinates (kty = 2) *) 126 126 | Symmetric (** Symmetric key (kty = 4) *) 127 127 128 - (** Elliptic curve identifiers per COSE Elliptic Curves registry. *) 129 - type crv = 130 - | P256 (** NIST P-256, crv = 1 *) 131 - | P384 (** NIST P-384, crv = 2 *) 132 - | P521 (** NIST P-521, crv = 3 *) 133 - | Ed25519 (** Ed25519 for EdDSA, crv = 6 *) 128 + (** A COSE key. 134 129 135 - (** A COSE key. *) 130 + Supported key types and curves: 131 + - Symmetric keys for HMAC algorithms 132 + - P-256 (NIST, crv = 1) for ES256 133 + - P-384 (NIST, crv = 2) for ES384 134 + - P-521 (NIST, crv = 3) for ES512 135 + - Ed25519 (crv = 6) for EdDSA *) 136 136 type t 137 137 138 138 (** {2 Constructors} *) ··· 254 254 255 255 CWT supports both integer and text string keys for custom claims. *) 256 256 257 - val get_int_key : int -> t -> string option 258 - (** [get_int_key key claims] returns the raw CBOR value of custom claim 257 + val get_int_key : int -> t -> Cbort.Cbor.t option 258 + (** [get_int_key key claims] returns the CBOR value of custom claim 259 259 with integer key [key]. *) 260 260 261 - val get_string_key : string -> t -> string option 262 - (** [get_string_key key claims] returns the raw CBOR value of custom claim 261 + val get_string_key : string -> t -> Cbort.Cbor.t option 262 + (** [get_string_key key claims] returns the CBOR value of custom claim 263 263 with string key [key]. *) 264 264 265 265 (** {2 Construction} *) ··· 291 291 val set_cti : string -> builder -> builder 292 292 (** Set CWT ID claim (raw bytes). *) 293 293 294 - val set_int_key : int -> string -> builder -> builder 294 + val set_int_key : int -> Cbort.Cbor.t -> builder -> builder 295 295 (** [set_int_key key value builder] sets a custom claim with integer key. 296 - [value] should be CBOR-encoded. *) 296 + [value] is a CBOR value that will be serialized. *) 297 297 298 - val set_string_key : string -> string -> builder -> builder 298 + val set_string_key : string -> Cbort.Cbor.t -> builder -> builder 299 299 (** [set_string_key key value builder] sets a custom claim with string key. 300 - [value] should be CBOR-encoded. *) 300 + [value] is a CBOR value that will be serialized. *) 301 301 302 302 val build : builder -> t 303 303 (** Build the claims set. *) ··· 314 314 (** {1 CWT Token} *) 315 315 316 316 type t 317 - (** A parsed CWT token (COSE_Sign1, COSE_Mac0, or COSE_Encrypt0 structure). *) 317 + (** A parsed CWT token (COSE_Sign1 or COSE_Mac0 structure). 318 + Note: COSE_Encrypt0 is not currently supported. *) 318 319 319 320 (** {2 Parsing} 320 321
+20 -16
test/test_cwt.ml
··· 504 504 let cbor = Cwt.Cose_key.to_cbor key in 505 505 Alcotest.(check bool) "non-empty" true (String.length cbor > 0) 506 506 507 - let test_cose_key_of_cbor_not_implemented () = 508 - (* Test that of_cbor returns appropriate error for now *) 507 + let test_cose_key_of_cbor () = 508 + (* Test that of_cbor correctly decodes a symmetric key *) 509 509 let cbor = hex_to_bytes rfc_256bit_key_hex in 510 510 match Cwt.Cose_key.of_cbor cbor with 511 - | Ok _ -> () (* If it succeeds, that's also fine *) 512 - | Error (Cwt.Invalid_cose msg) -> 513 - Alcotest.(check bool) "error mentions not implemented" true 514 - (String.length msg > 0) 515 - | Error e -> Alcotest.fail (Printf.sprintf "Unexpected error: %s" (Cwt.error_to_string e)) 511 + | Ok key -> 512 + Alcotest.(check bool) "key type is symmetric" true 513 + (Cwt.Cose_key.kty key = Cwt.Cose_key.Symmetric); 514 + Alcotest.(check (option string)) "kid" (Some "Symmetric256") (Cwt.Cose_key.kid key) 515 + | Error e -> Alcotest.fail (Printf.sprintf "Failed to decode key: %s" (Cwt.error_to_string e)) 516 516 517 517 (* ============= CWT Encoding Tests ============= *) 518 518 ··· 551 551 Alcotest.(check (option string)) "iss preserved" (Some "es256-issuer") (Cwt.Claims.iss (Cwt.claims cwt)) 552 552 | Error e -> Alcotest.fail (Printf.sprintf "Create failed: %s" (Cwt.error_to_string e)) 553 553 554 - let test_cwt_parse_not_implemented () = 555 - (* Test that parse returns appropriate error for now *) 554 + let test_cwt_parse_roundtrip () = 555 + (* Test that parse correctly round-trips a created CWT *) 556 556 let claims = 557 557 Cwt.Claims.empty 558 - |> Cwt.Claims.set_iss "test" 558 + |> Cwt.Claims.set_iss "test-issuer" 559 + |> Cwt.Claims.set_sub "test-subject" 559 560 |> Cwt.Claims.build 560 561 in 561 562 let key = Cwt.Cose_key.symmetric rfc_256bit_key_bytes in ··· 563 564 | Ok cwt -> 564 565 let encoded = Cwt.encode cwt in 565 566 begin match Cwt.parse encoded with 566 - | Ok _ -> () (* If it succeeds, that's fine too *) 567 - | Error (Cwt.Invalid_cose msg) -> 568 - Alcotest.(check bool) "error message present" true (String.length msg > 0) 569 - | Error _ -> () (* Any error is acceptable for unimplemented function *) 567 + | Ok parsed -> 568 + Alcotest.(check (option string)) "iss" (Some "test-issuer") (Cwt.Claims.iss (Cwt.claims parsed)); 569 + Alcotest.(check (option string)) "sub" (Some "test-subject") (Cwt.Claims.sub (Cwt.claims parsed)); 570 + Alcotest.(check (option string)) "algorithm" 571 + (Some "HMAC 256/256") 572 + (Option.map Cwt.Algorithm.to_string (Cwt.algorithm parsed)) 573 + | Error e -> Alcotest.fail (Printf.sprintf "Parse failed: %s" (Cwt.error_to_string e)) 570 574 end 571 575 | Error e -> Alcotest.fail (Printf.sprintf "Create failed: %s" (Cwt.error_to_string e)) 572 576 ··· 721 725 Alcotest.test_case "to_cbor_symmetric" `Quick test_cose_key_to_cbor_symmetric; 722 726 Alcotest.test_case "to_cbor_ed25519" `Quick test_cose_key_to_cbor_ed25519; 723 727 Alcotest.test_case "to_cbor_p256" `Quick test_cose_key_to_cbor_p256; 724 - Alcotest.test_case "of_cbor_not_impl" `Quick test_cose_key_of_cbor_not_implemented; 728 + Alcotest.test_case "of_cbor" `Quick test_cose_key_of_cbor; 725 729 ]; 726 730 "Claims", [ 727 731 Alcotest.test_case "builder" `Quick test_claims_builder; ··· 742 746 "CWT Encoding", [ 743 747 Alcotest.test_case "hmac" `Quick test_cwt_hmac_encoding; 744 748 Alcotest.test_case "es256" `Quick test_cwt_es256_encoding; 745 - Alcotest.test_case "parse_not_impl" `Quick test_cwt_parse_not_implemented; 749 + Alcotest.test_case "parse_roundtrip" `Quick test_cwt_parse_roundtrip; 746 750 ]; 747 751 "Claims Validation", [ 748 752 Alcotest.test_case "expired" `Quick test_validate_expired_token;