package secp256k1-internal

  1. Overview
  2. Docs

Source file external.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
module Context = struct
  type t

  external create : int -> t = "caml_secp256k1_context_create"
  external clone : t -> t = "caml_secp256k1_context_clone"
  external randomize : t -> Bigstring.t -> bool = "caml_secp256k1_context_randomize" [@@noalloc]

  let create ?(sign=true) ?(verify=true) () =
    let flags = 1 lor
                (if sign then 0x100 else 0) lor
                (if verify then 0x200 else 0) in
    create flags

  let randomize ctx buf =
    if Bigstring.length buf < 32 then
      invalid_arg "Context.randomize: input must be at least 32 bytes long" ;
    randomize ctx buf
end

module Key = struct
  type secret
  type public
  type _ t =
    | Sk : Bigstring.t -> secret t
    | Pk : Bigstring.t -> public t

  let buffer : type a. a t -> Bigstring.t = function
    | Sk sk -> sk
    | Pk pk -> pk

  let secret_bytes = 32
  let public_bytes = 64
  let compressed_pk_bytes = 33
  let uncompressed_pk_bytes = 65

  let bytes : type a. a t -> int = function
    | Sk _ -> secret_bytes
    | Pk _ -> public_bytes

  let serialized_bytes :
    type a. ?compressed:bool -> a t -> int =
    fun ?(compressed=true) -> function
      | Sk _ -> secret_bytes
      | Pk _ -> if compressed then public_bytes + 1 else secret_bytes + 1

  let equal : type a. a t -> a t -> bool = fun a b ->
    match a, b with
    | Sk a, Sk b -> Bigstring.equal a b
    | Pk a, Pk b -> Bigstring.equal a b

  let copy : type a. a t -> a t = function
    | Sk sk -> Sk (Bigstring.copy sk)
    | Pk pk -> Pk (Bigstring.copy pk)

  external sk_negate_inplace : Context.t -> Bigstring.t -> unit =
    "caml_secp256k1_ec_privkey_negate" [@@noalloc]
  external sk_add_tweak_inplace : Context.t -> Bigstring.t -> Bigstring.t -> bool =
    "caml_secp256k1_ec_privkey_tweak_add" [@@noalloc]
  external sk_mul_tweak_inplace : Context.t -> Bigstring.t -> Bigstring.t -> bool =
    "caml_secp256k1_ec_privkey_tweak_mul" [@@noalloc]
  external pk_negate_inplace : Context.t -> Bigstring.t -> unit =
    "caml_secp256k1_ec_pubkey_negate" [@@noalloc]
  external pk_add_tweak_inplace : Context.t -> Bigstring.t -> Bigstring.t -> bool =
    "caml_secp256k1_ec_pubkey_tweak_add" [@@noalloc]
  external pk_mul_tweak_inplace : Context.t -> Bigstring.t -> Bigstring.t -> bool =
    "caml_secp256k1_ec_pubkey_tweak_mul" [@@noalloc]
  external pk_combine : Context.t -> Bigstring.t -> Bigstring.t list -> bool =
    "caml_secp256k1_ec_pubkey_combine" [@@noalloc]

  let negate_inplace :
    type a. Context.t -> a t -> unit = fun ctx -> function
    | Sk k -> sk_negate_inplace ctx k
    | Pk k -> pk_negate_inplace ctx k

  let negate ctx k =
    let k' = copy k in
    negate_inplace ctx k' ;
    k'

  let op_tweak :
    type a. string -> (Context.t -> Bigstring.t -> Bigstring.t -> bool) ->
    Context.t -> a t -> Bigstring.t -> Bigstring.t =
    fun name f ctx k buf ->
      let buflen = Bigstring.length buf in
      if buflen < 32 then
        invalid_arg (Printf.sprintf "Key.%s: " name) ;
      let k' = buffer (copy k) in
      if not (f ctx k' buf) then
        failwith (Printf.sprintf "Key.%s: operation failed" name) ;
      k'

  let add_tweak :
    type a. Context.t -> a t -> Bigstring.t -> a t =
    fun ctx k buf ->
      match k with
      | Sk _ -> Sk (op_tweak "add_tweak" sk_add_tweak_inplace ctx k buf)
      | Pk _ -> Pk (op_tweak "add_tweak" pk_add_tweak_inplace ctx k buf)

  let mul_tweak :
    type a. Context.t -> a t -> Bigstring.t -> a t =
    fun ctx k buf ->
      match k with
      | Sk _ -> Sk (op_tweak "mul_tweak" sk_mul_tweak_inplace ctx k buf)
      | Pk _ -> Pk (op_tweak "mul_tweak" pk_mul_tweak_inplace ctx k buf)

  external pk_parse : Context.t -> Bigstring.t -> Bigstring.t -> bool =
    "caml_secp256k1_ec_pubkey_parse" [@@noalloc]
  external pk_serialize : Context.t -> Bigstring.t -> Bigstring.t -> int =
    "caml_secp256k1_ec_pubkey_serialize" [@@noalloc]
  external pk_create : Context.t -> Bigstring.t -> Bigstring.t -> bool =
    "caml_secp256k1_ec_pubkey_create" [@@noalloc]

  let neuterize :
    type a. Context.t -> a t -> public t option = fun ctx -> function
    | Pk pk -> Some (Pk pk)
    | Sk sk ->
        let pk = Bigstring.create public_bytes in
        if pk_create ctx pk sk then Some (Pk pk) else None

  let neuterize_exn ctx k =
    match neuterize ctx k with
    | None -> invalid_arg "Key.neuterize_exn: invalid secret key"
    | Some pk -> pk

  let list_map_filter_opt ~f l =
    ListLabels.fold_left ~init:[] ~f:begin fun a e ->
      match f e with
      | None -> a
      | Some r -> r :: a
    end l

  let combine ctx pks =
    let nb_pks = List.length pks in
    if nb_pks = 0 || nb_pks > 1024 then None
    else
      let pk = Bigstring.create public_bytes in
      let pks = list_map_filter_opt ~f:begin fun k ->
          match neuterize ctx k with
          | None -> None
          | Some (Pk k) -> Some k
        end pks in
      if pk_combine ctx pk pks then Some (Pk pk)
      else None

  let combine_exn ctx pks =
    match combine ctx pks with
    | None -> invalid_arg "Key.combine_exn: sum of pks is invalid"
    | Some pk -> pk

  external verify_sk : Context.t -> Bigstring.t -> bool =
    "caml_secp256k1_ec_seckey_verify" [@@noalloc]

  let read_sk_exn ctx buf =
    let buflen = Bigstring.length buf in
    if buflen < secret_bytes then
      invalid_arg (Printf.sprintf "Key.read_sk: invalid buffer size %d" buflen) ;
    match verify_sk ctx buf with
    | true -> Sk Bigstring.(copy (sub buf 0 secret_bytes))
    | false -> invalid_arg "Key.read_sk: secret key is invalid"

  let read_sk ctx buf =
    try Ok (read_sk_exn ctx buf) with
    | Invalid_argument msg -> Error msg

  let read_pk_exn ctx buf =
    let buflen = Bigstring.length buf in
    if buflen < compressed_pk_bytes then
      invalid_arg (Printf.sprintf "Key.read_pk: invalid buffer size %d" buflen) ;
    let outbuf = Bigstring.create public_bytes in
    if pk_parse ctx outbuf buf then
      Pk outbuf
    else
      invalid_arg "Key.read_pk_exn: public key is invalid"

  let read_pk ctx buf =
    try Ok (read_pk_exn ctx buf) with
    | Invalid_argument msg -> Error msg

  let write :
    type a. ?compress:bool -> Context.t -> ?pos:int -> Bigstring.t -> a t -> int =
    fun ?(compress=true) ctx ?(pos=0) buf -> function
      | Sk sk ->
          let buflen = Bigstring.length buf in
          if pos < 0 || pos > buflen - secret_bytes then
            invalid_arg "Key.write (secret): pos < 0 or pos + 32 > buflen" ;
          Bigstring.blit sk 0 buf pos secret_bytes ;
          secret_bytes
      | Pk pk ->
          let buflen = Bigstring.length buf in
          if pos < 0
          || (compress && pos > buflen - compressed_pk_bytes)
          || (not compress && pos > buflen - uncompressed_pk_bytes) then
            invalid_arg (Printf.sprintf "Key.write (public): pos=%d, buflen=%d" pos buflen) ;
          let len = if compress then 33 else 65 in
          let buf = Bigstring.sub buf pos len in
          pk_serialize ctx buf pk

  let to_bytes :
    type a. ?compress:bool -> Context.t -> a t -> Bigstring.t =
    fun ?(compress=true) ctx -> function
      | Sk _ as sk ->
          let buf = Bigstring.create secret_bytes in
          let _ = write ~compress ctx buf sk in
          buf
      | Pk _ as pk ->
          let buf =
            Bigstring.create (1 + (if compress then secret_bytes else public_bytes)) in
          let _ = write ~compress ctx buf pk in
          buf
end

module Sign = struct
  type plain
  type recoverable
  type _ t =
    | P : Bigstring.t -> plain t
    | R : Bigstring.t -> recoverable t

  let buffer : type a. a t -> Bigstring.t = function
    | P plain -> plain
    | R recoverable -> recoverable

  let plain_bytes = 64
  let recoverable_bytes = 65
  let msg_bytes = 32

  let equal : type a. a t -> a t -> bool = fun a b ->
    match a, b with
    | P a, P b -> Bigstring.equal a b
    | R a, R b -> Bigstring.equal a b

  external parse_compact : Context.t -> Bigstring.t -> Bigstring.t -> bool =
    "caml_secp256k1_ecdsa_signature_parse_compact" [@@noalloc]
  external parse_der : Context.t -> Bigstring.t -> Bigstring.t -> bool =
    "caml_secp256k1_ecdsa_signature_parse_der" [@@noalloc]
  external serialize_compact : Context.t -> Bigstring.t -> Bigstring.t -> unit =
    "caml_secp256k1_ecdsa_signature_serialize_compact" [@@noalloc]
  external serialize_der : Context.t -> Bigstring.t -> Bigstring.t -> int =
    "caml_secp256k1_ecdsa_signature_serialize_der" [@@noalloc]
  external parse_recoverable : Context.t -> Bigstring.t -> Bigstring.t -> int -> bool =
    "caml_secp256k1_ecdsa_recoverable_signature_parse_compact" [@@noalloc]
  external serialize_recoverable : Context.t -> Bigstring.t -> Bigstring.t -> int =
    "caml_secp256k1_ecdsa_recoverable_signature_serialize_compact" [@@noalloc]

  let read_exn ctx buf =
    let buflen = Bigstring.length buf in
    if buflen < plain_bytes then
      invalid_arg (Printf.sprintf "Sign.read: invalid buffer size %d" buflen) ;
    let signature = Bigstring.create plain_bytes in
    if parse_compact ctx signature buf then
      P signature
    else
      invalid_arg "Sign.read: signature could not be parsed"

  let read ctx buf =
    try Ok (read_exn ctx buf) with
      Invalid_argument msg -> Error msg

  let read_der_exn ctx buf =
    let signature = Bigstring.create plain_bytes in
    if parse_der ctx signature buf then
      P signature
    else
      invalid_arg "Sign.read_der: signature could not be parsed"

  let read_der ctx buf =
    try Ok (read_der_exn ctx buf) with
      Invalid_argument msg -> Error msg

  let read_recoverable_exn ctx buf =
    let buflen = Bigstring.length buf in
    if buflen < recoverable_bytes then
      invalid_arg (Printf.sprintf "Sign.read_recoverable: invalid buffer size %d" buflen) ;
    let signature = Bigstring.create recoverable_bytes in
    let recid = int_of_char (Bigstring.get buf 64) in
    if parse_recoverable ctx signature buf recid then
      R signature
    else
      invalid_arg "Sign.read_recoverable: signature could not be parsed"

  let read_recoverable ctx buf =
    try Ok (read_recoverable_exn ctx buf) with
    | Invalid_argument msg -> Error msg

  let write_exn :
    type a. ?der:bool -> Context.t -> Bigstring.t -> a t -> int =
    fun ?(der=false) ctx buf -> function
      | P signature ->
          let buflen = Bigstring.length buf in
          if not der then begin
            if buflen < plain_bytes then
              invalid_arg (Printf.sprintf "Sign.write: buffer length too small (%d)" buflen) ;
            serialize_compact ctx buf signature ;
            plain_bytes
          end
          else begin
            match serialize_der ctx buf signature with
            | 0 -> invalid_arg "Sign.write_exn: buffer too small to \
                                contain a DER signature"
            | len -> len
          end
      | R signature ->
          let buflen = Bigstring.length buf in
          if buflen < recoverable_bytes then
            invalid_arg (Printf.sprintf "Sign.write: buffer length too small (%d)" buflen) ;
          let recid = serialize_recoverable ctx buf signature in
          Bigstring.set buf 64 (char_of_int recid) ;
          recoverable_bytes

  let write ?der ctx buf signature =
    try Ok (write_exn ?der ctx buf signature) with
      Invalid_argument msg -> Error msg

  let to_bytes :
    type a. ?der:bool -> Context.t -> a t -> Bigstring.t =
    fun ?(der=false) ctx -> function
      | P _ as signature ->
          if der then begin
            let buf = Bigstring.create 72 in
            let nb_written = write_exn ~der ctx buf signature in
            Bigstring.sub buf 0 nb_written
          end
          else
            let buf = Bigstring.create plain_bytes in
            let _nb_written = write_exn ~der ctx buf signature in
            buf
      | R _ as signature ->
          let buf = Bigstring.create recoverable_bytes in
          let _nb_written = write_exn ctx buf signature in
          buf

  external normalize :
    Context.t -> Bigstring.t -> Bigstring.t -> bool =
    "caml_secp256k1_ecdsa_signature_normalize" [@@noalloc]

  let normalize ctx (P signature) =
    let normalized_sig = Bigstring.create plain_bytes in
    if normalize ctx normalized_sig signature then
      Some (P normalized_sig) else None

  (* [sign ctx signature msg sk] *)
  external sign :
    Context.t -> Bigstring.t -> Bigstring.t -> Bigstring.t -> bool =
    "caml_secp256k1_ecdsa_sign" [@@noalloc]

  (* [verify ctx pk msg signature] *)
  external verify :
    Context.t -> Bigstring.t -> Bigstring.t -> Bigstring.t -> bool =
    "caml_secp256k1_ecdsa_verify" [@@noalloc]

  let check_msglen msg =
    let msglen = Bigstring.length msg in
    if msglen < msg_bytes
    then invalid_arg
        (Printf.sprintf "message is too small (%d < %d)" msglen msg_bytes)

  let sign_exn ctx buf ~sk ~msg =
    check_msglen msg ;
    let buflen = Bigstring.length buf in
    if buflen < plain_bytes then
      invalid_arg (Printf.sprintf "Sign.write_sign: buffer length too \
                                   small (%d)" buflen) ;
    match sign ctx buf (Key.buffer sk) msg with
    | true -> ()
    | false -> invalid_arg "Sign.write_sign: the nonce generation \
                            function failed, or the private key was \
                            invalid"

  let write_sign_exn ctx buf ~sk ~msg =
    let signature = Bigstring.create plain_bytes in
    sign_exn ctx signature ~sk ~msg ;
    write_exn ctx buf (P signature)

  let write_sign ctx buf ~sk ~msg =
    try Ok (write_sign_exn ctx ~sk ~msg buf)
    with Invalid_argument msg -> Error msg

  let sign_exn ctx ~sk msg =
    let signature = Bigstring.create plain_bytes in
    sign_exn ctx signature ~sk ~msg ;
    P signature

  let sign ctx ~sk msg =
    try Ok (sign_exn ctx ~sk msg)
    with Invalid_argument msg -> Error msg

  external sign_recoverable :
    Context.t -> Bigstring.t -> Bigstring.t -> Bigstring.t -> bool =
    "caml_secp256k1_ecdsa_sign_recoverable" [@@noalloc]

  let write_sign_recoverable_exn ctx ~sk ~msg buf =
    check_msglen msg ;
    let buflen = Bigstring.length buf in
    if buflen < recoverable_bytes then
      invalid_arg (Printf.sprintf "Sign.write_sign_recoverable: buffer \
                                   length too small (%d)" buflen) ;
    if sign_recoverable ctx buf (Key.buffer sk) msg then
      recoverable_bytes
    else invalid_arg "Sign.write_sign_recoverable_exn: the nonce \
                      generation function failed, or the private key \
                      was invalid"

  let write_sign_recoverable ctx ~sk ~msg buf =
    try Ok (write_sign_recoverable_exn ctx ~sk ~msg buf)
    with Invalid_argument msg -> Error msg

  let sign_recoverable ctx ~sk msg =
    let signature = Bigstring.create recoverable_bytes in
    match write_sign_recoverable ctx ~sk ~msg signature with
    | Error error -> Error error
    | Ok _nb_written -> Ok (R signature)

  let sign_recoverable_exn ctx ~sk msg =
    match sign_recoverable ctx ~sk msg with
    | Error msg -> invalid_arg msg
    | Ok signature -> signature

  external to_plain : Context.t -> Bigstring.t -> Bigstring.t -> unit =
    "caml_secp256k1_ecdsa_recoverable_signature_convert" [@@noalloc]

  let to_plain : type a. Context.t -> a t -> plain t = fun ctx -> function
    | P _ as signature -> signature
    | R recoverable ->
        let plain = Bigstring.create plain_bytes in
        to_plain ctx plain recoverable ;
        P plain

  let verify_plain_exn ctx ~pk msg signature =
    check_msglen msg ;
    let siglen = Bigstring.length signature in
    if siglen < plain_bytes then
      invalid_arg (Printf.sprintf "verify: signature too short (%d < %d)"
                     siglen plain_bytes) ;
    verify ctx (Key.buffer pk) msg signature

  let verify_exn ctx ~pk ~msg ~signature =
    let P signature = to_plain ctx signature in
    verify_plain_exn ctx ~pk msg signature

  let verify ctx ~pk ~msg ~signature =
    try Ok (verify_exn ctx ~pk ~msg ~signature) with
    | Invalid_argument msg -> Error msg

  external recover :
    Context.t -> Bigstring.t -> Bigstring.t -> Bigstring.t -> bool =
    "caml_secp256k1_ecdsa_recover" [@@noalloc]

  let recover_exn ctx ~signature:(R signature) msg =
    check_msglen msg ;
    let pk = Bigstring.create Key.public_bytes in
    if recover ctx pk signature msg then Key.Pk pk
    else
      invalid_arg "Sign.recover: pk could not be recovered"

  let recover ctx ~signature msg =
    try Ok (recover_exn ctx ~signature msg) with
      Invalid_argument msg -> Error msg
end
OCaml

Innovation. Community. Security.