zuse: add refactored secp core (unjetted)

The secp core had some flaws: in particular, the logic for signing/recovery
did not match libsecbp256k1 w.r.t. the enigmatic "recid" (v) value. The jet
hints were also subtly wrong, in that the curve parameters were in a sample
(not an arm) and thus not matched by the jet matching scheme. Consequently,
the jets would be used (but incorrect) for other curve parameters.

Tests were also added to exercise the recovery id cases thoroughly.
This commit is contained in:
Paul Driver 2020-09-18 14:47:22 -07:00
parent 0917a89d1e
commit 9be3318ae9
2 changed files with 393 additions and 0 deletions

View File

@ -4180,6 +4180,280 @@
:: ::
:::: ++secp:crypto :: (2b9) secp family
:: ::::
++ new-secp !.
:: TODO: as-octs and hmc are outside of jet parent
=> :+ hmc=hmac-sha256l:hmac:crypto
as-octs=as-octs:mimes:html
..is
~% %secp ..is ~
|%
+= jacobian [x=@ y=@ z=@] :: jacobian point
+= point [x=@ y=@] :: curve point
+= domain
$: p=@ :: prime modulo
a=@ :: y^2=x^3+ax+b
b=@ ::
g=point :: base point
n=@ :: prime order of g
==
++ secp
|_ [bytes=@ =domain]
++ field-p ~(. fo p.domain)
++ field-n ~(. fo n.domain)
++ compress-point
|= =point
^- @
%+ can 3
:~ [bytes x.point]
[1 (add 2 (cut 0 [0 1] y.point))]
==
::
++ serialize-point
|= =point
^- @
%+ can 3
:~ [bytes y.point]
[bytes x.point]
[1 4]
==
::
++ decompress-point
|= compressed=@
^- point
=/ x=@ (end 3 bytes compressed)
?> =(3 (mod p.domain 4))
=/ fop field-p
=+ [fadd fmul fpow]=[sum.fop pro.fop exp.fop]
=/ y=@ %+ fpow (rsh 0 2 +(p.domain))
%+ fadd b.domain
%+ fadd (fpow 3 x)
(fmul a.domain x)
=/ s=@ (rsh 3 bytes compressed)
~| [`@ux`s `@ux`compressed]
?> |(=(2 s) =(3 s))
:: check parity
::
=? y !=((sub s 2) (mod y 2))
(sub p.domain y)
[x y]
::
++ jc :: jacobian math
|%
++ from
|= a=jacobian
^- point
=/ fop field-p
=+ [fmul fpow finv]=[pro.fop exp.fop inv.fop]
=/ z (finv z.a)
:- (fmul x.a (fpow 2 z))
(fmul y.a (fpow 3 z))
::
++ into
|= point
^- jacobian
[x y 1]
::
++ double
|= jacobian
^- jacobian
?: =(0 y) [0 0 0]
=/ fop field-p
=+ [fadd fsub fmul fpow]=[sum.fop dif.fop pro.fop exp.fop]
=/ s :(fmul 4 x (fpow 2 y))
=/ m %+ fadd
(fmul 3 (fpow 2 x))
(fmul a.domain (fpow 4 z))
=/ nx %+ fsub
(fpow 2 m)
(fmul 2 s)
=/ ny %+ fsub
(fmul m (fsub s nx))
(fmul 8 (fpow 4 y))
=/ nz :(fmul 2 y z)
[nx ny nz]
::
++ add
|= [a=jacobian b=jacobian]
^- jacobian
?: =(0 y.a) b
?: =(0 y.b) a
=/ fop field-p
=+ [fadd fsub fmul fpow]=[sum.fop dif.fop pro.fop exp.fop]
=/ u1 :(fmul x.a z.b z.b)
=/ u2 :(fmul x.b z.a z.a)
=/ s1 :(fmul y.a z.b z.b z.b)
=/ s2 :(fmul y.b z.a z.a z.a)
?: =(u1 u2)
?. =(s1 s2)
[0 0 1]
(double a)
=/ h (fsub u2 u1)
=/ r (fsub s2 s1)
=/ h2 (fmul h h)
=/ h3 (fmul h2 h)
=/ u1h2 (fmul u1 h2)
=/ nx %+ fsub
(fmul r r)
:(fadd h3 u1h2 u1h2)
=/ ny %+ fsub
(fmul r (fsub u1h2 nx))
(fmul s1 h3)
=/ nz :(fmul h z.a z.b)
[nx ny nz]
::
++ mul
|= [a=jacobian scalar=@]
^- jacobian
?: =(0 y.a)
[0 0 1]
?: =(0 scalar)
[0 0 1]
?: =(1 scalar)
a
?: (gte scalar n.domain)
$(scalar (mod scalar n.domain))
?: =(0 (mod scalar 2))
(double $(scalar (rsh 0 1 scalar)))
(add a (double $(scalar (rsh 0 1 scalar))))
--
++ mul-point-scalar
|= [p=point scalar=@]
^- point
=/ j jc
%- from.j
%+ mul.j
(into.j p)
scalar
::
++ in-order
|= i=@
?& (gth i 0)
(lth i n.domain)
==
++ priv-to-pub
|= private-key=@
^- point
?> (in-order private-key)
(mul-point-scalar g.domain private-key)
::
++ make-k
|= [hash=@ private-key=@]
^- @
?> (in-order private-key)
:: hash is truncated to bytes
=/ v (fil 3 bytes 1)
=/ k 0
=. k %+ hmc [bytes k]
%- as-octs
%+ can 3
:~ [bytes hash]
[bytes private-key]
[1 0]
[bytes v]
==
=. v (hmc bytes^k bytes^v)
=. k %+ hmc [bytes k]
%- as-octs
%+ can 3
:~ [bytes hash]
[bytes private-key]
[1 1]
[bytes v]
==
=. v (hmc bytes^k bytes^v)
(hmc bytes^k bytes^v)
::
++ ecdsa-raw-sign
|= [hash=@ private-key=@]
^- [r=@ s=@ y=@]
=/ k (make-k hash private-key)
=/ rp (priv-to-pub k)
=* r x.rp
?< =(0 r)
=/ fon field-n
=+ [fadd fmul finv]=[sum.fon pro.fon inv.fon]
=/ s %+ fmul (finv k)
%+ fadd hash
%+ fmul r
private-key
?< =(0 s)
[r s y.rp]
:: general recovery omitted, but possible
--
++ secp256k1
~% %secp256k1 + ~
|%
++ t :: in the battery for jet matching
^- domain
:* 0xffff.ffff.ffff.ffff.ffff.ffff.ffff.ffff.
ffff.ffff.ffff.ffff.ffff.fffe.ffff.fc2f
0
7
:- 0x79be.667e.f9dc.bbac.55a0.6295.ce87.0b07.
029b.fcdb.2dce.28d9.59f2.815b.16f8.1798
0x483a.da77.26a3.c465.5da4.fbfc.0e11.08a8.
fd17.b448.a685.5419.9c47.d08f.fb10.d4b8
0xffff.ffff.ffff.ffff.ffff.ffff.ffff.fffe.
baae.dce6.af48.a03b.bfd2.5e8c.d036.4141
==
::
++ curve ~(. secp 32 t)
++ make-k
~/ %make
|= [hash=@uvI private-key=@]
(make-k:curve hash private-key)
++ priv-to-pub
|= private-key=@
(priv-to-pub:curve private-key)
::
++ ecdsa-raw-sign
~/ %sign
|= [hash=@uvI private-key=@]
^- [v=@ r=@ s=@]
=/ c curve
=+ (ecdsa-raw-sign.c hash private-key)
=/ rp=point [r y]
=/ s-high (gte (mul 2 s) n.domain.c)
=? s s-high
(sub n.domain.c s)
=? rp s-high
[x.rp (sub p.domain.c y.rp)]
=/ v (end 0 1 y.rp)
=? v (gte x.rp n.domain.c)
(add v 2)
[v x.rp s]
::
++ ecdsa-raw-recover
~/ %reco
|= [hash=@ sig=[v=@ r=@ s=@]]
^- point
?> (lte v.sig 3)
=/ c curve
?> (in-order.c hash)
?> (in-order.c r.sig)
?> (in-order.c s.sig)
=/ x ?: (gte v.sig 2)
(add r.sig n.domain.c)
r.sig
=/ fop field-p.c
=+ [fadd fmul fpow]=[sum.fop pro.fop exp.fop]
=/ ysq (fadd (fpow 3 x) b.domain.c)
=/ beta (fpow (rsh 0 2 +(p.domain.c)) ysq)
=/ y ?: =((end 0 1 v.sig) (end 0 1 beta))
beta
(sub p.domain.c beta)
?> =(0 (dif.fop ysq (fmul y y)))
=/ nz (sub n.domain.c hash)
=/ j jc.c
=/ gz (mul.j (into.j g.domain.c) nz)
=/ xy (mul.j (into.j x y) s.sig)
=/ qr (add.j gz xy)
=/ qj (mul.j qr (inv:field-n.c x))
=/ pub (from.j qj)
?< =([0 0] pub)
pub
--
--
++ secp
~% %secp ..is ~
|%

