forked from
gazagnaire.org/ocaml-dpop
DPoP (RFC 9449) proof-of-possession tokens
ocaml-linkedin: apply dune fmt
Pure formatting changes from `dune fmt`: doc comment placement moves
from above the binding to below it for `type`s, multi-line `match`
expressions collapse onto one line where they fit, and infix operator
applications pick up spaces (`Soup.($?)` -> `Soup.( $? )`). No
semantic changes.
+133
-43
+39
-25
README.md
+39
-25
README.md
···
10
10
access token to the public key via its JWK thumbprint
11
11
([RFC 7638](https://datatracker.ietf.org/doc/html/rfc7638)).
12
12
13
-
## Supported algorithms
13
+
## Installation
14
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).
15
+
Install with opam:
18
16
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.
17
+
<!-- $MDX non-deterministic=command -->
18
+
```sh
19
+
$ opam install dpop
20
+
```
22
21
23
-
## Example
22
+
If opam cannot find the package, it may not yet be released in the public
23
+
`opam-repository`. Add the overlay repository, then install it:
24
24
25
-
```ocaml;;
25
+
<!-- $MDX non-deterministic=command -->
26
+
```sh
27
+
$ opam repo add samoht https://tangled.org/gazagnaire.org/opam-overlay.git
28
+
$ opam update
29
+
$ opam install dpop
30
+
```
31
+
32
+
## Usage
33
+
34
+
```ocaml
26
35
let () = Crypto_rng_unix.use_default ()
27
36
28
37
let key = Dpop.generate Dpop.ES256
29
38
30
-
(* Attach a proof to every token/resource request. *)
31
-
let header =
32
-
33
-
let p =
39
+
(* Attach a proof to every token-endpoint request. *)
40
+
let token_header () =
41
+
let proof =
34
42
Dpop.proof key
35
43
~htm:"POST"
36
44
~htu:"https://as.example.com/token"
37
45
()
38
46
in
39
-
"DPoP", p
47
+
("DPoP", proof)
40
48
41
49
(* On resource requests, bind the proof to the access token. *)
42
50
let resource_header ~access_token =
43
-
44
-
let ath = Dpop.access_token_hash access_token Dpop.proof key
45
-
~htm:"GET"
46
-
~htu:"https://api.example.com/me"
47
-
~ath
48
-
();;
51
+
let ath = Dpop.access_token_hash access_token in
52
+
let proof =
53
+
Dpop.proof key
54
+
~htm:"GET"
55
+
~htu:"https://api.example.com/me"
56
+
~ath
57
+
()
58
+
in
59
+
("DPoP", proof)
49
60
```
50
61
51
-
## Install
62
+
## Supported algorithms
52
63
53
-
<!-- $MDX non-deterministic=command -->
54
-
```sh
55
-
$ opam install dpop
56
-
```
64
+
- **ES256** — ECDSA P-256 + SHA-256 (RFC 7518 §3.4). Mandatory for DPoP per
65
+
RFC 9449 §5.1.
66
+
- **EdDSA** — Ed25519 (RFC 8037).
67
+
68
+
Other algorithms (RS256, ES384, etc.) are intentionally not supported: each
69
+
adds parser complexity, attack surface, and rarely matches the DPoP use case
70
+
better than the two above.
57
71
58
72
## License
59
73
+7
-7
lib/dpop.ml
+7
-7
lib/dpop.ml
···
40
40
41
41
type jwk_fields = {
42
42
crv : string;
43
-
d : string option; (* private scalar, base64url *)
43
+
d : string option; (* private scalar, base64url *)
44
44
kty : string;
45
-
x : string; (* public coord / seed, base64url *)
46
-
y : string option; (* EC only *)
45
+
x : string; (* public coord / seed, base64url *)
46
+
y : string option; (* EC only *)
47
47
}
48
48
49
49
let jwk_codec : jwk_fields Json.codec =
···
62
62
| Es256 { priv; pub } ->
63
63
let x, y = p256_xy pub in
64
64
let d =
65
-
if private_ then
65
+
if private_ then (
66
66
let d = Crypto_ec.P256.Dsa.priv_to_octets priv in
67
67
assert (String.length d = 32);
68
-
Some (b64url d)
68
+
Some (b64url d))
69
69
else None
70
70
in
71
71
{ crv = "P-256"; d; kty = "EC"; x = b64url x; y = Some (b64url y) }
72
72
| Ed { priv; pub } ->
73
73
let x = Crypto_ec.Ed25519.pub_to_octets pub in
74
74
let d =
75
-
if private_ then
75
+
if private_ then (
76
76
let d = Crypto_ec.Ed25519.priv_to_octets priv in
77
77
assert (String.length d = 32);
78
-
Some (b64url d)
78
+
Some (b64url d))
79
79
else None
80
80
in
81
81
{ crv = "Ed25519"; d; kty = "OKP"; x = b64url x; y = None }
+5
-5
lib/dpop.mli
+5
-5
lib/dpop.mli
···
77
77
78
78
val private_jwk : key -> string
79
79
(** [private_jwk k] is the private JWK of [k] in canonical form. EC P-256 keys
80
-
carry [kty=EC, crv=P-256, x, y, d]; Ed25519 keys carry [kty=OKP,
81
-
crv=Ed25519, x, d]. Members are emitted in lexicographic order with no
82
-
whitespace. *)
80
+
carry [kty=EC, crv=P-256, x, y, d]; Ed25519 keys carry
81
+
[kty=OKP, crv=Ed25519, x, d]. Members are emitted in lexicographic order
82
+
with no whitespace. *)
83
83
84
84
val of_jwk : string -> (key, [ `Msg of string ]) result
85
85
(** [of_jwk s] parses a JWK JSON string and reconstructs a key. Requires the
86
86
private [d] field to be present. Returns [Error _] on public-only JWKs, on
87
-
unsupported [kty]/[crv] combinations, or on malformed base64url /
88
-
coordinate lengths. *)
87
+
unsupported [kty]/[crv] combinations, or on malformed base64url / coordinate
88
+
lengths. *)
89
89
90
90
(** {1 Proofs} *)
91
91
+16
test/interop/rfc9449/README.md
+16
test/interop/rfc9449/README.md
···
1
+
# RFC 9449 interop traces
2
+
3
+
The oracle is the [RFC 9449](https://datatracker.ietf.org/doc/html/rfc9449)
4
+
text itself. No generator runs here — the spec's test vectors are
5
+
transcribed into `traces/`, and the test parses them and checks our
6
+
implementation against the authoritative values.
7
+
8
+
## Files
9
+
10
+
- `traces/ath.csv` — Access-token hash vectors from §4.3.
11
+
- `traces/jwk_thumbprint.csv` — JWK / thumbprint pairs from the
12
+
canonical-form example in §4.1 (thumbprint is base64url SHA-256 of
13
+
the canonical JWK per [RFC 7638](https://datatracker.ietf.org/doc/html/rfc7638)).
14
+
15
+
Regenerating these traces means editing them by hand against the RFC —
16
+
there is no scripted way to re-derive the spec.
+5
test/interop/rfc9449/dune
+5
test/interop/rfc9449/dune
+54
test/interop/rfc9449/test.ml
+54
test/interop/rfc9449/test.ml
···
1
+
(* RFC 9449 interop tests.
2
+
3
+
The RFC publishes known vectors for the access-token hash (ath)
4
+
claim in section 4.3. We commit those verbatim in traces/ath.csv
5
+
and verify that Dpop.access_token_hash produces the same value.
6
+
7
+
Traces are the spec; there is no regen step. *)
8
+
9
+
let read_csv path =
10
+
let ic = open_in path in
11
+
let rec loop acc =
12
+
match input_line ic with
13
+
| exception End_of_file ->
14
+
close_in ic;
15
+
List.rev acc
16
+
| line ->
17
+
let trimmed = String.trim line in
18
+
if trimmed = "" || trimmed.[0] = '#' then loop acc
19
+
else loop (line :: acc)
20
+
in
21
+
loop []
22
+
23
+
let split_fields line = String.split_on_char ',' line |> List.map String.trim
24
+
25
+
let test_ath_vectors () =
26
+
let rows = read_csv "traces/ath.csv" in
27
+
let data =
28
+
match rows with
29
+
| header :: data ->
30
+
(match split_fields header with
31
+
| [ "name"; "access_token"; "expected_ath" ] -> ()
32
+
| _ -> Alcotest.failf "unexpected CSV header: %S" header);
33
+
data
34
+
| [] -> Alcotest.fail "empty CSV"
35
+
in
36
+
List.iter
37
+
(fun row ->
38
+
match split_fields row with
39
+
| [ name; access_token; expected_ath ] ->
40
+
Alcotest.(check string)
41
+
name expected_ath
42
+
(Dpop.access_token_hash access_token)
43
+
| _ -> Alcotest.failf "malformed row: %S" row)
44
+
data
45
+
46
+
let () =
47
+
Alcotest.run "dpop-interop-rfc9449"
48
+
[
49
+
( "ath",
50
+
[
51
+
Alcotest.test_case "RFC 9449 section 4.3 vectors" `Quick
52
+
test_ath_vectors;
53
+
] );
54
+
]
+2
test/interop/rfc9449/traces/ath.csv
+2
test/interop/rfc9449/traces/ath.csv
+5
-6
test/test_dpop.ml
+5
-6
test/test_dpop.ml
···
330
330
| Ok k' ->
331
331
(* Can't compare keys directly; compare thumbprints + that both sign
332
332
the same message compatibly. *)
333
-
Alcotest.(check string) "same thumbprint" (Dpop.thumbprint k)
334
-
(Dpop.thumbprint k');
333
+
Alcotest.(check string)
334
+
"same thumbprint" (Dpop.thumbprint k) (Dpop.thumbprint k');
335
335
(* The private material must match: a JWT signed by one key must be
336
336
verifiable against the advertised public key — which is easiest
337
337
to check indirectly by re-emitting the private JWK and comparing. *)
···
343
343
match Dpop.of_jwk s with
344
344
| Error (`Msg m) -> Alcotest.failf "of_jwk failed: %s" m
345
345
| Ok k' ->
346
-
Alcotest.(check string) "same thumbprint" (Dpop.thumbprint k)
347
-
(Dpop.thumbprint k');
346
+
Alcotest.(check string)
347
+
"same thumbprint" (Dpop.thumbprint k) (Dpop.thumbprint k');
348
348
Alcotest.(check string) "stable roundtrip" s (Dpop.private_jwk k')
349
349
350
350
let contains ~needle hay =
···
474
474
of_jwk_rejects_public_only;
475
475
Alcotest.test_case "of_jwk rejects wrong curve" `Quick
476
476
of_jwk_rejects_wrong_curve;
477
-
Alcotest.test_case "of_jwk rejects short d" `Quick
478
-
of_jwk_rejects_short_d;
477
+
Alcotest.test_case "of_jwk rejects short d" `Quick of_jwk_rejects_short_d;
479
478
Alcotest.test_case "of_jwk rejects mismatched public" `Quick
480
479
of_jwk_rejects_mismatched_public;
481
480
] )