atproto libraries implementation in ocaml
gdiazlo.tngl.sh
1(** Crypto tests for AT Protocol.
2
3 Tests signature verification and did:key encoding using the official interop
4 test fixtures. *)
5
6open Atproto_crypto
7
8let () = Mirage_crypto_rng_unix.use_default ()
9
10(** Read test fixture file *)
11let read_fixture filename =
12 let path = "../fixtures/crypto/" ^ filename in
13 let ic = open_in path in
14 let content = In_channel.input_all ic in
15 close_in ic;
16 match Atproto_json.decode content with
17 | Ok json -> json
18 | Error e -> failwith ("JSON parse error: " ^ e)
19
20(** Base64 decode *)
21let base64_decode s =
22 (* Simple base64 decoder *)
23 let alphabet =
24 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
25 in
26 let decode_table = Array.make 256 (-1) in
27 String.iteri (fun i c -> decode_table.(Char.code c) <- i) alphabet;
28 let len = String.length s in
29 (* Remove padding and calculate output length *)
30 let padding =
31 if len >= 2 && s.[len - 1] = '=' && s.[len - 2] = '=' then 2
32 else if len >= 1 && s.[len - 1] = '=' then 1
33 else 0
34 in
35 let input_len = len - padding in
36 let output_len = input_len * 3 / 4 in
37 let buf = Bytes.create output_len in
38 let rec loop i j =
39 if i >= input_len then ()
40 else begin
41 let a = if i < len then decode_table.(Char.code s.[i]) else 0 in
42 let b = if i + 1 < len then decode_table.(Char.code s.[i + 1]) else 0 in
43 let c = if i + 2 < len then decode_table.(Char.code s.[i + 2]) else 0 in
44 let d = if i + 3 < len then decode_table.(Char.code s.[i + 3]) else 0 in
45 let triple = (a lsl 18) lor (b lsl 12) lor (c lsl 6) lor d in
46 if j < output_len then
47 Bytes.set buf j (Char.chr ((triple lsr 16) land 0xff));
48 if j + 1 < output_len then
49 Bytes.set buf (j + 1) (Char.chr ((triple lsr 8) land 0xff));
50 if j + 2 < output_len then
51 Bytes.set buf (j + 2) (Char.chr (triple land 0xff));
52 loop (i + 4) (j + 3)
53 end
54 in
55 loop 0 0;
56 Bytes.to_string buf
57
58(** Hex decode *)
59let hex_decode s =
60 let len = String.length s in
61 let buf = Bytes.create (len / 2) in
62 for i = 0 to (len / 2) - 1 do
63 let hi =
64 let c = s.[i * 2] in
65 if c >= '0' && c <= '9' then Char.code c - Char.code '0'
66 else if c >= 'a' && c <= 'f' then Char.code c - Char.code 'a' + 10
67 else if c >= 'A' && c <= 'F' then Char.code c - Char.code 'A' + 10
68 else failwith "invalid hex char"
69 in
70 let lo =
71 let c = s.[(i * 2) + 1] in
72 if c >= '0' && c <= '9' then Char.code c - Char.code '0'
73 else if c >= 'a' && c <= 'f' then Char.code c - Char.code 'a' + 10
74 else if c >= 'A' && c <= 'F' then Char.code c - Char.code 'A' + 10
75 else failwith "invalid hex char"
76 in
77 Bytes.set buf i (Char.chr ((hi lsl 4) lor lo))
78 done;
79 Bytes.to_string buf
80
81(* === Signature verification tests === *)
82
83let test_signature_verification () =
84 let fixtures = read_fixture "signature-fixtures.json" in
85 match Atproto_json.to_array_opt fixtures with
86 | Some items ->
87 List.iter
88 (fun item ->
89 match Atproto_json.to_object_opt item with
90 | Some fields ->
91 let comment =
92 match Atproto_json.get_string_opt "comment" fields with
93 | Some s -> s
94 | None -> "unknown"
95 in
96 let message_b64 =
97 match Atproto_json.get_string_opt "messageBase64" fields with
98 | Some s -> s
99 | None -> failwith "missing messageBase64"
100 in
101 let algorithm =
102 match Atproto_json.get_string_opt "algorithm" fields with
103 | Some s -> s
104 | None -> failwith "missing algorithm"
105 in
106 let public_key_did =
107 match Atproto_json.get_string_opt "publicKeyDid" fields with
108 | Some s -> s
109 | None -> failwith "missing publicKeyDid"
110 in
111 let signature_b64 =
112 match Atproto_json.get_string_opt "signatureBase64" fields with
113 | Some s -> s
114 | None -> failwith "missing signatureBase64"
115 in
116 let valid_signature =
117 match Atproto_json.get "validSignature" fields with
118 | Some json -> (
119 match Atproto_json.to_bool_opt json with
120 | Some b -> b
121 | None -> failwith "missing validSignature")
122 | None -> failwith "missing validSignature"
123 in
124 let tags =
125 match Atproto_json.get_array_opt "tags" fields with
126 | Some tags -> List.filter_map Atproto_json.to_string_opt tags
127 | None -> []
128 in
129
130 (* Decode inputs *)
131 let message = base64_decode message_b64 in
132 let signature = base64_decode signature_b64 in
133
134 (* Skip DER-encoded tests (we only support raw format) *)
135 if List.mem "der-encoded" tags then begin
136 Printf.printf "SKIP (DER): %s\n%!" comment;
137 (* DER-encoded signatures should fail - verify returns Error *)
138 match Did_key.decode public_key_did with
139 | Ok key ->
140 let result = Did_key.verify key message signature in
141 Alcotest.(check bool)
142 ("DER should fail: " ^ comment)
143 false (Result.is_ok result)
144 | Error _ ->
145 (* If we can't decode the key, that's also a fail which is correct *)
146 ()
147 end
148 else begin
149 Printf.printf "TEST %s: %s (alg=%s)\n%!"
150 (if valid_signature then "valid" else "invalid")
151 comment algorithm;
152
153 (* Decode the did:key *)
154 match Did_key.decode public_key_did with
155 | Error e ->
156 Alcotest.fail
157 (Printf.sprintf "Failed to decode did:key: %s - %s"
158 public_key_did
159 (Did_key.error_to_string e))
160 | Ok key ->
161 (* Verify the algorithm matches *)
162 let expected_alg = Did_key.algorithm key in
163 Alcotest.(check string)
164 "algorithm matches" algorithm expected_alg;
165
166 (* Verify the signature *)
167 let result = Did_key.verify key message signature in
168 let is_valid = Result.is_ok result in
169 Alcotest.(check bool)
170 (Printf.sprintf "signature validity: %s" comment)
171 valid_signature is_valid
172 end
173 | None -> failwith "expected object in fixture array")
174 items
175 | None -> failwith "expected array in fixture file"
176
177(* === did:key encoding tests for K-256 === *)
178
179let test_didkey_k256 () =
180 let fixtures = read_fixture "w3c_didkey_K256.json" in
181 match Atproto_json.to_array_opt fixtures with
182 | Some items ->
183 List.iter
184 (fun item ->
185 match Atproto_json.to_object_opt item with
186 | Some fields -> (
187 let private_key_hex =
188 match
189 Atproto_json.get_string_opt "privateKeyBytesHex" fields
190 with
191 | Some s -> s
192 | None -> failwith "missing privateKeyBytesHex"
193 in
194 let expected_did =
195 match Atproto_json.get_string_opt "publicDidKey" fields with
196 | Some s -> s
197 | None -> failwith "missing publicDidKey"
198 in
199
200 (* Decode private key and derive public key *)
201 let priv_bytes = hex_decode private_key_hex in
202 match K256.private_of_bytes priv_bytes with
203 | Error e ->
204 Alcotest.fail
205 (Printf.sprintf "Failed to decode K256 private key: %s"
206 (K256.error_to_string e))
207 | Ok priv -> (
208 let pub = K256.public priv in
209 let did = Did_key.encode (K256 pub) in
210 Printf.printf "K256 did:key test: %s\n%!" expected_did;
211 Alcotest.(check string) "did:key matches" expected_did did;
212
213 (* Also test roundtrip *)
214 match Did_key.decode did with
215 | Error e ->
216 Alcotest.fail
217 (Printf.sprintf "Failed to decode generated did:key: %s"
218 (Did_key.error_to_string e))
219 | Ok (K256 _pub') -> ()
220 | Ok (P256 _) ->
221 Alcotest.fail "decoded as P256 instead of K256"))
222 | None -> failwith "expected object in fixture array")
223 items
224 | None -> failwith "expected array in fixture file"
225
226(* === did:key encoding tests for P-256 === *)
227
228let test_didkey_p256 () =
229 let fixtures = read_fixture "w3c_didkey_P256.json" in
230 match Atproto_json.to_array_opt fixtures with
231 | Some items ->
232 List.iter
233 (fun item ->
234 match Atproto_json.to_object_opt item with
235 | Some fields -> (
236 let private_key_b58 =
237 match
238 Atproto_json.get_string_opt "privateKeyBytesBase58" fields
239 with
240 | Some s -> s
241 | None -> failwith "missing privateKeyBytesBase58"
242 in
243 let expected_did =
244 match Atproto_json.get_string_opt "publicDidKey" fields with
245 | Some s -> s
246 | None -> failwith "missing publicDidKey"
247 in
248
249 (* Decode private key and derive public key *)
250 match Atproto_multibase.Base58btc.decode private_key_b58 with
251 | Error _ -> Alcotest.fail "Failed to decode base58 private key"
252 | Ok priv_bytes -> (
253 let priv_str = Bytes.to_string priv_bytes in
254 match P256.private_of_bytes priv_str with
255 | Error e ->
256 Alcotest.fail
257 (Printf.sprintf "Failed to decode P256 private key: %s"
258 (P256.error_to_string e))
259 | Ok priv -> (
260 let pub = P256.public priv in
261 let did = Did_key.encode (P256 pub) in
262 Printf.printf "P256 did:key test: %s\n%!" expected_did;
263 Alcotest.(check string) "did:key matches" expected_did did;
264
265 (* Also test roundtrip *)
266 match Did_key.decode did with
267 | Error e ->
268 Alcotest.fail
269 (Printf.sprintf
270 "Failed to decode generated did:key: %s"
271 (Did_key.error_to_string e))
272 | Ok (P256 _pub') -> ()
273 | Ok (K256 _) ->
274 Alcotest.fail "decoded as K256 instead of P256")))
275 | None -> failwith "expected object in fixture array")
276 items
277 | None -> failwith "expected array in fixture file"
278
279(* === Basic P256 signing tests === *)
280
281let test_p256_sign_verify () =
282 let priv = P256.generate () in
283 let pub = P256.public priv in
284 let message = "Hello, AT Protocol!" in
285 let signature = P256.sign priv message in
286
287 (* Verify signature is correct length *)
288 Alcotest.(check int) "signature length" 64 (String.length signature);
289
290 (* Verify signature is valid *)
291 match P256.verify pub message signature with
292 | Ok () -> ()
293 | Error e ->
294 Alcotest.fail
295 (Printf.sprintf "signature verification failed: %s"
296 (P256.error_to_string e))
297
298let test_p256_invalid_signature () =
299 let priv = P256.generate () in
300 let pub = P256.public priv in
301 let message = "Hello, AT Protocol!" in
302 let signature = P256.sign priv message in
303
304 (* Modify signature - it should fail verification *)
305 let bad_sig =
306 String.init 64 (fun i ->
307 if i = 0 then Char.chr ((Char.code signature.[0] + 1) mod 256)
308 else signature.[i])
309 in
310 match P256.verify pub message bad_sig with
311 | Ok () -> Alcotest.fail "modified signature should not verify"
312 | Error _ -> ()
313
314(* === Basic K256 signing tests === *)
315
316let test_k256_sign_verify () =
317 let priv = K256.generate () in
318 let pub = K256.public priv in
319 let message = "Hello, AT Protocol!" in
320 let signature = K256.sign priv message in
321
322 (* Verify signature is correct length *)
323 Alcotest.(check int) "signature length" 64 (String.length signature);
324
325 (* Verify signature is valid *)
326 match K256.verify pub message signature with
327 | Ok () -> ()
328 | Error e ->
329 Alcotest.fail
330 (Printf.sprintf "signature verification failed: %s"
331 (K256.error_to_string e))
332
333let test_k256_invalid_signature () =
334 let priv = K256.generate () in
335 let pub = K256.public priv in
336 let message = "Hello, AT Protocol!" in
337 let signature = K256.sign priv message in
338
339 (* Modify signature - it should fail verification *)
340 let bad_sig =
341 String.init 64 (fun i ->
342 if i = 0 then Char.chr ((Char.code signature.[0] + 1) mod 256)
343 else signature.[i])
344 in
345 match K256.verify pub message bad_sig with
346 | Ok () -> Alcotest.fail "modified signature should not verify"
347 | Error _ -> ()
348
349(* === JWT tests === *)
350
351let test_jwt_create_verify_p256 () =
352 let priv = P256.generate () in
353 let pub = P256.public priv in
354 let now = Int64.of_float (Unix.time ()) in
355 let exp = Int64.add now 3600L in
356 (* 1 hour from now *)
357
358 let claims : Jwt.claims =
359 {
360 iss = "did:plc:test123";
361 sub = Some "did:plc:user456";
362 aud = "https://bsky.social";
363 exp;
364 iat = now;
365 jti = Some "unique-id-123";
366 lxm = None;
367 nonce = None;
368 scope = Some "atproto";
369 }
370 in
371
372 let token = Jwt.create ~key:(Jwt.P256_key priv) ~typ:"at+jwt" ~claims in
373 let token_str = Jwt.to_string token in
374
375 (* Verify token structure (3 parts separated by dots) *)
376 let parts = String.split_on_char '.' token_str in
377 Alcotest.(check int) "JWT has 3 parts" 3 (List.length parts);
378
379 (* Verify we can decode and verify *)
380 match Jwt.decode_and_verify ~key:(Jwt.P256_pub pub) ~now token_str with
381 | Ok decoded ->
382 Alcotest.(check string) "iss" "did:plc:test123" decoded.claims.iss;
383 Alcotest.(check (option string))
384 "sub" (Some "did:plc:user456") decoded.claims.sub;
385 Alcotest.(check string) "aud" "https://bsky.social" decoded.claims.aud;
386 Alcotest.(check string) "typ" "at+jwt" decoded.header.typ
387 | Error e ->
388 Alcotest.fail
389 (Printf.sprintf "JWT verification failed: %s" (Jwt.error_to_string e))
390
391let test_jwt_create_verify_k256 () =
392 let priv = K256.generate () in
393 let pub = K256.public priv in
394 let now = Int64.of_float (Unix.time ()) in
395 let exp = Int64.add now 3600L in
396
397 let claims : Jwt.claims =
398 {
399 iss = "did:plc:test123";
400 sub = None;
401 aud = "did:web:pds.example.com";
402 exp;
403 iat = now;
404 jti = None;
405 lxm = Some "com.atproto.repo.createRecord";
406 nonce = None;
407 scope = None;
408 }
409 in
410
411 let token = Jwt.create ~key:(Jwt.K256_key priv) ~typ:"at+jwt" ~claims in
412
413 match
414 Jwt.decode_and_verify ~key:(Jwt.K256_pub pub) ~now (Jwt.to_string token)
415 with
416 | Ok decoded ->
417 Alcotest.(check string)
418 "algorithm" "ES256K"
419 (Jwt.algorithm_to_string decoded.header.alg);
420 Alcotest.(check (option string))
421 "lxm" (Some "com.atproto.repo.createRecord") decoded.claims.lxm
422 | Error e ->
423 Alcotest.fail
424 (Printf.sprintf "JWT verification failed: %s" (Jwt.error_to_string e))
425
426let test_jwt_expired () =
427 let priv = P256.generate () in
428 let pub = P256.public priv in
429 let now = Int64.of_float (Unix.time ()) in
430 let exp = Int64.sub now 3600L in
431 (* Expired 1 hour ago *)
432
433 let claims : Jwt.claims =
434 {
435 iss = "did:plc:test123";
436 sub = None;
437 aud = "https://bsky.social";
438 exp;
439 iat = Int64.sub now 7200L;
440 (* Created 2 hours ago *)
441 jti = None;
442 lxm = None;
443 nonce = None;
444 scope = None;
445 }
446 in
447
448 let token = Jwt.create ~key:(Jwt.P256_key priv) ~typ:"at+jwt" ~claims in
449
450 match
451 Jwt.decode_and_verify ~key:(Jwt.P256_pub pub) ~now (Jwt.to_string token)
452 with
453 | Ok _ -> Alcotest.fail "Expired token should not verify"
454 | Error `Expired -> ()
455 | Error e ->
456 Alcotest.fail
457 (Printf.sprintf "Expected Expired error, got: %s"
458 (Jwt.error_to_string e))
459
460let test_jwt_invalid_signature () =
461 let priv = P256.generate () in
462 let other_priv = P256.generate () in
463 let other_pub = P256.public other_priv in
464 let now = Int64.of_float (Unix.time ()) in
465 let exp = Int64.add now 3600L in
466
467 let claims : Jwt.claims =
468 {
469 iss = "did:plc:test123";
470 sub = None;
471 aud = "https://bsky.social";
472 exp;
473 iat = now;
474 jti = None;
475 lxm = None;
476 nonce = None;
477 scope = None;
478 }
479 in
480
481 let token = Jwt.create ~key:(Jwt.P256_key priv) ~typ:"at+jwt" ~claims in
482
483 (* Verify with a different key - should fail *)
484 match
485 Jwt.decode_and_verify ~key:(Jwt.P256_pub other_pub) ~now
486 (Jwt.to_string token)
487 with
488 | Ok _ -> Alcotest.fail "Token signed with different key should not verify"
489 | Error `Invalid_signature -> ()
490 | Error e ->
491 Alcotest.fail
492 (Printf.sprintf "Expected Invalid_signature error, got: %s"
493 (Jwt.error_to_string e))
494
495let test_jwt_decode_unverified () =
496 let priv = P256.generate () in
497 let now = Int64.of_float (Unix.time ()) in
498 let exp = Int64.add now 3600L in
499
500 let claims : Jwt.claims =
501 {
502 iss = "did:plc:issuer";
503 sub = Some "did:plc:subject";
504 aud = "https://audience.example";
505 exp;
506 iat = now;
507 jti = Some "jti-value";
508 lxm = None;
509 nonce = None;
510 scope = None;
511 }
512 in
513
514 let token = Jwt.create ~key:(Jwt.P256_key priv) ~typ:"refresh+jwt" ~claims in
515
516 (* Decode without verification *)
517 match Jwt.decode_unverified (Jwt.to_string token) with
518 | Ok decoded ->
519 Alcotest.(check string) "typ" "refresh+jwt" decoded.header.typ;
520 Alcotest.(check string) "iss" "did:plc:issuer" decoded.claims.iss
521 | Error e ->
522 Alcotest.fail (Printf.sprintf "Decode failed: %s" (Jwt.error_to_string e))
523
524let test_jwt_invalid_format () =
525 match Jwt.decode_unverified "not.a.valid.jwt.with.too.many.parts" with
526 | Ok _ -> Alcotest.fail "Invalid format should fail"
527 | Error `Invalid_format -> ()
528 | Error e ->
529 Alcotest.fail
530 (Printf.sprintf "Expected Invalid_format, got: %s"
531 (Jwt.error_to_string e))
532
533let test_jwt_access_token_helper () =
534 let priv = P256.generate () in
535 let pub = P256.public priv in
536 let now = Int64.of_float (Unix.time ()) in
537 let exp = Int64.add now 3600L in
538
539 let token =
540 Jwt.create_access_token ~key:(Jwt.P256_key priv) ~iss:"did:plc:issuer"
541 ~sub:"did:plc:subject" ~aud:"https://pds.example.com" ~exp ~iat:now
542 ~scope:"atproto transition:generic" ()
543 in
544
545 match
546 Jwt.decode_and_verify ~key:(Jwt.P256_pub pub) ~now (Jwt.to_string token)
547 with
548 | Ok decoded ->
549 Alcotest.(check string) "typ" "at+jwt" decoded.header.typ;
550 Alcotest.(check (option string))
551 "scope" (Some "atproto transition:generic") decoded.claims.scope
552 | Error e ->
553 Alcotest.fail
554 (Printf.sprintf "Verification failed: %s" (Jwt.error_to_string e))
555
556let test_jwt_service_token_helper () =
557 let priv = K256.generate () in
558 let pub = K256.public priv in
559 let now = Int64.of_float (Unix.time ()) in
560 let exp = Int64.add now 60L in
561 (* Short-lived service token *)
562
563 let token =
564 Jwt.create_service_token ~key:(Jwt.K256_key priv) ~iss:"did:plc:service"
565 ~aud:"did:web:pds.example.com" ~exp ~iat:now
566 ~lxm:"com.atproto.server.createSession" ()
567 in
568
569 match
570 Jwt.decode_and_verify ~key:(Jwt.K256_pub pub) ~now (Jwt.to_string token)
571 with
572 | Ok decoded ->
573 Alcotest.(check (option string))
574 "lxm" (Some "com.atproto.server.createSession") decoded.claims.lxm;
575 Alcotest.(check (option string))
576 "sub should be None" None decoded.claims.sub
577 | Error e ->
578 Alcotest.fail
579 (Printf.sprintf "Verification failed: %s" (Jwt.error_to_string e))
580
581(* === Test suites === *)
582
583let signature_tests =
584 [
585 Alcotest.test_case "signature verification" `Quick
586 test_signature_verification;
587 ]
588
589let didkey_tests =
590 [
591 Alcotest.test_case "K-256 did:key encoding" `Quick test_didkey_k256;
592 Alcotest.test_case "P-256 did:key encoding" `Quick test_didkey_p256;
593 ]
594
595let p256_tests =
596 [
597 Alcotest.test_case "sign and verify" `Quick test_p256_sign_verify;
598 Alcotest.test_case "invalid signature" `Quick test_p256_invalid_signature;
599 ]
600
601let k256_tests =
602 [
603 Alcotest.test_case "sign and verify" `Quick test_k256_sign_verify;
604 Alcotest.test_case "invalid signature" `Quick test_k256_invalid_signature;
605 ]
606
607let jwt_tests =
608 [
609 Alcotest.test_case "create and verify P256" `Quick
610 test_jwt_create_verify_p256;
611 Alcotest.test_case "create and verify K256" `Quick
612 test_jwt_create_verify_k256;
613 Alcotest.test_case "expired token" `Quick test_jwt_expired;
614 Alcotest.test_case "invalid signature" `Quick test_jwt_invalid_signature;
615 Alcotest.test_case "decode unverified" `Quick test_jwt_decode_unverified;
616 Alcotest.test_case "invalid format" `Quick test_jwt_invalid_format;
617 Alcotest.test_case "access token helper" `Quick test_jwt_access_token_helper;
618 Alcotest.test_case "service token helper" `Quick
619 test_jwt_service_token_helper;
620 ]
621
622let () =
623 Alcotest.run "atproto-crypto"
624 [
625 ("signature", signature_tests);
626 ("did_key", didkey_tests);
627 ("p256", p256_tests);
628 ("k256", k256_tests);
629 ("jwt", jwt_tests);
630 ]