Matter smart home protocol implementation for OCaml
ocaml-matter: Add CASE (Certificate Authenticated Session Establishment)
Implements the Matter CASE protocol for secure session establishment:
- Sigma1/Sigma2/Sigma3 message encoding and decoding
- ECDHE key exchange with P-256
- Session key derivation via HKDF-SHA256
- X.509 certificate handling for Node Operational Certificates
- Full protocol exchange with ECDSA signatures
Includes unit tests (33 passing) and Crowbar fuzz tests.
+1294
-10
+2
-1
dune-project
+2
-1
dune-project
···
21
21
(depends
22
22
(ocaml (>= 4.14))
23
23
(dune-configurator (< 3.21))
24
+
(crypto (>= 0.1))
24
25
(digestif (>= 1.0))
25
26
(eio (>= 1.0))
26
27
(kdf (>= 0.1))
27
28
(mdns (>= 0.1))
28
29
(spake2 (>= 0.1))
29
30
(mirage-crypto (>= 1.0))
30
-
(mirage-crypto-rng (>= 1.0))
31
31
(cstruct (>= 6.0))
32
32
(ipaddr (>= 5.0))
33
33
(domain-name (>= 0.4))
34
34
(logs (>= 0.7))
35
35
(fmt (>= 0.9))
36
+
(x509 (>= 1.0))
36
37
(alcotest :with-test)
37
38
(crowbar :with-test)))
+9
-2
fuzz/dune
+9
-2
fuzz/dune
···
8
8
(modules fuzz_tlv)
9
9
(libraries matter crowbar))
10
10
11
+
(executable
12
+
(name fuzz_case)
13
+
(modules fuzz_case)
14
+
(libraries matter crowbar fmt))
15
+
11
16
(rule
12
17
(alias fuzz)
13
-
(deps fuzz_tlv.exe)
18
+
(deps fuzz_tlv.exe fuzz_case.exe)
14
19
(action
15
-
(run %{exe:fuzz_tlv.exe})))
20
+
(progn
21
+
(run %{exe:fuzz_tlv.exe})
22
+
(run %{exe:fuzz_case.exe}))))
+230
fuzz/fuzz_case.ml
+230
fuzz/fuzz_case.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(* Crowbar-based fuzz testing for Matter CASE message encoding/decoding *)
7
+
8
+
open Crowbar
9
+
module Case = Matter.Case
10
+
11
+
(** {1 Generators} *)
12
+
13
+
(* Generator for 32-byte random values *)
14
+
let random32_gen =
15
+
map [ bytes ] (fun s ->
16
+
let len = String.length s in
17
+
if len >= 32 then String.sub s 0 32 else s ^ String.make (32 - len) '\x00')
18
+
19
+
(* Generator for 65-byte public keys (uncompressed P-256) *)
20
+
let pubkey65_gen =
21
+
map [ bytes ] (fun s ->
22
+
let len = String.length s in
23
+
if len >= 65 then String.sub s 0 65 else s ^ String.make (65 - len) '\x00')
24
+
25
+
(* Generator for session IDs (16-bit) *)
26
+
let session_id_gen = map [ range 65536 ] (fun x -> x)
27
+
28
+
(* Generator for optional bytes *)
29
+
let option_bytes_gen = choose [ const None; map [ bytes ] (fun s -> Some s) ]
30
+
31
+
(* Generator for Sigma1 messages *)
32
+
let sigma1_gen : Case.sigma1 gen =
33
+
map
34
+
[
35
+
random32_gen;
36
+
session_id_gen;
37
+
random32_gen;
38
+
pubkey65_gen;
39
+
option_bytes_gen;
40
+
option_bytes_gen;
41
+
option_bytes_gen;
42
+
]
43
+
(fun
44
+
initiator_random
45
+
initiator_session_id
46
+
destination_id
47
+
initiator_eph_pub_key
48
+
initiator_session_params
49
+
resumption_id
50
+
initiator_resume_mic
51
+
->
52
+
Case.
53
+
{
54
+
initiator_random;
55
+
initiator_session_id;
56
+
destination_id;
57
+
initiator_eph_pub_key;
58
+
initiator_session_params;
59
+
resumption_id;
60
+
initiator_resume_mic;
61
+
})
62
+
63
+
(* Generator for Sigma2 messages *)
64
+
let sigma2_gen : Case.sigma2 gen =
65
+
map [ random32_gen; session_id_gen; pubkey65_gen; bytes; option_bytes_gen ]
66
+
(fun
67
+
responder_random
68
+
responder_session_id
69
+
responder_eph_pub_key
70
+
encrypted2
71
+
responder_session_params
72
+
->
73
+
Case.
74
+
{
75
+
responder_random;
76
+
responder_session_id;
77
+
responder_eph_pub_key;
78
+
encrypted2;
79
+
responder_session_params;
80
+
})
81
+
82
+
(* Generator for Sigma3 messages *)
83
+
let sigma3_gen : Case.sigma3 gen =
84
+
map [ bytes ] (fun encrypted3 -> Case.{ encrypted3 })
85
+
86
+
(** {1 Equality Functions} *)
87
+
88
+
let sigma1_equal (a : Case.sigma1) (b : Case.sigma1) =
89
+
a.initiator_random = b.initiator_random
90
+
&& a.initiator_session_id = b.initiator_session_id
91
+
&& a.destination_id = b.destination_id
92
+
&& a.initiator_eph_pub_key = b.initiator_eph_pub_key
93
+
&& a.initiator_session_params = b.initiator_session_params
94
+
&& a.resumption_id = b.resumption_id
95
+
&& a.initiator_resume_mic = b.initiator_resume_mic
96
+
97
+
let sigma2_equal (a : Case.sigma2) (b : Case.sigma2) =
98
+
a.responder_random = b.responder_random
99
+
&& a.responder_session_id = b.responder_session_id
100
+
&& a.responder_eph_pub_key = b.responder_eph_pub_key
101
+
&& a.encrypted2 = b.encrypted2
102
+
&& a.responder_session_params = b.responder_session_params
103
+
104
+
let sigma3_equal (a : Case.sigma3) (b : Case.sigma3) =
105
+
a.encrypted3 = b.encrypted3
106
+
107
+
(** {1 Pretty Printers} *)
108
+
109
+
let pp_sigma1 ppf (s : Case.sigma1) =
110
+
Fmt.pf ppf
111
+
"Sigma1{random=%d bytes, session_id=%d, dest=%d bytes, eph_pub=%d bytes}"
112
+
(String.length s.initiator_random)
113
+
s.initiator_session_id
114
+
(String.length s.destination_id)
115
+
(String.length s.initiator_eph_pub_key)
116
+
117
+
let pp_sigma2 ppf (s : Case.sigma2) =
118
+
Fmt.pf ppf
119
+
"Sigma2{random=%d bytes, session_id=%d, eph_pub=%d bytes, encrypted=%d \
120
+
bytes}"
121
+
(String.length s.responder_random)
122
+
s.responder_session_id
123
+
(String.length s.responder_eph_pub_key)
124
+
(String.length s.encrypted2)
125
+
126
+
let pp_sigma3 ppf (s : Case.sigma3) =
127
+
Fmt.pf ppf "Sigma3{encrypted=%d bytes}" (String.length s.encrypted3)
128
+
129
+
(** {1 Roundtrip Tests} *)
130
+
131
+
let test_sigma1_roundtrip msg =
132
+
let encoded = Case.encode_sigma1 msg in
133
+
match Case.decode_sigma1 encoded with
134
+
| Ok decoded -> check_eq ~eq:sigma1_equal ~pp:pp_sigma1 msg decoded
135
+
| Error e -> fail ("Sigma1 decode failed: " ^ e)
136
+
137
+
let test_sigma2_roundtrip msg =
138
+
let encoded = Case.encode_sigma2 msg in
139
+
match Case.decode_sigma2 encoded with
140
+
| Ok decoded -> check_eq ~eq:sigma2_equal ~pp:pp_sigma2 msg decoded
141
+
| Error e -> fail ("Sigma2 decode failed: " ^ e)
142
+
143
+
let test_sigma3_roundtrip msg =
144
+
let encoded = Case.encode_sigma3 msg in
145
+
match Case.decode_sigma3 encoded with
146
+
| Ok decoded -> check_eq ~eq:sigma3_equal ~pp:pp_sigma3 msg decoded
147
+
| Error e -> fail ("Sigma3 decode failed: " ^ e)
148
+
149
+
(** {1 No-Crash Tests} *)
150
+
151
+
let test_sigma1_decode_no_crash data =
152
+
let _ = Case.decode_sigma1 data in
153
+
()
154
+
155
+
let test_sigma2_decode_no_crash data =
156
+
let _ = Case.decode_sigma2 data in
157
+
()
158
+
159
+
let test_sigma3_decode_no_crash data =
160
+
let _ = Case.decode_sigma3 data in
161
+
()
162
+
163
+
(** {1 Key Derivation Tests} *)
164
+
165
+
let test_session_keys_deterministic shared initiator_random responder_random
166
+
initiator_pub responder_pub =
167
+
(* Ensure inputs have correct lengths *)
168
+
let pad s len =
169
+
if String.length s >= len then String.sub s 0 len
170
+
else s ^ String.make (len - String.length s) '\x00'
171
+
in
172
+
let shared = pad shared 32 in
173
+
let initiator_random = pad initiator_random 32 in
174
+
let responder_random = pad responder_random 32 in
175
+
let initiator_pub = pad initiator_pub 65 in
176
+
let responder_pub = pad responder_pub 65 in
177
+
178
+
let keys1 =
179
+
Case.derive_session_keys ~shared_secret:shared ~initiator_random
180
+
~responder_random ~initiator_pub ~responder_pub
181
+
in
182
+
let keys2 =
183
+
Case.derive_session_keys ~shared_secret:shared ~initiator_random
184
+
~responder_random ~initiator_pub ~responder_pub
185
+
in
186
+
187
+
check_eq ~pp:(fun ppf s -> Fmt.pf ppf "%S" s) keys1.i2r_key keys2.i2r_key;
188
+
check_eq ~pp:(fun ppf s -> Fmt.pf ppf "%S" s) keys1.r2i_key keys2.r2i_key
189
+
190
+
let test_destination_id_deterministic fabric_id node_id root_pub ipk random =
191
+
(* Ensure inputs have correct lengths *)
192
+
let pad s len =
193
+
if String.length s >= len then String.sub s 0 len
194
+
else s ^ String.make (len - String.length s) '\x00'
195
+
in
196
+
let fabric_id = pad fabric_id 8 in
197
+
let node_id = pad node_id 8 in
198
+
let root_pub = pad root_pub 65 in
199
+
let ipk = pad ipk 16 in
200
+
let random = pad random 32 in
201
+
202
+
let fabric : Case.fabric =
203
+
{ fabric_id; node_id; root_public_key = root_pub; ipk }
204
+
in
205
+
let dest1 = Case.compute_destination_id ~fabric ~initiator_random:random in
206
+
let dest2 = Case.compute_destination_id ~fabric ~initiator_random:random in
207
+
208
+
check_eq ~pp:(fun ppf s -> Fmt.pf ppf "%S" s) dest1 dest2
209
+
210
+
let () =
211
+
(* Sigma message roundtrip tests *)
212
+
add_test ~name:"case: sigma1 roundtrip" [ sigma1_gen ] test_sigma1_roundtrip;
213
+
add_test ~name:"case: sigma2 roundtrip" [ sigma2_gen ] test_sigma2_roundtrip;
214
+
add_test ~name:"case: sigma3 roundtrip" [ sigma3_gen ] test_sigma3_roundtrip;
215
+
216
+
(* No-crash tests for arbitrary input *)
217
+
add_test ~name:"case: sigma1 decode no crash" [ bytes ]
218
+
test_sigma1_decode_no_crash;
219
+
add_test ~name:"case: sigma2 decode no crash" [ bytes ]
220
+
test_sigma2_decode_no_crash;
221
+
add_test ~name:"case: sigma3 decode no crash" [ bytes ]
222
+
test_sigma3_decode_no_crash;
223
+
224
+
(* Key derivation tests *)
225
+
add_test ~name:"case: session keys deterministic"
226
+
[ bytes; bytes; bytes; bytes; bytes ]
227
+
test_session_keys_deterministic;
228
+
add_test ~name:"case: destination id deterministic"
229
+
[ bytes; bytes; bytes; bytes; bytes ]
230
+
test_destination_id_deterministic
+616
lib/case.ml
+616
lib/case.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Matter CASE (Certificate Authenticated Session Establishment).
7
+
8
+
Implementation of the sigma-style key exchange protocol for establishing
9
+
secure sessions between Matter nodes using X.509 certificates. *)
10
+
11
+
let log_src = Logs.Src.create "matter.case"
12
+
13
+
module Log = (val Logs.src_log log_src : Logs.LOG)
14
+
15
+
let ( let* ) = Result.bind
16
+
17
+
(** {1 Types} *)
18
+
19
+
type fabric = {
20
+
fabric_id : string;
21
+
node_id : string;
22
+
root_public_key : string;
23
+
ipk : string;
24
+
}
25
+
26
+
type credentials = {
27
+
noc : X509.Certificate.t;
28
+
icac : X509.Certificate.t option;
29
+
private_key : Crypto_ec.P256.Dsa.priv;
30
+
fabric : fabric;
31
+
}
32
+
33
+
type initiator_state = {
34
+
i_credentials : credentials;
35
+
i_peer_fabric : fabric;
36
+
i_session_id : int;
37
+
i_random : string;
38
+
i_eph_priv : Crypto_ec.P256.Dh.secret;
39
+
i_eph_pub : string;
40
+
}
41
+
42
+
type responder_state = {
43
+
r_credentials : credentials;
44
+
r_session_id : int;
45
+
r_random : string;
46
+
r_eph_priv : Crypto_ec.P256.Dh.secret;
47
+
r_eph_pub : string;
48
+
r_peer_eph_pub : string;
49
+
r_peer_session_id : int;
50
+
r_peer_random : string;
51
+
r_shared_secret : string;
52
+
}
53
+
54
+
type session_keys = {
55
+
i2r_key : string;
56
+
r2i_key : string;
57
+
attestation_challenge : string;
58
+
}
59
+
60
+
type sigma1 = {
61
+
initiator_random : string;
62
+
initiator_session_id : int;
63
+
destination_id : string;
64
+
initiator_eph_pub_key : string;
65
+
initiator_session_params : string option;
66
+
resumption_id : string option;
67
+
initiator_resume_mic : string option;
68
+
}
69
+
70
+
type sigma2 = {
71
+
responder_random : string;
72
+
responder_session_id : int;
73
+
responder_eph_pub_key : string;
74
+
encrypted2 : string;
75
+
responder_session_params : string option;
76
+
}
77
+
78
+
type sigma3 = { encrypted3 : string }
79
+
80
+
(** {1 Constants} *)
81
+
82
+
(** Matter CASE info strings for HKDF *)
83
+
let case_sigma2_info = "Sigma2"
84
+
85
+
let case_sigma3_info = "Sigma3"
86
+
let case_session_keys_info = "SessionKeys"
87
+
let _case_resumption_info = "SessionResumptionKey"
88
+
89
+
(** AES-CCM nonce size for CASE (12 bytes, not 13 like messages) *)
90
+
let case_nonce_size = 13
91
+
92
+
(** {1 Cryptographic Helpers} *)
93
+
94
+
(** Generate ephemeral P-256 key pair, return (private, public_uncompressed) *)
95
+
let generate_ephemeral_keypair () =
96
+
(* Crypto_ec.P256.Dh.gen_key returns (secret, string) where string is public key *)
97
+
Crypto_ec.P256.Dh.gen_key ()
98
+
99
+
(** Perform ECDH key agreement *)
100
+
let ecdh_shared_secret priv peer_pub_bytes =
101
+
match Crypto_ec.P256.Dh.key_exchange priv peer_pub_bytes with
102
+
| Ok shared -> Ok shared
103
+
| Error _ -> Error "ECDH key exchange failed"
104
+
105
+
(** HKDF-SHA256 *)
106
+
let hkdf ~salt ~ikm ~info ~length =
107
+
let prk = Hkdf.extract ~hash:`SHA256 ~salt ikm in
108
+
Hkdf.expand ~hash:`SHA256 ~prk ~info length
109
+
110
+
(** SHA-256 hash *)
111
+
let sha256 s = Digestif.SHA256.(digest_string s |> to_raw_string)
112
+
113
+
(** HMAC-SHA256 *)
114
+
let hmac_sha256 ~key data =
115
+
Digestif.SHA256.(hmac_string ~key data |> to_raw_string)
116
+
117
+
(** Compute destination ID for CASE *)
118
+
let compute_destination_id ~fabric ~initiator_random =
119
+
(* DestinationID = HMAC-SHA256(IPK, RootPubKey || FabricID || NodeID || Random) *)
120
+
let data =
121
+
fabric.root_public_key ^ fabric.fabric_id ^ fabric.node_id
122
+
^ initiator_random
123
+
in
124
+
hmac_sha256 ~key:fabric.ipk data
125
+
126
+
(** Derive session keys from shared secret *)
127
+
let derive_session_keys ~shared_secret ~initiator_random ~responder_random
128
+
~initiator_pub ~responder_pub =
129
+
(* Salt = initiator_random || responder_random || initiator_pub || responder_pub *)
130
+
let salt =
131
+
initiator_random ^ responder_random ^ initiator_pub ^ responder_pub
132
+
in
133
+
let keys =
134
+
hkdf ~salt ~ikm:shared_secret ~info:case_session_keys_info ~length:48
135
+
in
136
+
{
137
+
i2r_key = String.sub keys 0 16;
138
+
r2i_key = String.sub keys 16 16;
139
+
attestation_challenge = String.sub keys 32 16;
140
+
}
141
+
142
+
(** Derive encryption key for Sigma2/Sigma3 *)
143
+
let derive_sigma_key ~shared_secret ~salt ~info =
144
+
(* Key = HKDF(salt, shared_secret, info, 16) *)
145
+
hkdf ~salt ~ikm:shared_secret ~info ~length:16
146
+
147
+
(** Build nonce for CASE encryption (all zeros, 13 bytes) *)
148
+
let case_nonce = String.make case_nonce_size '\x00'
149
+
150
+
(** Encrypt with AES-128-CCM *)
151
+
let aes_ccm_encrypt ~key ~nonce ~adata plaintext =
152
+
Crypto.Aes_ccm.encrypt ~key ~nonce ~adata plaintext
153
+
154
+
(** Decrypt with AES-128-CCM *)
155
+
let aes_ccm_decrypt ~key ~nonce ~adata ciphertext =
156
+
match Crypto.Aes_ccm.decrypt ~key ~nonce ~adata ciphertext with
157
+
| Some pt -> Ok pt
158
+
| None -> Error "AES-CCM decryption/authentication failed"
159
+
160
+
(** Sign with ECDSA P-256 *)
161
+
let ecdsa_sign ~key data =
162
+
let hash = sha256 data in
163
+
let r, s = Crypto_ec.P256.Dsa.sign ~key hash in
164
+
r ^ s
165
+
166
+
(** Verify ECDSA P-256 signature *)
167
+
let ecdsa_verify ~key ~signature data =
168
+
if String.length signature <> 64 then false
169
+
else
170
+
let r = String.sub signature 0 32 in
171
+
let s = String.sub signature 32 32 in
172
+
let hash = sha256 data in
173
+
Crypto_ec.P256.Dsa.verify ~key (r, s) hash
174
+
175
+
(** Extract public key from X.509 certificate *)
176
+
let cert_public_key cert =
177
+
match X509.Certificate.public_key cert with
178
+
| `P256 key -> Ok key
179
+
| _ -> Error "Certificate does not contain P-256 public key"
180
+
181
+
(** Encode certificate to DER *)
182
+
let cert_to_der cert = X509.Certificate.encode_der cert
183
+
184
+
(** {1 TLV Encoding/Decoding} *)
185
+
186
+
(** Sigma1 TLV structure: 1: initiatorRandom (32 bytes) 2: initiatorSessionId
187
+
(uint16) 3: destinationId (32 bytes) 4: initiatorEphPubKey (65 bytes) 5:
188
+
initiatorSessionParams (optional structure) 6: resumptionID (optional bytes)
189
+
7: initiatorResumeMIC (optional bytes) *)
190
+
191
+
let encode_sigma1 msg =
192
+
let elems =
193
+
[
194
+
Tlv.ctx_bytes 1 msg.initiator_random;
195
+
Tlv.ctx_uint 2 msg.initiator_session_id;
196
+
Tlv.ctx_bytes 3 msg.destination_id;
197
+
Tlv.ctx_bytes 4 msg.initiator_eph_pub_key;
198
+
]
199
+
@ (match msg.initiator_session_params with
200
+
| Some p -> [ Tlv.ctx_bytes 5 p ]
201
+
| None -> [])
202
+
@ (match msg.resumption_id with
203
+
| Some r -> [ Tlv.ctx_bytes 6 r ]
204
+
| None -> [])
205
+
@
206
+
match msg.initiator_resume_mic with
207
+
| Some m -> [ Tlv.ctx_bytes 7 m ]
208
+
| None -> []
209
+
in
210
+
Tlv.encode [ Tlv.structure elems ]
211
+
212
+
let decode_sigma1 data =
213
+
let* elems = Tlv.decode data in
214
+
let find_ctx tag elems =
215
+
List.find_opt
216
+
(fun e ->
217
+
match e.Tlv.tag with Tlv.Context_specific t -> t = tag | _ -> false)
218
+
elems
219
+
in
220
+
let find_ctx_opt tag elems =
221
+
match find_ctx tag elems with
222
+
| Some { value = Bytes b; _ } -> Some b
223
+
| _ -> None
224
+
in
225
+
match elems with
226
+
| [ { value = Structure inner; _ } ] -> (
227
+
match
228
+
(find_ctx 1 inner, find_ctx 2 inner, find_ctx 3 inner, find_ctx 4 inner)
229
+
with
230
+
| ( Some { value = Bytes random; _ },
231
+
Some { value = Uint session_id; _ },
232
+
Some { value = Bytes dest_id; _ },
233
+
Some { value = Bytes eph_pub; _ } ) ->
234
+
Ok
235
+
{
236
+
initiator_random = random;
237
+
initiator_session_id = Int64.to_int session_id;
238
+
destination_id = dest_id;
239
+
initiator_eph_pub_key = eph_pub;
240
+
initiator_session_params = find_ctx_opt 5 inner;
241
+
resumption_id = find_ctx_opt 6 inner;
242
+
initiator_resume_mic = find_ctx_opt 7 inner;
243
+
}
244
+
| _ -> Error "Invalid Sigma1 structure: missing required fields")
245
+
| _ -> Error "Invalid Sigma1 structure: expected single structure element"
246
+
247
+
(** Sigma2 TLV structure: 1: responderRandom (32 bytes) 2: responderSessionId
248
+
(uint16) 3: responderEphPubKey (65 bytes) 4: encrypted2 (encrypted TBS2) 5:
249
+
responderSessionParams (optional structure) *)
250
+
251
+
let encode_sigma2 msg =
252
+
let elems =
253
+
[
254
+
Tlv.ctx_bytes 1 msg.responder_random;
255
+
Tlv.ctx_uint 2 msg.responder_session_id;
256
+
Tlv.ctx_bytes 3 msg.responder_eph_pub_key;
257
+
Tlv.ctx_bytes 4 msg.encrypted2;
258
+
]
259
+
@
260
+
match msg.responder_session_params with
261
+
| Some p -> [ Tlv.ctx_bytes 5 p ]
262
+
| None -> []
263
+
in
264
+
Tlv.encode [ Tlv.structure elems ]
265
+
266
+
let decode_sigma2 data =
267
+
let* elems = Tlv.decode data in
268
+
let find_ctx tag elems =
269
+
List.find_opt
270
+
(fun e ->
271
+
match e.Tlv.tag with Tlv.Context_specific t -> t = tag | _ -> false)
272
+
elems
273
+
in
274
+
let find_ctx_opt tag elems =
275
+
match find_ctx tag elems with
276
+
| Some { value = Bytes b; _ } -> Some b
277
+
| _ -> None
278
+
in
279
+
match elems with
280
+
| [ { value = Structure inner; _ } ] -> (
281
+
match
282
+
(find_ctx 1 inner, find_ctx 2 inner, find_ctx 3 inner, find_ctx 4 inner)
283
+
with
284
+
| ( Some { value = Bytes random; _ },
285
+
Some { value = Uint session_id; _ },
286
+
Some { value = Bytes eph_pub; _ },
287
+
Some { value = Bytes encrypted; _ } ) ->
288
+
Ok
289
+
{
290
+
responder_random = random;
291
+
responder_session_id = Int64.to_int session_id;
292
+
responder_eph_pub_key = eph_pub;
293
+
encrypted2 = encrypted;
294
+
responder_session_params = find_ctx_opt 5 inner;
295
+
}
296
+
| _ -> Error "Invalid Sigma2 structure: missing required fields")
297
+
| _ -> Error "Invalid Sigma2 structure: expected single structure element"
298
+
299
+
(** Sigma3 TLV structure: 1: encrypted3 (encrypted TBS3) *)
300
+
301
+
let encode_sigma3 msg =
302
+
Tlv.encode [ Tlv.structure [ Tlv.ctx_bytes 1 msg.encrypted3 ] ]
303
+
304
+
let decode_sigma3 data =
305
+
let* elems = Tlv.decode data in
306
+
let find_ctx tag elems =
307
+
List.find_opt
308
+
(fun e ->
309
+
match e.Tlv.tag with Tlv.Context_specific t -> t = tag | _ -> false)
310
+
elems
311
+
in
312
+
match elems with
313
+
| [ { value = Structure inner; _ } ] -> (
314
+
match find_ctx 1 inner with
315
+
| Some { value = Bytes encrypted; _ } -> Ok { encrypted3 = encrypted }
316
+
| _ -> Error "Invalid Sigma3 structure: missing encrypted3 field")
317
+
| _ -> Error "Invalid Sigma3 structure: expected single structure element"
318
+
319
+
(** Encode TBS2 (to-be-signed data for Sigma2): 1: responderNOC (bytes - DER
320
+
encoded) 2: responderICAC (optional bytes - DER encoded) 3: signature
321
+
(bytes) *)
322
+
let encode_tbs2_inner ~noc ~icac ~signature =
323
+
let elems =
324
+
[ Tlv.ctx_bytes 1 (cert_to_der noc) ]
325
+
@ (match icac with
326
+
| Some c -> [ Tlv.ctx_bytes 2 (cert_to_der c) ]
327
+
| None -> [])
328
+
@ [ Tlv.ctx_bytes 3 signature ]
329
+
in
330
+
Tlv.encode [ Tlv.structure elems ]
331
+
332
+
(** Decode TBS2 inner structure *)
333
+
let decode_tbs2_inner data =
334
+
let* elems = Tlv.decode data in
335
+
let find_ctx tag elems =
336
+
List.find_opt
337
+
(fun e ->
338
+
match e.Tlv.tag with Tlv.Context_specific t -> t = tag | _ -> false)
339
+
elems
340
+
in
341
+
match elems with
342
+
| [ { value = Structure inner; _ } ] -> (
343
+
match (find_ctx 1 inner, find_ctx 3 inner) with
344
+
| Some { value = Bytes noc_der; _ }, Some { value = Bytes signature; _ }
345
+
->
346
+
let icac_opt =
347
+
match find_ctx 2 inner with
348
+
| Some { value = Bytes icac_der; _ } -> Some icac_der
349
+
| _ -> None
350
+
in
351
+
Ok (noc_der, icac_opt, signature)
352
+
| _ -> Error "Invalid TBS2 structure: missing NOC or signature")
353
+
| _ -> Error "Invalid TBS2 structure"
354
+
355
+
(** Build TBS data for signature (Sigma2) *)
356
+
let build_sigma2_tbs ~responder_noc ~responder_icac ~responder_eph_pub
357
+
~initiator_eph_pub ~initiator_random ~responder_random =
358
+
(* TBS2 = responderNOC || responderICAC || responderEphPubKey ||
359
+
initiatorEphPubKey || initiatorRandom || responderRandom *)
360
+
let noc_der = cert_to_der responder_noc in
361
+
let icac_der =
362
+
match responder_icac with Some c -> cert_to_der c | None -> ""
363
+
in
364
+
noc_der ^ icac_der ^ responder_eph_pub ^ initiator_eph_pub ^ initiator_random
365
+
^ responder_random
366
+
367
+
(** Build TBS data for signature (Sigma3) *)
368
+
let build_sigma3_tbs ~initiator_noc ~initiator_icac ~initiator_eph_pub
369
+
~responder_eph_pub ~initiator_random ~responder_random =
370
+
(* TBS3 = initiatorNOC || initiatorICAC || initiatorEphPubKey ||
371
+
responderEphPubKey || initiatorRandom || responderRandom *)
372
+
let noc_der = cert_to_der initiator_noc in
373
+
let icac_der =
374
+
match initiator_icac with Some c -> cert_to_der c | None -> ""
375
+
in
376
+
noc_der ^ icac_der ^ initiator_eph_pub ^ responder_eph_pub ^ initiator_random
377
+
^ responder_random
378
+
379
+
(** {1 Protocol Operations} *)
380
+
381
+
let initiator_start ~credentials ~peer_fabric ~initiator_session_id =
382
+
let random = Crypto_rng.generate 32 in
383
+
let eph_priv, eph_pub = generate_ephemeral_keypair () in
384
+
let destination_id =
385
+
compute_destination_id ~fabric:peer_fabric ~initiator_random:random
386
+
in
387
+
let state =
388
+
{
389
+
i_credentials = credentials;
390
+
i_peer_fabric = peer_fabric;
391
+
i_session_id = initiator_session_id;
392
+
i_random = random;
393
+
i_eph_priv = eph_priv;
394
+
i_eph_pub = eph_pub;
395
+
}
396
+
in
397
+
let sigma1 =
398
+
{
399
+
initiator_random = random;
400
+
initiator_session_id;
401
+
destination_id;
402
+
initiator_eph_pub_key = eph_pub;
403
+
initiator_session_params = None;
404
+
resumption_id = None;
405
+
initiator_resume_mic = None;
406
+
}
407
+
in
408
+
Log.debug (fun m -> m "CASE initiator: generated Sigma1");
409
+
(state, sigma1)
410
+
411
+
let initiator_finish state sigma2 =
412
+
Log.debug (fun m -> m "CASE initiator: processing Sigma2");
413
+
414
+
(* Compute shared secret *)
415
+
let* shared_secret =
416
+
ecdh_shared_secret state.i_eph_priv sigma2.responder_eph_pub_key
417
+
in
418
+
419
+
(* Derive key for decrypting Sigma2 *)
420
+
let salt = state.i_random ^ sigma2.responder_random in
421
+
let s2k = derive_sigma_key ~shared_secret ~salt ~info:case_sigma2_info in
422
+
423
+
(* Decrypt TBS2 *)
424
+
let* tbs2_inner =
425
+
aes_ccm_decrypt ~key:s2k ~nonce:case_nonce ~adata:"" sigma2.encrypted2
426
+
in
427
+
428
+
(* Parse TBS2 inner structure *)
429
+
let* noc_der, icac_der_opt, signature = decode_tbs2_inner tbs2_inner in
430
+
431
+
(* Parse certificates *)
432
+
let* responder_noc =
433
+
match X509.Certificate.decode_der noc_der with
434
+
| Ok c -> Ok c
435
+
| Error (`Msg e) -> Error ("Failed to parse responder NOC: " ^ e)
436
+
in
437
+
let* responder_icac =
438
+
match icac_der_opt with
439
+
| None -> Ok None
440
+
| Some der -> (
441
+
match X509.Certificate.decode_der der with
442
+
| Ok c -> Ok (Some c)
443
+
| Error (`Msg e) -> Error ("Failed to parse responder ICAC: " ^ e))
444
+
in
445
+
446
+
(* Extract responder public key and verify signature *)
447
+
let* responder_pub_key = cert_public_key responder_noc in
448
+
let tbs2 =
449
+
build_sigma2_tbs ~responder_noc ~responder_icac
450
+
~responder_eph_pub:sigma2.responder_eph_pub_key
451
+
~initiator_eph_pub:state.i_eph_pub ~initiator_random:state.i_random
452
+
~responder_random:sigma2.responder_random
453
+
in
454
+
if not (ecdsa_verify ~key:responder_pub_key ~signature tbs2) then
455
+
Error "Sigma2 signature verification failed"
456
+
else begin
457
+
Log.debug (fun m -> m "CASE initiator: Sigma2 signature verified");
458
+
459
+
(* Build Sigma3 *)
460
+
let tbs3 =
461
+
build_sigma3_tbs ~initiator_noc:state.i_credentials.noc
462
+
~initiator_icac:state.i_credentials.icac
463
+
~initiator_eph_pub:state.i_eph_pub
464
+
~responder_eph_pub:sigma2.responder_eph_pub_key
465
+
~initiator_random:state.i_random
466
+
~responder_random:sigma2.responder_random
467
+
in
468
+
let signature3 = ecdsa_sign ~key:state.i_credentials.private_key tbs3 in
469
+
470
+
(* Encode TBS3 inner *)
471
+
let tbs3_inner =
472
+
encode_tbs2_inner ~noc:state.i_credentials.noc
473
+
~icac:state.i_credentials.icac ~signature:signature3
474
+
in
475
+
476
+
(* Encrypt TBS3 *)
477
+
let s3k = derive_sigma_key ~shared_secret ~salt ~info:case_sigma3_info in
478
+
let encrypted3 =
479
+
aes_ccm_encrypt ~key:s3k ~nonce:case_nonce ~adata:"" tbs3_inner
480
+
in
481
+
482
+
(* Derive session keys *)
483
+
let session_keys =
484
+
derive_session_keys ~shared_secret ~initiator_random:state.i_random
485
+
~responder_random:sigma2.responder_random ~initiator_pub:state.i_eph_pub
486
+
~responder_pub:sigma2.responder_eph_pub_key
487
+
in
488
+
489
+
Log.debug (fun m -> m "CASE initiator: generated Sigma3");
490
+
Ok (session_keys, { encrypted3 })
491
+
end
492
+
493
+
let responder_start ~credentials ~(sigma1 : sigma1) ~responder_session_id =
494
+
Log.debug (fun m -> m "CASE responder: processing Sigma1");
495
+
496
+
(* Verify destination_id matches our fabric *)
497
+
let expected_dest_id =
498
+
compute_destination_id ~fabric:credentials.fabric
499
+
~initiator_random:sigma1.initiator_random
500
+
in
501
+
if sigma1.destination_id <> expected_dest_id then
502
+
Error "Sigma1 destination_id does not match our fabric"
503
+
else begin
504
+
let random = Crypto_rng.generate 32 in
505
+
let eph_priv, eph_pub = generate_ephemeral_keypair () in
506
+
507
+
(* Compute shared secret *)
508
+
let* shared_secret =
509
+
ecdh_shared_secret eph_priv sigma1.initiator_eph_pub_key
510
+
in
511
+
512
+
(* Build TBS2 for signature *)
513
+
let tbs2 =
514
+
build_sigma2_tbs ~responder_noc:credentials.noc
515
+
~responder_icac:credentials.icac ~responder_eph_pub:eph_pub
516
+
~initiator_eph_pub:sigma1.initiator_eph_pub_key
517
+
~initiator_random:sigma1.initiator_random ~responder_random:random
518
+
in
519
+
let signature2 = ecdsa_sign ~key:credentials.private_key tbs2 in
520
+
521
+
(* Encode TBS2 inner structure *)
522
+
let tbs2_inner =
523
+
encode_tbs2_inner ~noc:credentials.noc ~icac:credentials.icac
524
+
~signature:signature2
525
+
in
526
+
527
+
(* Encrypt TBS2 *)
528
+
let salt = sigma1.initiator_random ^ random in
529
+
let s2k = derive_sigma_key ~shared_secret ~salt ~info:case_sigma2_info in
530
+
let encrypted2 =
531
+
aes_ccm_encrypt ~key:s2k ~nonce:case_nonce ~adata:"" tbs2_inner
532
+
in
533
+
534
+
let state =
535
+
{
536
+
r_credentials = credentials;
537
+
r_session_id = responder_session_id;
538
+
r_random = random;
539
+
r_eph_priv = eph_priv;
540
+
r_eph_pub = eph_pub;
541
+
r_peer_eph_pub = sigma1.initiator_eph_pub_key;
542
+
r_peer_session_id = sigma1.initiator_session_id;
543
+
r_peer_random = sigma1.initiator_random;
544
+
r_shared_secret = shared_secret;
545
+
}
546
+
in
547
+
548
+
let sigma2 =
549
+
{
550
+
responder_random = random;
551
+
responder_session_id;
552
+
responder_eph_pub_key = eph_pub;
553
+
encrypted2;
554
+
responder_session_params = None;
555
+
}
556
+
in
557
+
558
+
Log.debug (fun m -> m "CASE responder: generated Sigma2");
559
+
Ok (state, sigma2)
560
+
end
561
+
562
+
let responder_finish state sigma3 =
563
+
Log.debug (fun m -> m "CASE responder: processing Sigma3");
564
+
565
+
(* Derive key for decrypting Sigma3 *)
566
+
let salt = state.r_peer_random ^ state.r_random in
567
+
let s3k =
568
+
derive_sigma_key ~shared_secret:state.r_shared_secret ~salt
569
+
~info:case_sigma3_info
570
+
in
571
+
572
+
(* Decrypt TBS3 *)
573
+
let* tbs3_inner =
574
+
aes_ccm_decrypt ~key:s3k ~nonce:case_nonce ~adata:"" sigma3.encrypted3
575
+
in
576
+
577
+
(* Parse TBS3 inner structure *)
578
+
let* noc_der, icac_der_opt, signature = decode_tbs2_inner tbs3_inner in
579
+
580
+
(* Parse certificates *)
581
+
let* initiator_noc =
582
+
match X509.Certificate.decode_der noc_der with
583
+
| Ok c -> Ok c
584
+
| Error (`Msg e) -> Error ("Failed to parse initiator NOC: " ^ e)
585
+
in
586
+
let* initiator_icac =
587
+
match icac_der_opt with
588
+
| None -> Ok None
589
+
| Some der -> (
590
+
match X509.Certificate.decode_der der with
591
+
| Ok c -> Ok (Some c)
592
+
| Error (`Msg e) -> Error ("Failed to parse initiator ICAC: " ^ e))
593
+
in
594
+
595
+
(* Extract initiator public key and verify signature *)
596
+
let* initiator_pub_key = cert_public_key initiator_noc in
597
+
let tbs3 =
598
+
build_sigma3_tbs ~initiator_noc ~initiator_icac
599
+
~initiator_eph_pub:state.r_peer_eph_pub ~responder_eph_pub:state.r_eph_pub
600
+
~initiator_random:state.r_peer_random ~responder_random:state.r_random
601
+
in
602
+
if not (ecdsa_verify ~key:initiator_pub_key ~signature tbs3) then
603
+
Error "Sigma3 signature verification failed"
604
+
else begin
605
+
Log.debug (fun m -> m "CASE responder: Sigma3 signature verified");
606
+
607
+
(* Derive session keys *)
608
+
let session_keys =
609
+
derive_session_keys ~shared_secret:state.r_shared_secret
610
+
~initiator_random:state.r_peer_random ~responder_random:state.r_random
611
+
~initiator_pub:state.r_peer_eph_pub ~responder_pub:state.r_eph_pub
612
+
in
613
+
614
+
Log.debug (fun m -> m "CASE responder: session established");
615
+
Ok session_keys
616
+
end
+141
lib/case.mli
+141
lib/case.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Matter CASE (Certificate Authenticated Session Establishment).
7
+
8
+
CASE is a sigma-style key exchange protocol that establishes secure sessions
9
+
between Matter devices using X.509 certificates (NOCs - Node Operational
10
+
Certificates).
11
+
12
+
The protocol involves three messages:
13
+
- {b Sigma1}: Initiator sends random, session params, ECDHE public key
14
+
- {b Sigma2}: Responder sends random, ECDHE public key, encrypted NOC chain
15
+
- {b Sigma3}: Initiator sends encrypted NOC chain and signature
16
+
17
+
See Matter Core Specification Chapter 4 for details. *)
18
+
19
+
(** {1 Types} *)
20
+
21
+
type fabric = {
22
+
fabric_id : string; (** 8-byte fabric identifier *)
23
+
node_id : string; (** 8-byte node identifier *)
24
+
root_public_key : string; (** 65-byte uncompressed P-256 public key *)
25
+
ipk : string; (** 16-byte Identity Protection Key *)
26
+
}
27
+
(** Fabric identity for a node. *)
28
+
29
+
type credentials = {
30
+
noc : X509.Certificate.t; (** Node Operational Certificate *)
31
+
icac : X509.Certificate.t option; (** Intermediate CA Certificate *)
32
+
private_key : Crypto_ec.P256.Dsa.priv; (** Node's private key *)
33
+
fabric : fabric;
34
+
}
35
+
(** Node credentials. *)
36
+
37
+
type initiator_state
38
+
(** CASE initiator state (after Sigma1). *)
39
+
40
+
type responder_state
41
+
(** CASE responder state (after receiving Sigma1). *)
42
+
43
+
type session_keys = {
44
+
i2r_key : string; (** 16-byte initiator-to-responder key *)
45
+
r2i_key : string; (** 16-byte responder-to-initiator key *)
46
+
attestation_challenge : string; (** 16-byte attestation challenge *)
47
+
}
48
+
(** Session keys derived from CASE. *)
49
+
50
+
type sigma1 = {
51
+
initiator_random : string; (** 32-byte random *)
52
+
initiator_session_id : int; (** 16-bit session ID *)
53
+
destination_id : string; (** 32-byte HMAC identifying target *)
54
+
initiator_eph_pub_key : string; (** 65-byte ephemeral public key *)
55
+
initiator_session_params : string option; (** Optional session parameters *)
56
+
resumption_id : string option; (** Optional resumption ID *)
57
+
initiator_resume_mic : string option; (** Optional resume MIC *)
58
+
}
59
+
(** Sigma1 message (initiator -> responder). *)
60
+
61
+
type sigma2 = {
62
+
responder_random : string; (** 32-byte random *)
63
+
responder_session_id : int; (** 16-bit session ID *)
64
+
responder_eph_pub_key : string; (** 65-byte ephemeral public key *)
65
+
encrypted2 : string; (** Encrypted TBS2 data *)
66
+
responder_session_params : string option; (** Optional session parameters *)
67
+
}
68
+
(** Sigma2 message (responder -> initiator). *)
69
+
70
+
type sigma3 = { encrypted3 : string (** Encrypted TBS3 data *) }
71
+
(** Sigma3 message (initiator -> responder). *)
72
+
73
+
(** {1 Protocol Operations} *)
74
+
75
+
(** {2 Initiator Side} *)
76
+
77
+
val initiator_start :
78
+
credentials:credentials ->
79
+
peer_fabric:fabric ->
80
+
initiator_session_id:int ->
81
+
initiator_state * sigma1
82
+
(** [initiator_start ~credentials ~peer_fabric ~initiator_session_id] begins
83
+
CASE as initiator. Returns the internal state and Sigma1 message to send. *)
84
+
85
+
val initiator_finish :
86
+
initiator_state -> sigma2 -> (session_keys * sigma3, string) result
87
+
(** [initiator_finish state sigma2] processes Sigma2 and produces Sigma3.
88
+
Returns session keys and Sigma3 message, or an error if verification fails.
89
+
*)
90
+
91
+
(** {2 Responder Side} *)
92
+
93
+
val responder_start :
94
+
credentials:credentials ->
95
+
sigma1:sigma1 ->
96
+
responder_session_id:int ->
97
+
(responder_state * sigma2, string) result
98
+
(** [responder_start ~credentials sigma1 ~responder_session_id] processes Sigma1
99
+
and produces Sigma2. Verifies the destination_id matches our fabric. *)
100
+
101
+
val responder_finish :
102
+
responder_state -> sigma3 -> (session_keys, string) result
103
+
(** [responder_finish state sigma3] processes Sigma3 and completes CASE. Returns
104
+
session keys or an error if verification fails. *)
105
+
106
+
(** {1 Message Encoding/Decoding} *)
107
+
108
+
val encode_sigma1 : sigma1 -> string
109
+
(** [encode_sigma1 msg] encodes Sigma1 to TLV binary format. *)
110
+
111
+
val decode_sigma1 : string -> (sigma1, string) result
112
+
(** [decode_sigma1 data] decodes Sigma1 from TLV binary format. *)
113
+
114
+
val encode_sigma2 : sigma2 -> string
115
+
(** [encode_sigma2 msg] encodes Sigma2 to TLV binary format. *)
116
+
117
+
val decode_sigma2 : string -> (sigma2, string) result
118
+
(** [decode_sigma2 data] decodes Sigma2 from TLV binary format. *)
119
+
120
+
val encode_sigma3 : sigma3 -> string
121
+
(** [encode_sigma3 msg] encodes Sigma3 to TLV binary format. *)
122
+
123
+
val decode_sigma3 : string -> (sigma3, string) result
124
+
(** [decode_sigma3 data] decodes Sigma3 from TLV binary format. *)
125
+
126
+
(** {1 Cryptographic Helpers} *)
127
+
128
+
val compute_destination_id : fabric:fabric -> initiator_random:string -> string
129
+
(** [compute_destination_id ~fabric ~initiator_random] computes the 32-byte
130
+
destination identifier that allows the responder to identify the target
131
+
fabric without revealing it to eavesdroppers. *)
132
+
133
+
val derive_session_keys :
134
+
shared_secret:string ->
135
+
initiator_random:string ->
136
+
responder_random:string ->
137
+
initiator_pub:string ->
138
+
responder_pub:string ->
139
+
session_keys
140
+
(** [derive_session_keys ~shared_secret ~initiator_random ~responder_random
141
+
~initiator_pub ~responder_pub] derives CASE session keys using HKDF. *)
+4
-2
lib/dune
+4
-2
lib/dune
+1
lib/matter.ml
+1
lib/matter.ml
+3
lib/matter.mli
+3
lib/matter.mli
+2
-2
lib/session.ml
+2
-2
lib/session.ml
···
208
208
let establish_pase ~net ~sw ~clock ~ip ~port ~passcode =
209
209
let conn = connect ~net ~sw ~ip ~port in
210
210
211
-
let initiator_random = Mirage_crypto_rng.generate 32 in
211
+
let initiator_random = Crypto_rng.generate 32 in
212
212
(* Use secure random for session ID *)
213
-
let session_id_bytes = Mirage_crypto_rng.generate 2 in
213
+
let session_id_bytes = Crypto_rng.generate 2 in
214
214
let session_id =
215
215
(Char.code session_id_bytes.[0] lsl 8) lor Char.code session_id_bytes.[1]
216
216
in
+2
-1
matter.opam
+2
-1
matter.opam
···
15
15
"dune" {>= "3.0"}
16
16
"ocaml" {>= "4.14"}
17
17
"dune-configurator" {< "3.21"}
18
+
"crypto" {>= "0.1"}
18
19
"digestif" {>= "1.0"}
19
20
"eio" {>= "1.0"}
20
21
"kdf" {>= "0.1"}
21
22
"mdns" {>= "0.1"}
22
23
"spake2" {>= "0.1"}
23
24
"mirage-crypto" {>= "1.0"}
24
-
"mirage-crypto-rng" {>= "1.0"}
25
25
"cstruct" {>= "6.0"}
26
26
"ipaddr" {>= "5.0"}
27
27
"domain-name" {>= "0.4"}
28
28
"logs" {>= "0.7"}
29
29
"fmt" {>= "0.9"}
30
+
"x509" {>= "1.0"}
30
31
"alcotest" {with-test}
31
32
"crowbar" {with-test}
32
33
"odoc" {with-doc}
+1
-1
test/dune
+1
-1
test/dune
+2
-1
test/test.ml
+2
-1
test/test.ml
+281
test/test_case.ml
+281
test/test_case.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Tests for Matter CASE (Certificate Authenticated Session Establishment) *)
7
+
8
+
open Matter
9
+
10
+
(** {1 Test Helpers} *)
11
+
12
+
let hex = Ohex.decode
13
+
14
+
(** Generate a self-signed test certificate with P-256 key *)
15
+
let generate_test_credentials ~fabric_id ~node_id =
16
+
(* Generate P-256 key pair *)
17
+
let priv, pub = Crypto_ec.P256.Dsa.generate () in
18
+
let priv_key = `P256 priv in
19
+
20
+
(* Create a minimal X.509 certificate via signing request *)
21
+
let issuer =
22
+
X509.Distinguished_name.
23
+
[ Relative_distinguished_name.(singleton (CN "Test Matter CA")) ]
24
+
in
25
+
let subject =
26
+
X509.Distinguished_name.
27
+
[ Relative_distinguished_name.(singleton (CN "Test Matter Node")) ]
28
+
in
29
+
let valid_from = Option.get (Ptime.of_float_s 0.) in
30
+
let valid_until = Option.get (Ptime.of_float_s (365. *. 24. *. 3600.)) in
31
+
32
+
(* Create signing request *)
33
+
let csr =
34
+
match X509.Signing_request.create subject priv_key with
35
+
| Ok csr -> csr
36
+
| Error (`Msg e) -> failwith ("Failed to create CSR: " ^ e)
37
+
in
38
+
39
+
(* Self-sign to create certificate *)
40
+
let noc =
41
+
match
42
+
X509.Signing_request.sign csr ~valid_from ~valid_until priv_key issuer
43
+
with
44
+
| Ok cert -> cert
45
+
| Error e ->
46
+
failwith
47
+
("Failed to sign certificate: "
48
+
^ Format.asprintf "%a" X509.Validation.pp_signature_error e)
49
+
in
50
+
51
+
(* Create fabric *)
52
+
let root_pub = Crypto_ec.P256.Dsa.pub_to_octets pub in
53
+
let fabric : Case.fabric =
54
+
{
55
+
fabric_id;
56
+
node_id;
57
+
root_public_key = root_pub;
58
+
ipk = String.make 16 '\x00';
59
+
(* Test IPK *)
60
+
}
61
+
in
62
+
63
+
let credentials : Case.credentials =
64
+
{ noc; icac = None; private_key = priv; fabric }
65
+
in
66
+
credentials
67
+
68
+
(** {1 Destination ID Tests} *)
69
+
70
+
let test_destination_id_deterministic () =
71
+
let fabric : Case.fabric =
72
+
{
73
+
fabric_id = String.make 8 '\x01';
74
+
node_id = String.make 8 '\x02';
75
+
root_public_key = String.make 65 '\x03';
76
+
ipk = String.make 16 '\x04';
77
+
}
78
+
in
79
+
let random = String.make 32 '\x05' in
80
+
81
+
let dest1 = Case.compute_destination_id ~fabric ~initiator_random:random in
82
+
let dest2 = Case.compute_destination_id ~fabric ~initiator_random:random in
83
+
84
+
Alcotest.(check string) "destination_id is deterministic" dest1 dest2;
85
+
Alcotest.(check int) "destination_id is 32 bytes" 32 (String.length dest1)
86
+
87
+
let test_destination_id_different_random () =
88
+
let fabric : Case.fabric =
89
+
{
90
+
fabric_id = String.make 8 '\x01';
91
+
node_id = String.make 8 '\x02';
92
+
root_public_key = String.make 65 '\x03';
93
+
ipk = String.make 16 '\x04';
94
+
}
95
+
in
96
+
97
+
let dest1 =
98
+
Case.compute_destination_id ~fabric
99
+
~initiator_random:(String.make 32 '\x00')
100
+
in
101
+
let dest2 =
102
+
Case.compute_destination_id ~fabric
103
+
~initiator_random:(String.make 32 '\x01')
104
+
in
105
+
106
+
Alcotest.(check bool)
107
+
"different random gives different dest_id" false (dest1 = dest2)
108
+
109
+
(** {1 Session Key Derivation Tests} *)
110
+
111
+
let test_session_keys_length () =
112
+
let shared_secret = String.make 32 '\xAA' in
113
+
let initiator_random = String.make 32 '\xBB' in
114
+
let responder_random = String.make 32 '\xCC' in
115
+
let initiator_pub = String.make 65 '\xDD' in
116
+
let responder_pub = String.make 65 '\xEE' in
117
+
118
+
let keys =
119
+
Case.derive_session_keys ~shared_secret ~initiator_random ~responder_random
120
+
~initiator_pub ~responder_pub
121
+
in
122
+
123
+
Alcotest.(check int) "i2r_key is 16 bytes" 16 (String.length keys.i2r_key);
124
+
Alcotest.(check int) "r2i_key is 16 bytes" 16 (String.length keys.r2i_key);
125
+
Alcotest.(check int)
126
+
"attestation_challenge is 16 bytes" 16
127
+
(String.length keys.attestation_challenge)
128
+
129
+
let test_session_keys_deterministic () =
130
+
let shared_secret = String.make 32 '\xAA' in
131
+
let initiator_random = String.make 32 '\xBB' in
132
+
let responder_random = String.make 32 '\xCC' in
133
+
let initiator_pub = String.make 65 '\xDD' in
134
+
let responder_pub = String.make 65 '\xEE' in
135
+
136
+
let keys1 =
137
+
Case.derive_session_keys ~shared_secret ~initiator_random ~responder_random
138
+
~initiator_pub ~responder_pub
139
+
in
140
+
let keys2 =
141
+
Case.derive_session_keys ~shared_secret ~initiator_random ~responder_random
142
+
~initiator_pub ~responder_pub
143
+
in
144
+
145
+
Alcotest.(check string) "i2r_key deterministic" keys1.i2r_key keys2.i2r_key;
146
+
Alcotest.(check string) "r2i_key deterministic" keys1.r2i_key keys2.r2i_key
147
+
148
+
(** {1 Sigma Message Encoding Tests} *)
149
+
150
+
let test_sigma1_roundtrip () =
151
+
let msg : Case.sigma1 =
152
+
{
153
+
initiator_random = String.make 32 '\x11';
154
+
initiator_session_id = 0x1234;
155
+
destination_id = String.make 32 '\x22';
156
+
initiator_eph_pub_key = String.make 65 '\x33';
157
+
initiator_session_params = None;
158
+
resumption_id = None;
159
+
initiator_resume_mic = None;
160
+
}
161
+
in
162
+
163
+
let encoded = Case.encode_sigma1 msg in
164
+
match Case.decode_sigma1 encoded with
165
+
| Ok decoded ->
166
+
Alcotest.(check string)
167
+
"random" msg.initiator_random decoded.initiator_random;
168
+
Alcotest.(check int)
169
+
"session_id" msg.initiator_session_id decoded.initiator_session_id;
170
+
Alcotest.(check string)
171
+
"dest_id" msg.destination_id decoded.destination_id;
172
+
Alcotest.(check string)
173
+
"eph_pub" msg.initiator_eph_pub_key decoded.initiator_eph_pub_key
174
+
| Error e -> Alcotest.fail ("decode_sigma1 failed: " ^ e)
175
+
176
+
let test_sigma2_roundtrip () =
177
+
let msg : Case.sigma2 =
178
+
{
179
+
responder_random = String.make 32 '\x44';
180
+
responder_session_id = 0x5678;
181
+
responder_eph_pub_key = String.make 65 '\x55';
182
+
encrypted2 = String.make 100 '\x66';
183
+
responder_session_params = None;
184
+
}
185
+
in
186
+
187
+
let encoded = Case.encode_sigma2 msg in
188
+
match Case.decode_sigma2 encoded with
189
+
| Ok decoded ->
190
+
Alcotest.(check string)
191
+
"random" msg.responder_random decoded.responder_random;
192
+
Alcotest.(check int)
193
+
"session_id" msg.responder_session_id decoded.responder_session_id;
194
+
Alcotest.(check string)
195
+
"eph_pub" msg.responder_eph_pub_key decoded.responder_eph_pub_key;
196
+
Alcotest.(check string) "encrypted2" msg.encrypted2 decoded.encrypted2
197
+
| Error e -> Alcotest.fail ("decode_sigma2 failed: " ^ e)
198
+
199
+
let test_sigma3_roundtrip () =
200
+
let msg : Case.sigma3 = { encrypted3 = String.make 150 '\x77' } in
201
+
202
+
let encoded = Case.encode_sigma3 msg in
203
+
match Case.decode_sigma3 encoded with
204
+
| Ok decoded ->
205
+
Alcotest.(check string) "encrypted3" msg.encrypted3 decoded.encrypted3
206
+
| Error e -> Alcotest.fail ("decode_sigma3 failed: " ^ e)
207
+
208
+
(** {1 Full CASE Protocol Test} *)
209
+
210
+
let test_case_full_exchange () =
211
+
(* Generate credentials for initiator and responder *)
212
+
let initiator_creds =
213
+
generate_test_credentials ~fabric_id:(String.make 8 '\x01')
214
+
~node_id:(String.make 8 '\x10')
215
+
in
216
+
let responder_creds =
217
+
generate_test_credentials ~fabric_id:(String.make 8 '\x01')
218
+
~node_id:(String.make 8 '\x20')
219
+
in
220
+
221
+
(* Initiator starts CASE *)
222
+
let initiator_state, sigma1 =
223
+
Case.initiator_start ~credentials:initiator_creds
224
+
~peer_fabric:responder_creds.fabric ~initiator_session_id:0x1000
225
+
in
226
+
227
+
(* Responder processes Sigma1 and generates Sigma2 *)
228
+
match
229
+
Case.responder_start ~credentials:responder_creds ~sigma1
230
+
~responder_session_id:0x2000
231
+
with
232
+
| Error e -> Alcotest.fail ("responder_start failed: " ^ e)
233
+
| Ok (responder_state, sigma2) -> (
234
+
(* Initiator processes Sigma2 and generates Sigma3 *)
235
+
match Case.initiator_finish initiator_state sigma2 with
236
+
| Error e -> Alcotest.fail ("initiator_finish failed: " ^ e)
237
+
| Ok (initiator_keys, sigma3) -> (
238
+
(* Responder processes Sigma3 *)
239
+
match Case.responder_finish responder_state sigma3 with
240
+
| Error e -> Alcotest.fail ("responder_finish failed: " ^ e)
241
+
| Ok responder_keys ->
242
+
(* Verify both sides derived the same keys *)
243
+
Alcotest.(check string)
244
+
"i2r_key matches" initiator_keys.i2r_key responder_keys.i2r_key;
245
+
Alcotest.(check string)
246
+
"r2i_key matches" initiator_keys.r2i_key responder_keys.r2i_key;
247
+
Alcotest.(check string)
248
+
"attestation_challenge matches"
249
+
initiator_keys.attestation_challenge
250
+
responder_keys.attestation_challenge))
251
+
252
+
(** {1 Test Suites} *)
253
+
254
+
let destination_id_tests =
255
+
[
256
+
("deterministic", `Quick, test_destination_id_deterministic);
257
+
("different random", `Quick, test_destination_id_different_random);
258
+
]
259
+
260
+
let session_keys_tests =
261
+
[
262
+
("key lengths", `Quick, test_session_keys_length);
263
+
("deterministic", `Quick, test_session_keys_deterministic);
264
+
]
265
+
266
+
let sigma_encoding_tests =
267
+
[
268
+
("sigma1 roundtrip", `Quick, test_sigma1_roundtrip);
269
+
("sigma2 roundtrip", `Quick, test_sigma2_roundtrip);
270
+
("sigma3 roundtrip", `Quick, test_sigma3_roundtrip);
271
+
]
272
+
273
+
let protocol_tests = [ ("full exchange", `Quick, test_case_full_exchange) ]
274
+
275
+
let suite =
276
+
[
277
+
("destination_id", destination_id_tests);
278
+
("session_keys", session_keys_tests);
279
+
("sigma_encoding", sigma_encoding_tests);
280
+
("protocol", protocol_tests);
281
+
]