futur.blue
objective categorical abstract machine language personal data server
1open struct
2 let to_multikey key ~prefix : string =
3 match
4 Multibase.encode_t `Base58btc (Bytes.to_string @@ Bytes.cat prefix key)
5 with
6 | Ok multikey ->
7 multikey
8 | Error (`Msg msg) ->
9 failwith (Format.sprintf "failed to encode key as multikey: %s" msg)
10
11 let bytes_of_multikey multikey : bytes =
12 match Multibase.decode multikey with
13 | Ok (_, k) ->
14 Bytes.of_string k
15 | Error (`Msg msg) ->
16 failwith msg
17 | Error (`Unsupported e) ->
18 failwith
19 ( "unsupported key multibase encoding "
20 ^ Multibase.Encoding.to_string e )
21end
22
23module type CURVE = sig
24 val name : string
25
26 val public_prefix : bytes
27
28 val private_prefix : bytes
29
30 val normalize_pubkey_to_raw : bytes -> bytes
31
32 val low_s_normalize_signature : bytes -> bytes
33
34 val sign : privkey:bytes -> msg:bytes -> bytes
35
36 val verify : pubkey:bytes -> msg:bytes -> signature:bytes -> bool
37
38 val is_valid_privkey : bytes -> bool
39
40 val derive_pubkey : privkey:bytes -> bytes
41
42 val generate_keypair : unit -> bytes * bytes
43
44 val privkey_to_multikey : bytes -> string
45
46 val pubkey_to_multikey : bytes -> string
47
48 val pubkey_to_did_key : bytes -> string
49end
50
51module K256 : CURVE = struct
52 open Hacl_star.Hacl
53
54 let name = "K256"
55
56 let public_prefix = Bytes.of_string "\xe7\x01"
57
58 let private_prefix = Bytes.of_string "\x81\x26"
59
60 let normalize_pubkey_to_raw key : bytes =
61 match Bytes.length key with
62 | 64 ->
63 key
64 | 65 -> (
65 match K256.uncompressed_to_raw key with
66 | Some raw ->
67 raw
68 | None ->
69 failwith "invalid uncompressed key" )
70 | 33 -> (
71 match K256.compressed_to_raw key with
72 | Some raw ->
73 raw
74 | None ->
75 failwith "invalid compressed key" )
76 | len ->
77 failwith ("invalid key length: " ^ string_of_int len)
78
79 let low_s_normalize_signature = Low_s.normalize_k256
80
81 let sign ~privkey ~msg : bytes =
82 let hashed = SHA2_256.hash msg in
83 let k = Rfc6979.k_for_k256 ~privkey ~msg in
84 match K256.Libsecp256k1.sign ~sk:privkey ~msg:hashed ~k with
85 | Some sgn ->
86 Low_s.normalize_k256 sgn
87 | None ->
88 failwith "failed to sign message"
89
90 let verify ~pubkey ~msg ~signature : bool =
91 let hashed = SHA2_256.hash msg in
92 let pk = normalize_pubkey_to_raw pubkey in
93 K256.Libsecp256k1.verify ~pk ~msg:hashed ~signature
94
95 let is_valid_privkey privkey : bool = K256.valid_sk ~sk:privkey
96
97 let derive_pubkey ~privkey : bytes =
98 if not (is_valid_privkey privkey) then failwith "invalid p256 private key" ;
99 match K256.secret_to_public ~sk:privkey with
100 | Some pubkey ->
101 K256.raw_to_compressed pubkey
102 | None ->
103 failwith "failed to derive public key"
104
105 let generate_keypair () : bytes * bytes =
106 (* P256 is fine for generating a privkey for either curve,
107 but the accompanying public key won't work K256 *)
108 let open Mirage_crypto_ec.P256.Dsa in
109 let privkey = generate () |> fst |> priv_to_octets |> Bytes.of_string in
110 (privkey, derive_pubkey ~privkey)
111
112 let privkey_to_multikey privkey : string =
113 to_multikey privkey ~prefix:private_prefix
114
115 let pubkey_to_multikey pubkey : string =
116 to_multikey pubkey ~prefix:public_prefix
117
118 let pubkey_to_did_key pubkey : string = "did:key:" ^ pubkey_to_multikey pubkey
119end
120
121module P256 : CURVE = struct
122 open Hacl_star.Hacl
123
124 let name = "P256"
125
126 let public_prefix = Bytes.of_string "\x80\x24"
127
128 let private_prefix = Bytes.of_string "\x86\x26"
129
130 let normalize_pubkey_to_raw key : bytes =
131 match Bytes.length key with
132 | 64 | 32 ->
133 key
134 | 65 -> (
135 match P256.uncompressed_to_raw key with
136 | Some raw ->
137 raw
138 | None ->
139 failwith "invalid uncompressed key" )
140 | 33 -> (
141 match P256.compressed_to_raw key with
142 | Some raw ->
143 raw
144 | None ->
145 failwith "invalid compressed key" )
146 | len ->
147 failwith ("invalid key length: " ^ string_of_int len)
148
149 let low_s_normalize_signature = Low_s.normalize_p256
150
151 let sign ~privkey ~msg : bytes =
152 let hashed = SHA2_256.hash msg in
153 let k = Rfc6979.k_for_p256 ~privkey ~msg in
154 match P256.sign ~sk:privkey ~msg:hashed ~k with
155 | Some sgn ->
156 Low_s.normalize_p256 sgn
157 | None ->
158 failwith "failed to sign message"
159
160 let verify ~pubkey ~msg ~signature : bool =
161 let hashed = SHA2_256.hash msg in
162 let pk = normalize_pubkey_to_raw pubkey in
163 P256.verify ~pk ~msg:hashed ~signature
164
165 let is_valid_privkey privkey : bool = P256.valid_sk ~sk:privkey
166
167 let derive_pubkey ~privkey : bytes =
168 if not (is_valid_privkey privkey) then failwith "invalid p256 private key" ;
169 match P256.dh_initiator ~sk:privkey with
170 | Some pubkey ->
171 P256.raw_to_compressed pubkey
172 | None ->
173 failwith "failed to derive public key"
174
175 let generate_keypair () : bytes * bytes =
176 (* don't know why but the pubkey returned by generate () fails to validate
177 so we derive our own *)
178 let open Mirage_crypto_ec.P256.Dsa in
179 let privkey = generate () |> fst |> priv_to_octets |> Bytes.of_string in
180 (privkey, derive_pubkey ~privkey)
181
182 let privkey_to_multikey privkey : string =
183 to_multikey privkey ~prefix:private_prefix
184
185 let pubkey_to_multikey pubkey : string =
186 to_multikey pubkey ~prefix:public_prefix
187
188 let pubkey_to_did_key pubkey : string = "did:key:" ^ pubkey_to_multikey pubkey
189end
190
191type key = bytes * (module CURVE)
192
193let parse_multikey_bytes bytes : key =
194 if Bytes.length bytes < 3 then failwith "multikey too short" ;
195 let b0 = int_of_char (Bytes.get bytes 0) in
196 let b1 = int_of_char (Bytes.get bytes 1) in
197 let type_code = (b0 lsl 8) lor b1 in
198 let key = Bytes.sub bytes 2 (Bytes.length bytes - 2) in
199 match type_code with
200 | 0x8626 ->
201 (* p256 privkey *)
202 (key, (module P256 : CURVE))
203 | 0x8024 ->
204 (* p256 pubkey *)
205 (key, (module P256 : CURVE))
206 | 0x8126 ->
207 (* k256 privkey *)
208 (key, (module K256 : CURVE))
209 | 0xe701 ->
210 (* k256 pubkey *)
211 (key, (module K256 : CURVE))
212 | _ ->
213 failwith (Printf.sprintf "invalid key type 0x%04x" type_code)
214
215let parse_multikey_str multikey : key =
216 multikey |> bytes_of_multikey |> parse_multikey_bytes
217
218let sign ~privkey ~msg : bytes =
219 let privkey, (module Curve : CURVE) = privkey in
220 Curve.sign ~privkey ~msg
221
222let verify ~pubkey ~msg ~signature : bool =
223 let pubkey, (module Curve : CURVE) = pubkey in
224 Curve.verify ~pubkey ~msg ~signature
225
226let pubkey_to_did_key pubkey : string =
227 let pubkey, (module Curve : CURVE) = pubkey in
228 Curve.pubkey_to_did_key pubkey
229
230let derive_pubkey privkey : key =
231 let privkey, (module Curve : CURVE) = privkey in
232 (Curve.derive_pubkey ~privkey, (module Curve : CURVE))
233
234let privkey_to_multikey privkey : string =
235 let privkey, (module Curve : CURVE) = privkey in
236 Curve.privkey_to_multikey privkey