forked from
gazagnaire.org/ocaml-dpop
DPoP (RFC 9449) proof-of-possession tokens
ocaml-dpop: new library for RFC 9449 DPoP proof-of-possession
Splits DPoP out of the ocaml-oauth client so authorization servers and
resource servers can verify proofs without pulling in the full HTTP
client stack. The library is self-contained on crypto-ec (P-256,
Ed25519), digestif, and base64.
Supports the two algorithms that actually matter for DPoP:
- ES256 (ECDSA P-256 + SHA-256), mandatory per RFC 9449 §5.1.
- EdDSA (Ed25519), RFC 8037.
Canonical JWK thumbprints follow RFC 7638 (lexicographic keys, no
whitespace). Signatures use JOSE P-1363 format (r||s) for ECDSA and
raw 64-byte Ed25519. jti defaults to 128 random bits base64url-encoded.
13 tests cover JWK ordering, thumbprint stability, RFC 9449 §4.3 ath
vector, proof segment layout, header/payload claims, and round-trip
signature verification for both algorithms.
+675
+21
LICENSE.md
+21
LICENSE.md
···
1
+
MIT License
2
+
3
+
Copyright (c) 2025 Thomas Gazagnaire
4
+
5
+
Permission is hereby granted, free of charge, to any person obtaining a copy
6
+
of this software and associated documentation files (the "Software"), to deal
7
+
in the Software without restriction, including without limitation the rights
8
+
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
9
+
copies of the Software, and to permit persons to whom the Software is
10
+
furnished to do so, subject to the following conditions:
11
+
12
+
The above copyright notice and this permission notice shall be included in all
13
+
copies or substantial portions of the Software.
14
+
15
+
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16
+
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17
+
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18
+
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19
+
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20
+
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
21
+
SOFTWARE.
+58
README.md
+58
README.md
···
1
+
# dpop
2
+
3
+
Minimal OCaml implementation of
4
+
[RFC 9449 — OAuth 2.0 Demonstrating Proof of Possession (DPoP)](https://datatracker.ietf.org/doc/html/rfc9449).
5
+
6
+
DPoP binds an OAuth access token to a public key held by the client so that a
7
+
leaked bearer token cannot be replayed by an attacker who does not also hold
8
+
the private key. Clients attach a signed JWT (a *DPoP proof*) to every
9
+
token-endpoint and resource request; authorization servers bind the issued
10
+
access token to the public key via its JWK thumbprint
11
+
([RFC 7638](https://datatracker.ietf.org/doc/html/rfc7638)).
12
+
13
+
## Supported algorithms
14
+
15
+
- **ES256** — ECDSA P-256 + SHA-256 (RFC 7518 §3.4). Mandatory for DPoP per
16
+
RFC 9449 §5.1.
17
+
- **EdDSA** — Ed25519 (RFC 8037).
18
+
19
+
Other algorithms (RS256, ES384, etc.) are intentionally not supported: each
20
+
adds parser complexity, attack surface, and rarely matches the DPoP use case
21
+
better than the two above.
22
+
23
+
## Example
24
+
25
+
```ocaml
26
+
let () = Crypto_rng_unix.use_default ()
27
+
28
+
let key = Dpop.generate Dpop.ES256
29
+
30
+
(* Attach a proof to every token/resource request. *)
31
+
let header =
32
+
let p =
33
+
Dpop.proof key
34
+
~htm:"POST"
35
+
~htu:"https://as.example.com/token"
36
+
()
37
+
in
38
+
"DPoP", p
39
+
40
+
(* On resource requests, bind the proof to the access token. *)
41
+
let resource_header ~access_token =
42
+
let ath = Dpop.access_token_hash access_token in
43
+
Dpop.proof key
44
+
~htm:"GET"
45
+
~htu:"https://api.example.com/me"
46
+
~ath
47
+
()
48
+
```
49
+
50
+
## Install
51
+
52
+
```sh
53
+
opam install dpop
54
+
```
55
+
56
+
## License
57
+
58
+
MIT. See `LICENSE.md`.
+38
dpop.opam
+38
dpop.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "DPoP (RFC 9449) proof-of-possession tokens"
4
+
description:
5
+
"Minimal implementation of RFC 9449 (Demonstrating Proof of Possession) for OAuth 2.0 clients, authorization servers, and resource servers. Supports ES256 (ECDSA P-256 + SHA-256) and EdDSA (Ed25519) with JWK thumbprints per RFC 7638."
6
+
maintainer: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
7
+
authors: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
8
+
license: "MIT"
9
+
tags: ["org:blacksun" "crypto" "http"]
10
+
homepage: "https://tangled.org/gazagnaire.org/ocaml-dpop"
11
+
bug-reports: "https://tangled.org/gazagnaire.org/ocaml-dpop/issues"
12
+
depends: [
13
+
"ocaml" {>= "5.1"}
14
+
"dune" {>= "3.21" & >= "3.21"}
15
+
"fmt" {>= "0.9"}
16
+
"crypto-rng" {>= "0.11.0"}
17
+
"crypto-ec" {>= "0.11.0"}
18
+
"digestif" {>= "1.0"}
19
+
"base64" {>= "3.0"}
20
+
"alcotest" {with-test}
21
+
"odoc" {with-doc}
22
+
]
23
+
build: [
24
+
["dune" "subst"] {dev}
25
+
[
26
+
"dune"
27
+
"build"
28
+
"-p"
29
+
name
30
+
"-j"
31
+
jobs
32
+
"@install"
33
+
"@runtest" {with-test}
34
+
"@doc" {with-doc}
35
+
]
36
+
]
37
+
dev-repo: "git+https://tangled.org/gazagnaire.org/ocaml-dpop"
38
+
x-maintenance-intent: ["(latest)"]
+25
dune-project
+25
dune-project
···
1
+
(lang dune 3.21)
2
+
(name dpop)
3
+
4
+
(generate_opam_files true)
5
+
6
+
(source (tangled gazagnaire.org/ocaml-dpop))
7
+
(license MIT)
8
+
(authors "Thomas Gazagnaire <thomas@gazagnaire.org>")
9
+
(maintainers "Thomas Gazagnaire <thomas@gazagnaire.org>")
10
+
11
+
(package
12
+
(name dpop)
13
+
(synopsis "DPoP (RFC 9449) proof-of-possession tokens")
14
+
(tags (org:blacksun crypto http))
15
+
(description "Minimal implementation of RFC 9449 (Demonstrating Proof of Possession) for OAuth 2.0 clients, authorization servers, and resource servers. Supports ES256 (ECDSA P-256 + SHA-256) and EdDSA (Ed25519) with JWK thumbprints per RFC 7638.")
16
+
(depends
17
+
(ocaml (>= 5.1))
18
+
(dune (>= 3.21))
19
+
(fmt (>= 0.9))
20
+
(crypto-rng (>= 0.11.0))
21
+
(crypto-ec (>= 0.11.0))
22
+
(digestif (>= 1.0))
23
+
(base64 (>= 3.0))
24
+
(alcotest :with-test)
25
+
(odoc :with-doc)))
+130
lib/dpop.ml
+130
lib/dpop.ml
···
1
+
(** DPoP (RFC 9449). *)
2
+
3
+
type alg = ES256 | EdDSA
4
+
5
+
type key =
6
+
| Es256 of { priv : Crypto_ec.P256.Dsa.priv; pub : Crypto_ec.P256.Dsa.pub }
7
+
| Ed of { priv : Crypto_ec.Ed25519.priv; pub : Crypto_ec.Ed25519.pub }
8
+
9
+
let alg = function Es256 _ -> ES256 | Ed _ -> EdDSA
10
+
11
+
let generate = function
12
+
| ES256 ->
13
+
let priv, pub = Crypto_ec.P256.Dsa.generate () in
14
+
Es256 { priv; pub }
15
+
| EdDSA ->
16
+
let priv, pub = Crypto_ec.Ed25519.generate () in
17
+
Ed { priv; pub }
18
+
19
+
(* Base64url per RFC 4648 §5 without padding. DPoP, JWS, and RFC 7638 all
20
+
specify this encoding. *)
21
+
let b64url s = Base64.encode_exn ~pad:false ~alphabet:Base64.uri_safe_alphabet s
22
+
23
+
(* P-256 uncompressed point is 0x04 || X (32) || Y (32). Strip the tag and
24
+
split into the two coordinates. *)
25
+
let p256_xy pub =
26
+
let octets = Crypto_ec.P256.Dsa.pub_to_octets ~compress:false pub in
27
+
assert (String.length octets = 65 && octets.[0] = '\x04');
28
+
(String.sub octets 1 32, String.sub octets 33 32)
29
+
30
+
(* RFC 7638 canonical JWK serialisation: the members required for the
31
+
algorithm, in lexicographic order, with no whitespace and JSON string
32
+
escaping of the values. The value strings we produce (base64url of 32
33
+
bytes) contain no characters that require JSON escaping, so simple
34
+
quoting is safe. *)
35
+
let canonical_jwk = function
36
+
| Es256 { pub; _ } ->
37
+
let x, y = p256_xy pub in
38
+
Fmt.str "{\"crv\":\"P-256\",\"kty\":\"EC\",\"x\":%S,\"y\":%S}" (b64url x)
39
+
(b64url y)
40
+
| Ed { pub; _ } ->
41
+
let x = Crypto_ec.Ed25519.pub_to_octets pub in
42
+
Fmt.str "{\"crv\":\"Ed25519\",\"kty\":\"OKP\",\"x\":%S}" (b64url x)
43
+
44
+
let public_jwk k = canonical_jwk k
45
+
46
+
let thumbprint k =
47
+
let canonical = canonical_jwk k in
48
+
let hash = Digestif.SHA256.(digest_string canonical |> to_raw_string) in
49
+
b64url hash
50
+
51
+
let access_token_hash at =
52
+
let hash = Digestif.SHA256.(digest_string at |> to_raw_string) in
53
+
b64url hash
54
+
55
+
(* ECDSA P-256 signatures in JOSE (RFC 7518 §3.4) are the fixed-width
56
+
concatenation r || s of the two 32-byte unsigned big-endian integers.
57
+
[Crypto_ec.P256.Dsa.sign] already returns each component as a 32-byte
58
+
string (F.to_be_octets is fixed-width at byte_length); defend against
59
+
any future change by padding if needed. *)
60
+
let p1363_signature ~byte_length (r, s) =
61
+
let pad x =
62
+
let len = String.length x in
63
+
if len = byte_length then x
64
+
else if len < byte_length then String.make (byte_length - len) '\x00' ^ x
65
+
else invalid_arg "ECDSA signature component larger than curve"
66
+
in
67
+
pad r ^ pad s
68
+
69
+
let sign_message key message =
70
+
match key with
71
+
| Es256 { priv; _ } ->
72
+
let digest = Digestif.SHA256.(digest_string message |> to_raw_string) in
73
+
let rs = Crypto_ec.P256.Dsa.sign ~key:priv digest in
74
+
p1363_signature ~byte_length:32 rs
75
+
| Ed { priv; _ } -> Crypto_ec.Ed25519.sign ~key:priv message
76
+
77
+
let alg_string = function ES256 -> "ES256" | EdDSA -> "EdDSA"
78
+
79
+
(* Build the JWS header as a canonical JSON string. Lexicographic key order
80
+
and no whitespace so the same key produces byte-identical headers on
81
+
every call; the server does not require canonical form but reproducibility
82
+
helps testing. *)
83
+
let header_json key =
84
+
Fmt.str "{\"alg\":\"%s\",\"jwk\":%s,\"typ\":\"dpop+jwt\"}"
85
+
(alg_string (alg key))
86
+
(canonical_jwk key)
87
+
88
+
(* Payload: canonical order (ath, htm, htu, iat, jti, nonce) omitting
89
+
missing optional claims. Values are well-formed (base64url, ASCII method,
90
+
ASCII URL, integer, base64url, opaque string from the server) so simple
91
+
%S quoting suffices for everything except [iat] which is a JSON number. *)
92
+
let payload_json ~jti ~htm ~htu ~iat ?nonce ?ath () =
93
+
let buf = Buffer.create 128 in
94
+
Buffer.add_char buf '{';
95
+
let sep = ref "" in
96
+
let add_string k v =
97
+
Buffer.add_string buf !sep;
98
+
Buffer.add_string buf (Fmt.str "%S:%S" k v);
99
+
sep := ","
100
+
in
101
+
let add_int k v =
102
+
Buffer.add_string buf !sep;
103
+
Buffer.add_string buf (Fmt.str "%S:%d" k v);
104
+
sep := ","
105
+
in
106
+
Option.iter (fun v -> add_string "ath" v) ath;
107
+
add_string "htm" htm;
108
+
add_string "htu" htu;
109
+
add_int "iat" iat;
110
+
add_string "jti" jti;
111
+
Option.iter (fun v -> add_string "nonce" v) nonce;
112
+
Buffer.add_char buf '}';
113
+
Buffer.contents buf
114
+
115
+
let default_jti () = b64url (Crypto_rng.generate 16)
116
+
117
+
let proof key ~htm ~htu ?nonce ?ath ?jti ?iat () =
118
+
let jti = match jti with Some j -> j | None -> default_jti () in
119
+
let iat =
120
+
match iat with
121
+
| Some t -> int_of_float t
122
+
| None -> int_of_float (Unix.time ())
123
+
in
124
+
let header = header_json key in
125
+
let payload = payload_json ~jti ~htm ~htu ~iat ?nonce ?ath () in
126
+
let h = b64url header in
127
+
let p = b64url payload in
128
+
let signing_input = h ^ "." ^ p in
129
+
let signature = sign_message key signing_input in
130
+
h ^ "." ^ p ^ "." ^ b64url signature
+104
lib/dpop.mli
+104
lib/dpop.mli
···
1
+
(** DPoP (Demonstrating Proof-of-Possession) per
2
+
{{:https://datatracker.ietf.org/doc/html/rfc9449} RFC 9449}.
3
+
4
+
DPoP binds an OAuth access token to a public key held by the client, so that
5
+
a leaked bearer token cannot be replayed by an attacker who does not also
6
+
hold the corresponding private key.
7
+
8
+
The client generates a key pair once (typically per session), attaches the
9
+
public JWK to every token-endpoint and resource request as a DPoP {i proof}
10
+
(a JWT signed with the private key), and the authorization server binds the
11
+
issued access token to the public key via its JWK thumbprint
12
+
({{:https://datatracker.ietf.org/doc/html/rfc7638} RFC 7638}).
13
+
14
+
This module only supports asymmetric algorithms with no private material
15
+
leakage in the public representation:
16
+
17
+
- {b ES256} — ECDSA using P-256 and SHA-256 (RFC 7518 §3.4). Mandatory for
18
+
DPoP implementations (RFC 9449 §5.1).
19
+
- {b EdDSA} — Ed25519 (RFC 8037). Compact and fast; recommended when
20
+
supported by the authorization server.
21
+
22
+
{b Example}
23
+
{[
24
+
(* 1. Generate a per-session key. *)
25
+
let key = Dpop.generate ES256 in
26
+
27
+
(* 2. Attach a proof to every token/resource request. *)
28
+
let proof =
29
+
Dpop.proof key ~htm:"POST" ~htu:"https://as.example.com/token" ()
30
+
in
31
+
let headers = [ ("DPoP", proof) ] in
32
+
33
+
(* 3. On resource requests, bind the proof to the access token. *)
34
+
let ath = Dpop.access_token_hash "gho_abc..." in
35
+
let proof =
36
+
Dpop.proof key ~htm:"GET" ~htu:"https://api.example.com/me" ~ath ()
37
+
in
38
+
ignore proof
39
+
]} *)
40
+
41
+
(** {1 Keys and algorithms} *)
42
+
43
+
(** Asymmetric signing algorithm. *)
44
+
type alg = ES256 (** ECDSA P-256 + SHA-256. *) | EdDSA (** Ed25519. *)
45
+
46
+
type key
47
+
(** A DPoP key pair. The private material is held internally; {!public_jwk}
48
+
exposes only the public coordinates. *)
49
+
50
+
val generate : alg -> key
51
+
(** [generate alg] generates a fresh DPoP key pair.
52
+
53
+
@raise Crypto_rng.Unseeded_generator if the RNG is not seeded. *)
54
+
55
+
val alg : key -> alg
56
+
(** [alg k] is the algorithm bound to the key. *)
57
+
58
+
(** {1 Public key export} *)
59
+
60
+
val public_jwk : key -> string
61
+
(** [public_jwk k] is the public JWK of [k] in RFC 7638 canonical form
62
+
(lexicographic keys, no whitespace). This is the exact string whose SHA-256
63
+
is the thumbprint, and it is also safe to embed in a JWS header verbatim. *)
64
+
65
+
val thumbprint : key -> string
66
+
(** [thumbprint k] is the base64url (no padding) of SHA-256 of the canonical JWK
67
+
per {{:https://datatracker.ietf.org/doc/html/rfc7638} RFC 7638}. The
68
+
authorization server uses this value as the [jkt] confirmation claim (RFC
69
+
9449 §6.1). *)
70
+
71
+
(** {1 Proofs} *)
72
+
73
+
val proof :
74
+
key ->
75
+
htm:string ->
76
+
htu:string ->
77
+
?nonce:string ->
78
+
?ath:string ->
79
+
?jti:string ->
80
+
?iat:float ->
81
+
unit ->
82
+
string
83
+
(** [proof k ~htm ~htu ?nonce ?ath ?jti ?iat ()] is a compact JWS DPoP proof per
84
+
RFC 9449 §4.
85
+
86
+
- [htm] is the HTTP method of the request the proof will accompany, e.g.
87
+
["POST"], ["GET"].
88
+
- [htu] is the HTTP target URI {b without} query or fragment components
89
+
(§4.2). The caller is responsible for stripping them.
90
+
- [nonce] is included when the server has challenged with a [DPoP-Nonce]
91
+
response header (§8).
92
+
- [ath] is base64url(SHA-256(access_token)), required on resource requests
93
+
(§4.3). Use {!access_token_hash} to compute it.
94
+
- [jti] defaults to 16 random bytes base64url-encoded; callers may supply
95
+
their own unique identifier.
96
+
- [iat] defaults to [Unix.time ()]; callers may supply a monotonic or
97
+
Eio-clock-derived time instead.
98
+
99
+
@raise Crypto_rng.Unseeded_generator
100
+
if [jti] is not supplied and the RNG is unseeded. *)
101
+
102
+
val access_token_hash : string -> string
103
+
(** [access_token_hash at] is the base64url (no padding) of SHA-256 of [at].
104
+
Intended as the [ath] argument of {!proof} on resource requests. *)
+4
lib/dune
+4
lib/dune
+3
test/dune
+3
test/dune
+3
test/test.ml
+3
test/test.ml
+286
test/test_dpop.ml
+286
test/test_dpop.ml
···
1
+
(* Split a compact JWS into its three base64url segments. *)
2
+
let split_compact s =
3
+
match String.split_on_char '.' s with
4
+
| [ h; p; sg ] -> (h, p, sg)
5
+
| _ -> Alcotest.failf "expected three JWS segments, got %S" s
6
+
7
+
let b64url_decode s =
8
+
Base64.decode_exn ~pad:false ~alphabet:Base64.uri_safe_alphabet s
9
+
10
+
(* -- Thumbprint and JWK stability --------------------------------- *)
11
+
12
+
let test_es256_public_jwk_canonical_order () =
13
+
let k = Dpop.generate ES256 in
14
+
let jwk = Dpop.public_jwk k in
15
+
(* RFC 7638 canonical: members in lexicographic order, no whitespace.
16
+
The four EC JWK members are crv, kty, x, y. *)
17
+
Alcotest.(check bool)
18
+
"starts with crv" true
19
+
(String.length jwk > 7 && String.sub jwk 0 8 = "{\"crv\":\"");
20
+
Alcotest.(check bool)
21
+
"contains P-256" true
22
+
(let rec find i =
23
+
if i + 5 > String.length jwk then false
24
+
else if String.sub jwk i 5 = "P-256" then true
25
+
else find (i + 1)
26
+
in
27
+
find 0);
28
+
(* Order check: kty appears after crv, x after kty, y after x. *)
29
+
let find_after sub offset =
30
+
let rec go i =
31
+
if i + String.length sub > String.length jwk then -1
32
+
else if String.sub jwk i (String.length sub) = sub then i
33
+
else go (i + 1)
34
+
in
35
+
go offset
36
+
in
37
+
let crv = find_after "\"crv\"" 0 in
38
+
let kty = find_after "\"kty\"" 0 in
39
+
let x = find_after "\"x\"" 0 in
40
+
let y = find_after "\"y\"" 0 in
41
+
Alcotest.(check bool) "crv < kty < x < y" true (crv < kty && kty < x && x < y)
42
+
43
+
let test_eddsa_public_jwk_canonical_order () =
44
+
let k = Dpop.generate EdDSA in
45
+
let jwk = Dpop.public_jwk k in
46
+
Alcotest.(check bool)
47
+
"starts with crv" true
48
+
(String.length jwk > 7 && String.sub jwk 0 8 = "{\"crv\":\"");
49
+
Alcotest.(check bool)
50
+
"contains Ed25519" true
51
+
(let rec find i =
52
+
if i + 7 > String.length jwk then false
53
+
else if String.sub jwk i 7 = "Ed25519" then true
54
+
else find (i + 1)
55
+
in
56
+
find 0)
57
+
58
+
let test_thumbprint_matches_sha256_of_jwk () =
59
+
let k = Dpop.generate ES256 in
60
+
let jwk = Dpop.public_jwk k in
61
+
let expected =
62
+
Base64.encode_exn ~pad:false ~alphabet:Base64.uri_safe_alphabet
63
+
Digestif.SHA256.(digest_string jwk |> to_raw_string)
64
+
in
65
+
Alcotest.(check string) "thumbprint" expected (Dpop.thumbprint k)
66
+
67
+
let test_thumbprint_stable_across_calls () =
68
+
let k = Dpop.generate EdDSA in
69
+
Alcotest.(check string)
70
+
"same thumbprint twice" (Dpop.thumbprint k) (Dpop.thumbprint k)
71
+
72
+
let test_thumbprint_differs_between_keys () =
73
+
let a = Dpop.generate ES256 in
74
+
let b = Dpop.generate ES256 in
75
+
Alcotest.(check bool)
76
+
"fresh keys have distinct thumbprints" true
77
+
(Dpop.thumbprint a <> Dpop.thumbprint b)
78
+
79
+
(* -- Access-token hash ------------------------------------------- *)
80
+
81
+
let test_access_token_hash_known_vector () =
82
+
(* RFC 9449 §4.3 Example: access_token = "Kz~8mXK1EalYznwH-LC-1fBAo.4Ljp~zsPE_NeO.gxU"
83
+
ath (base64url of sha256) = "fUHyO2r2Z3DZ53EsNrWBb0xWXoaNy59IiKCAqksmQEo". *)
84
+
let at = "Kz~8mXK1EalYznwH-LC-1fBAo.4Ljp~zsPE_NeO.gxU" in
85
+
Alcotest.(check string)
86
+
"RFC 9449 §4.3 example" "fUHyO2r2Z3DZ53EsNrWBb0xWXoaNy59IiKCAqksmQEo"
87
+
(Dpop.access_token_hash at)
88
+
89
+
(* -- Proof structure --------------------------------------------- *)
90
+
91
+
let test_proof_has_three_segments () =
92
+
let k = Dpop.generate ES256 in
93
+
let p = Dpop.proof k ~htm:"POST" ~htu:"https://as.example.com/token" () in
94
+
let _ = split_compact p in
95
+
()
96
+
97
+
let test_proof_header_claims () =
98
+
let k = Dpop.generate ES256 in
99
+
let p = Dpop.proof k ~htm:"GET" ~htu:"https://api/me" () in
100
+
let h, _, _ = split_compact p in
101
+
let decoded = b64url_decode h in
102
+
Alcotest.(check bool)
103
+
"typ=dpop+jwt" true
104
+
(let rec find i =
105
+
if i + 15 > String.length decoded then false
106
+
else if String.sub decoded i 15 = "\"typ\":\"dpop+jwt" then true
107
+
else find (i + 1)
108
+
in
109
+
find 0);
110
+
Alcotest.(check bool)
111
+
"alg=ES256" true
112
+
(let rec find i =
113
+
if i + 13 > String.length decoded then false
114
+
else if String.sub decoded i 13 = "\"alg\":\"ES256\"" then true
115
+
else find (i + 1)
116
+
in
117
+
find 0);
118
+
Alcotest.(check bool)
119
+
"jwk present" true
120
+
(let rec find i =
121
+
if i + 7 > String.length decoded then false
122
+
else if String.sub decoded i 7 = "\"jwk\":{" then true
123
+
else find (i + 1)
124
+
in
125
+
find 0)
126
+
127
+
let contains sub s =
128
+
let n = String.length sub in
129
+
let rec go i =
130
+
if i + n > String.length s then false
131
+
else if String.sub s i n = sub then true
132
+
else go (i + 1)
133
+
in
134
+
go 0
135
+
136
+
let test_proof_payload_required_claims () =
137
+
let k = Dpop.generate EdDSA in
138
+
let p =
139
+
Dpop.proof k ~htm:"POST" ~htu:"https://as/token" ~iat:1700000000.0
140
+
~jti:"jti-xyz" ()
141
+
in
142
+
let _, payload, _ = split_compact p in
143
+
let decoded = b64url_decode payload in
144
+
Alcotest.(check bool) "htm=POST" true (contains "\"htm\":\"POST\"" decoded);
145
+
Alcotest.(check bool)
146
+
"htu=https://as/token" true
147
+
(contains "\"htu\":\"https://as/token\"" decoded);
148
+
Alcotest.(check bool)
149
+
"iat integer" true
150
+
(contains "\"iat\":1700000000" decoded);
151
+
Alcotest.(check bool) "jti" true (contains "\"jti\":\"jti-xyz\"" decoded);
152
+
Alcotest.(check bool) "no ath" false (contains "\"ath\"" decoded);
153
+
Alcotest.(check bool) "no nonce" false (contains "\"nonce\"" decoded)
154
+
155
+
let test_proof_payload_optional_claims () =
156
+
let k = Dpop.generate ES256 in
157
+
let p =
158
+
Dpop.proof k ~htm:"GET" ~htu:"https://api/x" ~nonce:"srv-nonce"
159
+
~ath:"ath-hash" ~jti:"j" ~iat:1000.0 ()
160
+
in
161
+
let _, payload, _ = split_compact p in
162
+
let decoded = b64url_decode payload in
163
+
Alcotest.(check bool)
164
+
"ath included" true
165
+
(contains "\"ath\":\"ath-hash\"" decoded);
166
+
Alcotest.(check bool)
167
+
"nonce included" true
168
+
(contains "\"nonce\":\"srv-nonce\"" decoded)
169
+
170
+
(* -- Signature verification (roundtrip) -------------------------- *)
171
+
172
+
(* Extract the EC x,y coordinates from a canonical EC JWK string. Assumes
173
+
exact byte layout produced by Dpop.public_jwk. *)
174
+
let extract_xy_b64 jwk =
175
+
let idx_of needle =
176
+
let n = String.length needle in
177
+
let rec go i =
178
+
if i + n > String.length jwk then -1
179
+
else if String.sub jwk i n = needle then i
180
+
else go (i + 1)
181
+
in
182
+
go 0
183
+
in
184
+
let read_string_value label =
185
+
let key = Fmt.str "\"%s\":\"" label in
186
+
let i = idx_of key in
187
+
if i < 0 then Alcotest.failf "missing %s in %S" label jwk
188
+
else
189
+
let start = i + String.length key in
190
+
let j = String.index_from jwk start '"' in
191
+
String.sub jwk start (j - start)
192
+
in
193
+
(read_string_value "x", read_string_value "y")
194
+
195
+
let extract_x_b64 jwk =
196
+
let key = "\"x\":\"" in
197
+
let n = String.length key in
198
+
let rec find i =
199
+
if i + n > String.length jwk then -1
200
+
else if String.sub jwk i n = key then i
201
+
else find (i + 1)
202
+
in
203
+
let i = find 0 in
204
+
if i < 0 then Alcotest.failf "missing x in %S" jwk
205
+
else
206
+
let start = i + n in
207
+
let j = String.index_from jwk start '"' in
208
+
String.sub jwk start (j - start)
209
+
210
+
let test_es256_signature_verifies () =
211
+
let k = Dpop.generate ES256 in
212
+
let p = Dpop.proof k ~htm:"POST" ~htu:"https://as/token" () in
213
+
let h, pl, sg = split_compact p in
214
+
let jwk = Dpop.public_jwk k in
215
+
let x, y = extract_xy_b64 jwk in
216
+
let pub_octets = "\x04" ^ b64url_decode x ^ b64url_decode y in
217
+
let pub =
218
+
match Crypto_ec.P256.Dsa.pub_of_octets pub_octets with
219
+
| Ok p -> p
220
+
| Error _ -> Alcotest.fail "rebuilding P-256 pub failed"
221
+
in
222
+
let sig_bytes = b64url_decode sg in
223
+
Alcotest.(check int) "signature length" 64 (String.length sig_bytes);
224
+
let r = String.sub sig_bytes 0 32 in
225
+
let s = String.sub sig_bytes 32 32 in
226
+
let msg = h ^ "." ^ pl in
227
+
let digest = Digestif.SHA256.(digest_string msg |> to_raw_string) in
228
+
Alcotest.(check bool)
229
+
"ES256 verifies" true
230
+
(Crypto_ec.P256.Dsa.verify ~key:pub (r, s) digest)
231
+
232
+
let test_eddsa_signature_verifies () =
233
+
let k = Dpop.generate EdDSA in
234
+
let p = Dpop.proof k ~htm:"POST" ~htu:"https://as/token" () in
235
+
let h, pl, sg = split_compact p in
236
+
let jwk = Dpop.public_jwk k in
237
+
let x = extract_x_b64 jwk in
238
+
let pub_octets = b64url_decode x in
239
+
let pub =
240
+
match Crypto_ec.Ed25519.pub_of_octets pub_octets with
241
+
| Ok p -> p
242
+
| Error _ -> Alcotest.fail "rebuilding Ed25519 pub failed"
243
+
in
244
+
let sig_bytes = b64url_decode sg in
245
+
Alcotest.(check bool)
246
+
"EdDSA verifies" true
247
+
(Crypto_ec.Ed25519.verify ~key:pub sig_bytes ~msg:(h ^ "." ^ pl))
248
+
249
+
let test_proof_jti_default_unique () =
250
+
let k = Dpop.generate ES256 in
251
+
let p1 = Dpop.proof k ~htm:"GET" ~htu:"https://a" () in
252
+
let p2 = Dpop.proof k ~htm:"GET" ~htu:"https://a" () in
253
+
(* Either the jti or the signature (randomized k in ECDSA) differs. For
254
+
DPoP the jti MUST be unique per proof so this test would fail if the
255
+
default jti collided. *)
256
+
Alcotest.(check bool) "two proofs differ" true (p1 <> p2)
257
+
258
+
let suite =
259
+
( "dpop",
260
+
[
261
+
Alcotest.test_case "ES256 JWK canonical order" `Quick
262
+
test_es256_public_jwk_canonical_order;
263
+
Alcotest.test_case "EdDSA JWK canonical order" `Quick
264
+
test_eddsa_public_jwk_canonical_order;
265
+
Alcotest.test_case "thumbprint = sha256(JWK)" `Quick
266
+
test_thumbprint_matches_sha256_of_jwk;
267
+
Alcotest.test_case "thumbprint stable" `Quick
268
+
test_thumbprint_stable_across_calls;
269
+
Alcotest.test_case "distinct keys distinct thumbprints" `Quick
270
+
test_thumbprint_differs_between_keys;
271
+
Alcotest.test_case "RFC 9449 §4.3 ath vector" `Quick
272
+
test_access_token_hash_known_vector;
273
+
Alcotest.test_case "proof has three segments" `Quick
274
+
test_proof_has_three_segments;
275
+
Alcotest.test_case "proof header claims" `Quick test_proof_header_claims;
276
+
Alcotest.test_case "proof required claims" `Quick
277
+
test_proof_payload_required_claims;
278
+
Alcotest.test_case "proof optional claims" `Quick
279
+
test_proof_payload_optional_claims;
280
+
Alcotest.test_case "ES256 signature verifies" `Quick
281
+
test_es256_signature_verifies;
282
+
Alcotest.test_case "EdDSA signature verifies" `Quick
283
+
test_eddsa_signature_verifies;
284
+
Alcotest.test_case "default jti unique" `Quick
285
+
test_proof_jti_default_unique;
286
+
] )