objective categorical abstract machine language personal data server
Cryptography implementation
+206
+9
dune-project
+9
dune-project
+29
kleidos.opam
+29
kleidos.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "Atproto-flavour k256 and p256 signing and verification"
4
+
maintainer: ["futurGH"]
5
+
authors: ["futurGH"]
6
+
license: "MPL-2.0"
7
+
homepage: "https://github.com/futurGH/pegasus"
8
+
bug-reports: "https://github.com/futurGH/pegasus/issues"
9
+
depends: [
10
+
"ocaml"
11
+
"dune" {>= "3.14"}
12
+
"hacl-star" {>= "0.7.2"}
13
+
"odoc" {with-doc}
14
+
]
15
+
build: [
16
+
["dune" "subst"] {dev}
17
+
[
18
+
"dune"
19
+
"build"
20
+
"-p"
21
+
name
22
+
"-j"
23
+
jobs
24
+
"@install"
25
+
"@runtest" {with-test}
26
+
"@doc" {with-doc}
27
+
]
28
+
]
29
+
dev-repo: "git+https://github.com/futurGH/pegasus.git"
+33
kleidos/kleidos.ml
+33
kleidos/kleidos.ml
···
1
+
module K256 = struct
2
+
open Hacl_star.Hacl
3
+
4
+
let sign ~privkey ~msg : bytes =
5
+
let hashed = SHA2_256.hash msg in
6
+
let k = Rfc6979.k_for_k256 ~privkey ~msg in
7
+
match K256.Libsecp256k1.sign ~sk:privkey ~msg:hashed ~k with
8
+
| Some signature ->
9
+
signature
10
+
| None ->
11
+
failwith "failed to sign message"
12
+
13
+
let verify ~pubkey ~msg ~signature : bool =
14
+
let hashed = SHA2_256.hash msg in
15
+
K256.Libsecp256k1.verify ~pk:pubkey ~msg:hashed ~signature
16
+
end
17
+
18
+
module P256 = struct
19
+
open Hacl_star.Hacl
20
+
21
+
let sign ~privkey ~msg : bytes =
22
+
let hashed = SHA2_256.hash msg in
23
+
let k = Rfc6979.k_for_p256 ~privkey ~msg in
24
+
match P256.sign ~sk:privkey ~msg:hashed ~k with
25
+
| Some signature ->
26
+
signature
27
+
| None ->
28
+
failwith "failed to sign message"
29
+
30
+
let verify ~pubkey ~msg ~signature : bool =
31
+
let hashed = SHA2_256.hash msg in
32
+
P256.verify ~pk:pubkey ~msg:hashed ~signature
33
+
end
+132
kleidos/rfc6979.ml
+132
kleidos/rfc6979.ml
···
1
+
(* rfc 6979 nonce "k" generation *)
2
+
3
+
(* curve orders *)
4
+
let n_secp256k1 =
5
+
Z.of_string_base 16
6
+
"FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141"
7
+
8
+
let n_secp256r1 =
9
+
Z.of_string_base 16
10
+
"FFFFFFFF00000000FFFFFFFFFFFFFFFFBCE6FAADA7179E84F3B9CAC2FC632551"
11
+
12
+
(* 32-byte big-endian to Z *)
13
+
let bytes32_to_z (b : bytes) : Z.t =
14
+
if Bytes.length b <> 32 then invalid_arg "expected 32 bytes" ;
15
+
Bytes.fold_left
16
+
(fun acc c -> Z.(add (shift_left acc 8) (of_int (Char.code c))))
17
+
Z.zero b
18
+
19
+
(* Z to fixed 32-byte big-endian *)
20
+
let z_to_bytes32 (z : Z.t) : bytes =
21
+
let out = Bytes.make 32 '\x00' in
22
+
let rec fill i v =
23
+
if i < 0 || v = Z.zero then ()
24
+
else (
25
+
Bytes.set out i (Char.chr Z.(to_int (logand v (of_int 0xFF)))) ;
26
+
fill (i - 1) Z.(shift_right v 8) )
27
+
in
28
+
fill 31 z ;
29
+
if z >= Z.(shift_left one 256) then invalid_arg "integer too large" ;
30
+
out
31
+
32
+
(* bits2int for qbits=256 (leftmost 256 bits is whole 32 bytes here) *)
33
+
let bits2int_256 (bs : bytes) : Z.t =
34
+
(* If bs > 32 bytes (not the case here), we'd truncate *)
35
+
let len = Bytes.length bs in
36
+
let take = if len <= 32 then len else 32 in
37
+
let acc = ref Z.zero in
38
+
for i = 0 to take - 1 do
39
+
acc := Z.(add (shift_left !acc 8) (of_int (Char.code (Bytes.get bs i))))
40
+
done ;
41
+
if len > 32 then
42
+
(* shift right extra bits if longer (not expected with SHA-256) *)
43
+
let extra_bits = (len - 32) * 8 in
44
+
Z.shift_right !acc extra_bits
45
+
else !acc
46
+
47
+
(* bits2octets per RFC 6979 §2.3.2: reduce hash to scalar-sized octets *)
48
+
let bits2octets_256 ~q h1 =
49
+
let z1 = bits2int_256 h1 in
50
+
let z2 = Z.(z1 mod q) in
51
+
z_to_bytes32 z2
52
+
53
+
(* hmac sha256 using only hash function *)
54
+
let hmac_sha256 ~(hash : bytes -> bytes) ~(key : bytes) (data : bytes) : bytes =
55
+
let block_size = 64 in
56
+
let key0 = if Bytes.length key > block_size then hash key else key in
57
+
let key_block =
58
+
if Bytes.length key0 = block_size then key0
59
+
else
60
+
let b = Bytes.make block_size '\x00' in
61
+
Bytes.blit key0 0 b 0 (Bytes.length key0) ;
62
+
b
63
+
in
64
+
let ipad = 0x36 and opad = 0x5c in
65
+
let inner_pad = Bytes.create block_size
66
+
and outer_pad = Bytes.create block_size in
67
+
for i = 0 to block_size - 1 do
68
+
let kc = Char.code (Bytes.get key_block i) in
69
+
Bytes.set inner_pad i (Char.chr (kc lxor ipad)) ;
70
+
Bytes.set outer_pad i (Char.chr (kc lxor opad))
71
+
done ;
72
+
let concat a b =
73
+
let out = Bytes.create (Bytes.length a + Bytes.length b) in
74
+
Bytes.blit a 0 out 0 (Bytes.length a) ;
75
+
Bytes.blit b 0 out (Bytes.length a) (Bytes.length b) ;
76
+
out
77
+
in
78
+
let inner = hash (concat inner_pad data) in
79
+
hash (concat outer_pad inner)
80
+
81
+
(* returns 32-byte k for given order q *)
82
+
let rfc6979_k_256_bytes ~(q : Z.t) ~(privkey : bytes) ~(msg : bytes) : bytes =
83
+
if Bytes.length privkey <> 32 then invalid_arg "privkey must be 32 bytes" ;
84
+
let x = bytes32_to_z privkey in
85
+
if x <= Z.zero || x >= q then invalid_arg "privkey scalar out of range" ;
86
+
let module H = Hacl_star.Hacl.SHA2_256 in
87
+
let hash = H.hash in
88
+
let hmac = hmac_sha256 ~hash in
89
+
let h1 = hash msg in
90
+
(* 32-byte SHA-256 digest *)
91
+
let x_octets = privkey in
92
+
(* already 32 bytes big-endian *)
93
+
let h1_red = bits2octets_256 ~q h1 in
94
+
let v = Bytes.make 32 '\x01' in
95
+
let k = Bytes.make 32 '\x00' in
96
+
let concat parts =
97
+
let total = List.fold_left (fun a b -> a + Bytes.length b) 0 parts in
98
+
let out = Bytes.create total in
99
+
ignore
100
+
@@ List.fold_left
101
+
(fun off b ->
102
+
Bytes.blit b 0 out off (Bytes.length b) ;
103
+
off + Bytes.length b )
104
+
0 parts ;
105
+
out
106
+
in
107
+
(* step: K = HMAC_K(V || 0x00 || x || h1); V = HMAC_K(V) *)
108
+
let k = hmac ~key:k (concat [v; Bytes.of_string "\x00"; x_octets; h1_red]) in
109
+
let v = hmac ~key:k v in
110
+
(* step: K = HMAC_K(V || 0x01 || x || h1); V = HMAC_K(V) *)
111
+
let k = hmac ~key:k (concat [v; Bytes.of_string "\x01"; x_octets; h1_red]) in
112
+
let v = hmac ~key:k v in
113
+
(* loop *)
114
+
let rec loop k v =
115
+
(* a. V = HMAC_K(V) *)
116
+
let v = hmac ~key:k v in
117
+
let t = v in
118
+
let k_candidate = bits2int_256 t in
119
+
if Z.(k_candidate >= one && k_candidate < q) then t
120
+
else
121
+
(* K = HMAC_K(V || 0x00); V = HMAC_K(V) *)
122
+
let k = hmac ~key:k (concat [v; Bytes.of_string "\x00"]) in
123
+
let v = hmac ~key:k v in
124
+
loop k v
125
+
in
126
+
loop k v
127
+
128
+
let k_for_k256 ~(privkey : bytes) ~(msg : bytes) : bytes =
129
+
rfc6979_k_256_bytes ~q:n_secp256k1 ~privkey ~msg
130
+
131
+
let k_for_p256 ~(privkey : bytes) ~(msg : bytes) : bytes =
132
+
rfc6979_k_256_bytes ~q:n_secp256r1 ~privkey ~msg