View File

@ -0,0 +1,119 @@
:: tests for secp256k1 elliptic curve cryptography
::
/+ *test
=/ ecc secp256k1:new-secp:crypto
|%
:: from libsecp256k1 src/modules/recovery/tests_impl.h
:: there are more tests there, ports would be welcome
++ test-ecdsa-recovery-end-to-end
=/ util
=/ eny=@ 'ecdsa recovery test "entropy"'
=/ rnd ~(. og eny)
=/ dom t.ecc
|%
++ random-scalar-order
=* core .
=^ z rnd (rads:rnd (dec n.dom))
[`@`.+(z) core]
--
:: generate a random key and message
%+ category "random"
%- zing
=| [i=@ out=(list tang)]
|- ^+ out
?: =(i 64) out
=^ message util random-scalar-order:util
=^ privkey util random-scalar-order:util
=/ pubkey (priv-to-pub.ecc privkey)
=/ msghash (shax (shax message))
=/ sig (ecdsa-raw-sign.ecc msghash privkey)
=/ reckey (ecdsa-raw-recover.ecc msghash sig)
%= $
i .+(i)
out :_ out
%+ expect-eq
!> pubkey
!> reckey
==
::
++ test-ecdsa-recovery-edge-cases
=< %+ category "edge cases"
(zing ~[t1 t2 t3 t4 t5])
=/ msg32=@ '...egassem terces yrev a si sihT'
=/ r=@ux 0x67cb.285f.9cd1.94e8.
40d6.2939.7af5.5696.
62fd.e446.4999.5963.
179a.7dd1.7bd2.3532
=/ s=@ux 0x4b1b.7df3.4ce1.f68e.
694f.f6f1.1ac7.51dd.
7dd7.3e38.7ee4.fc86.
6e1b.e8ec.c7dd.9557
=/ r %+ turn (gulf 0 3)
|= v=@
(mule |.((ecdsa-raw-recover.ecc msg32 v r s)))
=/ t1 %+ expect-eq
!> %.n
!> -.&1.r
=/ t3 %+ expect-eq
!> %.n
!> -.&3.r
=/ t4 %+ expect-eq
!> %.n
!> -.&4.r
=/ t2 %+ expect-eq
!> :+ %.y
0x8687.4a6b.24a7.5462.
7116.560e.7ae1.5cd6.
9eb3.3e73.b4d8.c810.
33b2.7c2f.a9cf.5d1c
0xe13f.19fa.8dea.0d1a.
e3e8.4c91.146c.3386.
8f87.730e.31bb.486e.
b370.05d1.40cc.7a55
!> &2.r
:: (4,4) should recover with all 4 recids
:_ .
^= t5
%- expect-eq :_
!> %+ turn (gulf 0 3)
|= v=@
(mule |.((ecdsa-raw-recover.ecc msg32 v 4 4)))
!>
:~ :+ %.y
0x8a3d.70c0.4104.68e4.
5739.39af.01b9.9ea7.
b206.4910.6d55.acf9.
f558.eba2.8ed5.9a2e
0x77eb.58dd.36ed.385b.
3dcf.e7d3.62c8.16f3.
7d3b.ef3e.4a34.94b8.
6fcc.8357.5184.9329
:+ %.y
0x3e99.0254.a50d.6599.
26c9.28ef.8b54.181e.
e67e.27ff.bf63.eb69.
294b.9ab6.d27b.a225
0xa898.847e.931e.9b10.
2c0f.9b0f.9597.07ba.
f9b8.5e93.6425.fc72.
e80c.a868.e535.dfb4
:+ %.y
0x7e15.24fa.06ba.fd6e.
b9c0.2f27.9e13.1314.
be93.0570.0fc6.9e80.
d54d.29ab.3606.3f23
0x3f86.a967.33e7.723d.
fdde.4e03.382d.8c45.
3493.fa88.9050.5ba5.
cfc4.0a8b.226b.1b00
:+ %.y
0xb337.c9b7.4ca9.9ea9.
63c6.560d.2558.cdf0.
9c73.0120.8409.649a.
8a6d.1fb1.0e1c.b946
0x11df.5391.ee11.6de0.
a722.bc0f.be5f.6575.
3d07.03a9.9925.0581.
f7de.cd5e.f0f4.f809
==
--