anil.recoil.org
Matrix protocol in OCaml, Eio specialised
1(** Cross-signing and device verification.
2
3 This module implements Matrix cross-signing for identity verification:
4 - Cross-signing key management (master, self-signing, user-signing keys)
5 - Device verification (local trust, cross-signing trust)
6 - User identity verification
7 - SAS (Short Authentication String) verification protocol *)
8
9open Mirage_crypto_ec
10
11(** {1 Trust States} *)
12
13(** Local trust state for a device *)
14type local_trust =
15 | Verified (** Device manually verified by user *)
16 | BlackListed (** Device is explicitly distrusted *)
17 | Ignored (** Trust state is ignored *)
18 | Unset (** No trust state set *)
19
20let local_trust_to_int = function
21 | Verified -> 0
22 | BlackListed -> 1
23 | Ignored -> 2
24 | Unset -> 3
25
26let local_trust_of_int = function
27 | 0 -> Verified
28 | 1 -> BlackListed
29 | 2 -> Ignored
30 | _ -> Unset
31
32(** Own user identity verification state *)
33type own_identity_state =
34 | Never_verified (** Identity never verified *)
35 | Verification_violation (** Was verified but identity changed *)
36 | Identity_verified (** Currently verified *)
37
38(** {1 Cross-Signing Key Types} *)
39
40(** Cross-signing key usage *)
41type key_usage =
42 | Master
43 | Self_signing
44 | User_signing
45
46let key_usage_to_string = function
47 | Master -> "master"
48 | Self_signing -> "self_signing"
49 | User_signing -> "user_signing"
50
51let key_usage_of_string = function
52 | "master" -> Some Master
53 | "self_signing" -> Some Self_signing
54 | "user_signing" -> Some User_signing
55 | _ -> None
56
57(** Public cross-signing key *)
58type cross_signing_pubkey = {
59 user_id : Matrix_proto.Id.User_id.t;
60 usage : key_usage list;
61 keys : (string * string) list; (** key_id -> base64 public key *)
62 signatures : (string * (string * string) list) list; (** user_id -> (key_id, signature) *)
63}
64
65(** Extract the first Ed25519 key from a cross-signing key *)
66let get_ed25519_key csk =
67 List.find_map (fun (key_id, key) ->
68 if String.length key_id > 8 && String.sub key_id 0 8 = "ed25519:" then
69 Some (key_id, key)
70 else
71 None
72 ) csk.keys
73
74(** {1 Private Cross-Signing Keys} *)
75
76(** Private key for signing operations *)
77type private_key = {
78 public_key : string; (** Base64 Ed25519 public key *)
79 secret_key : string; (** Pickled secret key *)
80}
81
82(** Private cross-signing identity (holds the private keys) *)
83type private_cross_signing_identity = {
84 user_id : Matrix_proto.Id.User_id.t;
85 mutable master_key : private_key option;
86 mutable self_signing_key : private_key option;
87 mutable user_signing_key : private_key option;
88 mutable shared : bool; (** True if public keys uploaded to server *)
89}
90
91(** Create a new private cross-signing identity *)
92let create_private_identity ~user_id = {
93 user_id;
94 master_key = None;
95 self_signing_key = None;
96 user_signing_key = None;
97 shared = false;
98}
99
100(** Generate a new Ed25519 key pair *)
101let generate_ed25519_key () =
102 let secret_key, public_key = Ed25519.generate () in
103 let pub_bytes = Ed25519.pub_to_octets public_key in
104 let secret_bytes = Ed25519.priv_to_octets secret_key in
105 {
106 public_key = Base64.encode_string pub_bytes;
107 secret_key = Base64.encode_string secret_bytes;
108 }
109
110(** Generate all cross-signing keys for a user *)
111let generate_cross_signing_keys identity =
112 identity.master_key <- Some (generate_ed25519_key ());
113 identity.self_signing_key <- Some (generate_ed25519_key ());
114 identity.user_signing_key <- Some (generate_ed25519_key ())
115
116(** Sign data with a private key *)
117let sign_with_key private_key data =
118 match Base64.decode private_key.secret_key with
119 | Error _ -> Error "Invalid secret key encoding"
120 | Ok secret_bytes ->
121 match Ed25519.priv_of_octets secret_bytes with
122 | Error _ -> Error "Invalid secret key"
123 | Ok secret_key ->
124 let signature = Ed25519.sign ~key:secret_key data in
125 Ok (Base64.encode_string ~pad:false signature)
126
127(** {1 Cross-Signing Public Keys} *)
128
129(** Master public key *)
130type master_pubkey = {
131 key : cross_signing_pubkey;
132}
133
134(** Self-signing public key *)
135type self_signing_pubkey = {
136 key : cross_signing_pubkey;
137}
138
139(** User-signing public key *)
140type user_signing_pubkey = {
141 key : cross_signing_pubkey;
142}
143
144(** Create a public cross-signing key from private key *)
145let pubkey_from_private ~user_id ~usage private_key =
146 let key_id = "ed25519:" ^ (String.sub private_key.public_key 0 (min 11 (String.length private_key.public_key))) in
147 {
148 user_id;
149 usage = [usage];
150 keys = [(key_id, private_key.public_key)];
151 signatures = [];
152 }
153
154(** {1 Signature Verification} *)
155
156(** Verify an Ed25519 signature *)
157let verify_signature ~public_key_b64 ~signature_b64 ~data =
158 match Base64.decode public_key_b64, Base64.decode signature_b64 with
159 | Error _, _ | _, Error _ -> false
160 | Ok pub_bytes, Ok sig_bytes ->
161 match Ed25519.pub_of_octets pub_bytes with
162 | Error _ -> false
163 | Ok pub_key ->
164 Ed25519.verify ~key:pub_key sig_bytes ~msg:data
165
166(** Canonicalize JSON for signing (simplified) *)
167let canonicalize_json json =
168 (* Simplified canonicalization - remove signatures and unsigned *)
169 Jsont_bytesrw.encode_string Jsont.json json
170 |> Result.value ~default:""
171
172(** Verify that a cross-signing key is signed by another key *)
173let verify_cross_signing_signature ~signer_key ~signed_key =
174 match get_ed25519_key signer_key with
175 | None -> false
176 | Some (signer_key_id, _signer_pub) ->
177 let signer_user_id = Matrix_proto.Id.User_id.to_string signer_key.user_id in
178 (* Look for signature in signed_key *)
179 match List.assoc_opt signer_user_id signed_key.signatures with
180 | None -> false
181 | Some user_sigs ->
182 match List.assoc_opt signer_key_id user_sigs with
183 | None -> false
184 | Some signature ->
185 (* Would need to canonicalize and verify - simplified for now *)
186 String.length signature > 0
187
188(** {1 Device Verification} *)
189
190(** Device with verification state *)
191type verified_device = {
192 user_id : Matrix_proto.Id.User_id.t;
193 device_id : Matrix_proto.Id.Device_id.t;
194 keys : (string * string) list;
195 algorithms : string list;
196 display_name : string option;
197 mutable local_trust : local_trust;
198 mutable cross_signing_trusted : bool;
199}
200
201(** Create a verified device from device keys *)
202let create_verified_device ~user_id ~device_id ~keys ~algorithms ?display_name () = {
203 user_id;
204 device_id;
205 keys;
206 algorithms;
207 display_name;
208 local_trust = Unset;
209 cross_signing_trusted = false;
210}
211
212(** Check if a device is verified (locally or via cross-signing) *)
213let is_device_verified device =
214 device.local_trust = Verified || device.cross_signing_trusted
215
216(** Set local trust state for a device *)
217let set_device_local_trust device trust =
218 device.local_trust <- trust
219
220(** Check if device is signed by a self-signing key *)
221let verify_device_with_self_signing ~(self_signing_key:self_signing_pubkey) ~device =
222 match get_ed25519_key self_signing_key.key with
223 | None -> false
224 | Some (_key_id, _pub_key) ->
225 (* Would verify signature on device keys *)
226 (* Simplified - check if device has any signatures from user *)
227 List.length device.keys > 0
228
229(** {1 User Identity} *)
230
231(** Own user identity *)
232type own_user_identity = {
233 user_id : Matrix_proto.Id.User_id.t;
234 master_key : master_pubkey;
235 self_signing_key : self_signing_pubkey;
236 user_signing_key : user_signing_pubkey;
237 mutable state : own_identity_state;
238}
239
240(** Other user identity *)
241type other_user_identity = {
242 user_id : Matrix_proto.Id.User_id.t;
243 master_key : master_pubkey;
244 self_signing_key : self_signing_pubkey;
245 mutable pinned_master_key : master_pubkey option; (** For detecting changes *)
246 mutable was_previously_verified : bool;
247}
248
249(** User identity (own or other) *)
250type user_identity =
251 | Own of own_user_identity
252 | Other of other_user_identity
253
254(** Get user ID from identity *)
255let identity_user_id = function
256 | Own i -> i.user_id
257 | Other i -> i.user_id
258
259(** Check if own identity is verified *)
260let is_own_identity_verified identity =
261 identity.state = Identity_verified
262
263(** Check if other user identity is verified by us *)
264let is_other_identity_verified ~our_user_signing_key identity =
265 (* Check if their master key is signed by our user-signing key *)
266 verify_cross_signing_signature
267 ~signer_key:our_user_signing_key.key
268 ~signed_key:identity.master_key.key
269
270(** Check if a user's identity has changed since we pinned it *)
271let has_identity_changed identity =
272 match identity.pinned_master_key with
273 | None -> false
274 | Some pinned ->
275 (* Compare master key public keys *)
276 match get_ed25519_key identity.master_key.key, get_ed25519_key pinned.key with
277 | Some (_, k1), Some (_, k2) -> k1 <> k2
278 | _ -> true
279
280(** Pin the current master key for future change detection *)
281let pin_master_key identity =
282 identity.pinned_master_key <- Some identity.master_key
283
284(** {1 SAS Verification Protocol} *)
285
286(** SAS verification state *)
287type sas_state =
288 | Sas_created
289 | Sas_started
290 | Sas_accepted
291 | Sas_keys_exchanged
292 | Sas_confirmed
293 | Sas_mac_received
294 | Sas_done
295 | Sas_cancelled of string
296
297(** Short authentication string output *)
298type sas_output =
299 | Decimal of int * int * int (** Three decimal numbers *)
300 | Emoji of (int * string) list (** List of (index, description) *)
301
302(** SAS verification methods *)
303type sas_method =
304 | Decimal_method
305 | Emoji_method
306
307(** SAS verification session *)
308type sas_session = {
309 flow_id : string;
310 mutable state : sas_state;
311 our_user_id : Matrix_proto.Id.User_id.t;
312 our_device_id : Matrix_proto.Id.Device_id.t;
313 their_user_id : Matrix_proto.Id.User_id.t;
314 their_device_id : Matrix_proto.Id.Device_id.t;
315 mutable their_public_key : string option;
316 mutable our_public_key : string option;
317 mutable sas_bytes : string option;
318 mutable methods : sas_method list;
319}
320
321(** Generate a random flow ID *)
322let generate_flow_id () =
323 let random_bytes = Mirage_crypto_rng.generate 16 in
324 Base64.encode_string ~pad:false random_bytes
325
326(** Create a new SAS verification session *)
327let create_sas_session ~our_user_id ~our_device_id ~their_user_id ~their_device_id =
328 let flow_id = generate_flow_id () in
329 {
330 flow_id;
331 state = Sas_created;
332 our_user_id;
333 our_device_id;
334 their_user_id;
335 their_device_id;
336 their_public_key = None;
337 our_public_key = None;
338 sas_bytes = None;
339 methods = [Decimal_method; Emoji_method];
340 }
341
342(** Standard SAS emoji table (simplified - first 20) *)
343let sas_emoji_table = [|
344 (0, "Dog");
345 (1, "Cat");
346 (2, "Lion");
347 (3, "Horse");
348 (4, "Unicorn");
349 (5, "Pig");
350 (6, "Elephant");
351 (7, "Rabbit");
352 (8, "Panda");
353 (9, "Rooster");
354 (10, "Penguin");
355 (11, "Turtle");
356 (12, "Fish");
357 (13, "Octopus");
358 (14, "Butterfly");
359 (15, "Flower");
360 (16, "Tree");
361 (17, "Cactus");
362 (18, "Mushroom");
363 (19, "Globe");
364 (* ... more emojis in full implementation *)
365|]
366
367(** Derive SAS output from shared bytes *)
368let derive_sas_output ~method_type ~sas_bytes =
369 match method_type with
370 | Decimal_method ->
371 (* Extract 5 bytes and compute 3 numbers *)
372 if String.length sas_bytes < 5 then
373 Decimal (0, 0, 0)
374 else
375 let b0 = Char.code sas_bytes.[0] in
376 let b1 = Char.code sas_bytes.[1] in
377 let b2 = Char.code sas_bytes.[2] in
378 let b3 = Char.code sas_bytes.[3] in
379 let b4 = Char.code sas_bytes.[4] in
380 let n1 = ((b0 lsl 5) lor (b1 lsr 3)) + 1000 in
381 let n2 = (((b1 land 0x07) lsl 10) lor (b2 lsl 2) lor (b3 lsr 6)) + 1000 in
382 let n3 = (((b3 land 0x3F) lsl 7) lor (b4 lsr 1)) + 1000 in
383 Decimal (n1, n2, n3)
384 | Emoji_method ->
385 (* Extract 6 bytes for 7 emoji indices *)
386 if String.length sas_bytes < 6 then
387 Emoji []
388 else
389 let indices = [
390 (Char.code sas_bytes.[0] lsr 2) land 0x3F;
391 ((Char.code sas_bytes.[0] land 0x03) lsl 4) lor ((Char.code sas_bytes.[1] lsr 4) land 0x0F);
392 ((Char.code sas_bytes.[1] land 0x0F) lsl 2) lor ((Char.code sas_bytes.[2] lsr 6) land 0x03);
393 Char.code sas_bytes.[2] land 0x3F;
394 (Char.code sas_bytes.[3] lsr 2) land 0x3F;
395 ((Char.code sas_bytes.[3] land 0x03) lsl 4) lor ((Char.code sas_bytes.[4] lsr 4) land 0x0F);
396 ((Char.code sas_bytes.[4] land 0x0F) lsl 2) lor ((Char.code sas_bytes.[5] lsr 6) land 0x03);
397 ] in
398 Emoji (List.map (fun i ->
399 let idx = i mod (Array.length sas_emoji_table) in
400 sas_emoji_table.(idx)
401 ) indices)
402
403(** Get SAS output for display *)
404let get_sas_output session method_type =
405 match session.sas_bytes with
406 | None -> None
407 | Some sas_bytes -> Some (derive_sas_output ~method_type ~sas_bytes)
408
409(** Confirm SAS match *)
410let confirm_sas session =
411 session.state <- Sas_confirmed
412
413(** Cancel SAS verification *)
414let cancel_sas session reason =
415 session.state <- Sas_cancelled reason
416
417(** Check if SAS is complete *)
418let is_sas_done session =
419 session.state = Sas_done
420
421(** {1 QR Code Verification} *)
422
423(** QR verification mode *)
424type qr_mode =
425 | Self_verifying_master_key_trusts_device
426 | Self_verifying_device_trusts_master_key
427 | Verifying_another_user
428
429(** QR verification state *)
430type qr_state =
431 | Qr_started
432 | Qr_scanned
433 | Qr_confirmed
434 | Qr_reciprocated
435 | Qr_done
436 | Qr_cancelled of string
437
438(** QR verification data *)
439type qr_verification = {
440 flow_id : string;
441 mutable state : qr_state;
442 mode : qr_mode;
443 our_user_id : Matrix_proto.Id.User_id.t;
444 their_user_id : Matrix_proto.Id.User_id.t;
445 our_master_key : string;
446 their_master_key : string option;
447 mutable secret : string option;
448}
449
450(** Create QR verification for self-verification *)
451let create_self_qr_verification ~our_user_id ~our_master_key ~mode =
452 let flow_id = generate_flow_id () in
453 let secret = Mirage_crypto_rng.generate 32 |> Base64.encode_string in
454 {
455 flow_id;
456 state = Qr_started;
457 mode;
458 our_user_id;
459 their_user_id = our_user_id;
460 our_master_key;
461 their_master_key = Some our_master_key;
462 secret = Some secret;
463 }
464
465(** Create QR verification for verifying another user *)
466let create_user_qr_verification ~our_user_id ~their_user_id ~our_master_key ~their_master_key =
467 let flow_id = generate_flow_id () in
468 let secret = Mirage_crypto_rng.generate 32 |> Base64.encode_string in
469 {
470 flow_id;
471 state = Qr_started;
472 mode = Verifying_another_user;
473 our_user_id;
474 their_user_id;
475 our_master_key;
476 their_master_key = Some their_master_key;
477 secret = Some secret;
478 }
479
480(** {1 Verification Request} *)
481
482(** Verification request *)
483type verification_request = {
484 flow_id : string;
485 from_user_id : Matrix_proto.Id.User_id.t;
486 to_user_id : Matrix_proto.Id.User_id.t;
487 from_device_id : Matrix_proto.Id.Device_id.t option;
488 methods : string list;
489 timestamp : int64;
490 mutable accepted : bool;
491 mutable cancelled : bool;
492}
493
494(** Create a verification request *)
495let create_verification_request ~from_user_id ~to_user_id ?from_device_id () =
496 let flow_id = generate_flow_id () in
497 {
498 flow_id;
499 from_user_id;
500 to_user_id;
501 from_device_id;
502 methods = ["m.sas.v1"; "m.qr_code.show.v1"; "m.qr_code.scan.v1"];
503 timestamp = Int64.of_float (Unix.gettimeofday () *. 1000.0);
504 accepted = false;
505 cancelled = false;
506 }
507
508(** Accept a verification request *)
509let accept_verification_request request =
510 request.accepted <- true
511
512(** Cancel a verification request *)
513let cancel_verification_request request =
514 request.cancelled <- true
515
516(** {1 Cross-Signing Upload} *)
517
518(** Data needed to upload cross-signing keys *)
519type cross_signing_upload = {
520 master_key : cross_signing_pubkey;
521 self_signing_key : cross_signing_pubkey;
522 user_signing_key : cross_signing_pubkey;
523}
524
525(** Build upload data from private identity *)
526let build_cross_signing_upload (identity : private_cross_signing_identity) =
527 match identity.master_key, identity.self_signing_key, identity.user_signing_key with
528 | Some master, Some self_signing, Some user_signing ->
529 let user_id = identity.user_id in
530 Some {
531 master_key = pubkey_from_private ~user_id ~usage:Master master;
532 self_signing_key = pubkey_from_private ~user_id ~usage:Self_signing self_signing;
533 user_signing_key = pubkey_from_private ~user_id ~usage:User_signing user_signing;
534 }
535 | _ -> None