commit 287a4e9e649a2fb5215ab10575239c563afc08b5
parent fc2c1fcf42bb4bc5e91213f2d035ae09e5386d25
Author: Jared Tobin <jared@jtobin.io>
Date: Sun, 24 Mar 2024 15:22:26 +0400
lib: prune unused addition algorithms
Diffstat:
3 files changed, 8 insertions(+), 237 deletions(-)
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -12,8 +12,13 @@ instance NFData S.Projective
instance NFData S.Affine
instance NFData S.Curve
-add :: Benchmark
-add = bgroup "secp256k1" [
+main :: IO ()
+main = defaultMain [
+ secp256k1
+ ]
+
+secp256k1 :: Benchmark
+secp256k1 = bgroup "secp256k1" [
bgroup "parse" [
bench "foo" $ nf bparse p
, bench "bar" $ nf bparse q
@@ -28,30 +33,6 @@ add = bgroup "secp256k1" [
, bench "bar qux" $ nf (S.add bar) qux
, bench "baz qux" $ nf (S.add baz) qux
]
- , bgroup "add'" [
- bench "foo bar" $ nf (S.add' foo) bar
- , bench "foo baz" $ nf (S.add' foo) baz
- , bench "foo qux" $ nf (S.add' foo) qux
- , bench "bar baz" $ nf (S.add' bar) baz
- , bench "bar qux" $ nf (S.add' bar) qux
- , bench "baz qux" $ nf (S.add' baz) qux
- ]
- , bgroup "add_pure" [
- bench "foo bar" $ nf (S.add_pure foo) bar
- , bench "foo baz" $ nf (S.add_pure foo) baz
- , bench "foo qux" $ nf (S.add_pure foo) qux
- , bench "bar baz" $ nf (S.add_pure bar) baz
- , bench "bar qux" $ nf (S.add_pure bar) qux
- , bench "baz qux" $ nf (S.add_pure baz) qux
- ]
- , bgroup "add_affine" [
- bench "foo bar" $ nf (S.add_affine afoo) abar
- , bench "foo baz" $ nf (S.add_affine afoo) abaz
- , bench "foo qux" $ nf (S.add_affine afoo) aqux
- , bench "bar baz" $ nf (S.add_affine abar) abaz
- , bench "bar qux" $ nf (S.add_affine abar) aqux
- , bench "baz qux" $ nf (S.add_affine abaz) aqux
- ]
]
where
p = "0279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798"
@@ -84,15 +65,3 @@ add = bgroup "secp256k1" [
Nothing -> error "bang"
Just !pa -> pa
- afoo = S.affine' foo
-
- abar = S.affine' bar
-
- abaz = S.affine' baz
-
- aqux = S.affine' qux
-
-main :: IO ()
-main = defaultMain [
- add
- ]
diff --git a/lib/Crypto/Secp256k1.hs b/lib/Crypto/Secp256k1.hs
@@ -119,168 +119,10 @@ _BASE = Projective (curve_gx secp256k1) (curve_gy secp256k1) 1
neg :: Projective -> Projective
neg (Projective x y z) = Projective x (mods (negate y)) z
--- -- XX correct?
-add_affine :: Affine -> Affine -> Maybe Affine
-add_affine p@(Affine x1 y1) q@(Affine x2 y2)
- | p == q && (p == azero || q == azero) = pure azero
- | p == q = do
- i <- fmap fromIntegral (modinv (mods (2 * y1)) (curve_p secp256k1))
- let s = mods (mods (3 * mods (x1 * x1)) * i)
- x = mods (mods (s * s) - mods (2 * x1))
- y = mods (mods (s * mods (x1 - x)) - y1)
- pure (Affine x y)
- | x1 == 0 && y1 == 0 = pure q
- | x2 == 0 && y2 == 0 = pure p
- | x1 == x2 = pure azero
- | otherwise = do
- i <- fmap fromIntegral (modinv (mods (x1 - x2)) (curve_p secp256k1))
- let s = mods (mods (y1 - y2) * i)
- x3 = mods (mods (s * s) - x1 - x2)
- y3 = mods (mods (s * mods (x1 - x3)) - y1)
- pure (Affine x3 y3)
- where
- azero = Affine 0 0
-
-
--- algo 1, "complete addition formulas for prime order elliptic curves,"
+-- algo 7, "complete addition formulas for prime order elliptic curves,"
-- renes et al, 2015
add :: Projective -> Projective -> Projective
add (Projective x1 y1 z1) (Projective x2 y2 z2) = runST $ do
- let a = curve_a secp256k1
- b = curve_b secp256k1
- x3 <- newSTRef 0
- y3 <- newSTRef 0
- z3 <- newSTRef 0
- let b3 = mods (b * 3)
- t0 <- newSTRef (mods (x1 * x2))
- t1 <- newSTRef (mods (y1 * y2))
- t2 <- newSTRef (mods (z1 * z2))
- t3 <- newSTRef (mods (x1 + y1))
- t4 <- newSTRef (mods (x2 + y2))
- readSTRef t4 >>= \r4 ->
- modifySTRef' t3 (\r3 -> mods (r3 * r4))
- readSTRef t0 >>= \r0 ->
- readSTRef t1 >>= \r1 ->
- writeSTRef t4 (mods (r0 + r1))
- readSTRef t4 >>= \r4 ->
- modifySTRef' t3 (\r3 -> mods (r3 - r4))
- writeSTRef t4 (mods (x1 + z1))
- t5 <- newSTRef (mods (x2 + z2))
- readSTRef t5 >>= \r5 ->
- modifySTRef' t4 (\r4 -> mods (r4 * r5))
- readSTRef t0 >>= \r0 ->
- readSTRef t2 >>= \r2 ->
- writeSTRef t5 (mods (r0 + r2))
- readSTRef t5 >>= \r5 ->
- modifySTRef' t4 (\r4 -> mods (r4 - r5))
- writeSTRef t5 (mods (y1 + z1))
- writeSTRef x3 (mods (y2 + z2))
- readSTRef x3 >>= \rx3 ->
- modifySTRef' t5 (\r5 -> mods (r5 * rx3))
- readSTRef t1 >>= \r1 ->
- readSTRef t2 >>= \r2 ->
- writeSTRef x3 (mods (r1 + r2))
- readSTRef x3 >>= \rx3 ->
- modifySTRef' t5 (\r5 -> mods (r5 - rx3))
- readSTRef t4 >>= \r4 ->
- writeSTRef z3 (mods (a * r4))
- readSTRef t2 >>= \r2 ->
- writeSTRef x3 (mods (b3 * r2))
- readSTRef x3 >>= \rx3 ->
- modifySTRef' z3 (\rz3 -> mods (rx3 + rz3))
- readSTRef t1 >>= \r1 ->
- readSTRef z3 >>= \rz3 ->
- writeSTRef x3 (mods (r1 - rz3))
- readSTRef t1 >>= \r1 ->
- modifySTRef' z3 (\rz3 -> mods (r1 + rz3))
- readSTRef x3 >>= \rx3 ->
- readSTRef z3 >>= \rz3 ->
- writeSTRef y3 (mods (rx3 * rz3))
- readSTRef t0 >>= \r0 ->
- writeSTRef t1 (mods (r0 + r0))
- readSTRef t0 >>= \r0 ->
- modifySTRef' t1 (\r1 -> mods (r1 + r0))
- modifySTRef' t2 (\r2 -> mods (a * r2))
- modifySTRef' t4 (\r4 -> mods (b3 * r4))
- readSTRef t2 >>= \r2 ->
- modifySTRef' t1 (\r1 -> mods (r1 + r2))
- readSTRef t0 >>= \r0 ->
- modifySTRef' t2 (\r2 -> mods (r0 - r2))
- modifySTRef' t2 (\r2 -> mods (a * r2))
- readSTRef t2 >>= \r2 ->
- modifySTRef' t4 (\r4 -> mods (r4 + r2))
- readSTRef t1 >>= \r1 ->
- readSTRef t4 >>= \r4 ->
- writeSTRef t0 (mods (r1 * r4))
- readSTRef t0 >>= \r0 ->
- modifySTRef' y3 (\ry3 -> mods (ry3 + r0))
- readSTRef t5 >>= \r5 ->
- readSTRef t4 >>= \r4 ->
- writeSTRef t0 (mods (r5 * r4))
- readSTRef t3 >>= \r3 ->
- modifySTRef' x3 (\rx3 -> mods (r3 * rx3))
- readSTRef t0 >>= \r0 ->
- modifySTRef' x3 (\rx3 -> mods (rx3 - r0))
- readSTRef t1 >>= \r1 ->
- readSTRef t3 >>= \r3 ->
- writeSTRef t0 (mods (r3 * r1))
- readSTRef t5 >>= \r5 ->
- modifySTRef' z3 (\rz3 -> mods (r5 * rz3))
- readSTRef t0 >>= \r0 ->
- modifySTRef' z3 (\rz3 -> mods (rz3 + r0))
- Projective <$> readSTRef x3 <*> readSTRef y3 <*> readSTRef z3
-
-add_pure :: Projective -> Projective -> Projective
-add_pure (Projective x1 y1 z1) (Projective x2 y2 z2) =
- let a = curve_a secp256k1
- b = curve_b secp256k1
- b3 = mods (b * 3)
- t0 = mods (x1 * x2)
- t1 = mods (y1 * y2)
- t2 = mods (z1 * z2)
- t3 = mods (x1 + y1)
- t4 = mods (x2 + y2)
- t30 = mods (t3 * t4)
- t40 = mods (t0 + t1)
- t300 = mods (t30 - t40)
- t400 = mods (x1 + z1)
- t5 = mods (x2 + z2)
- t4000 = mods (t400 * t5)
- t50 = mods (t0 + t2)
- t40000 = mods (t4000 - t50)
- t500 = mods (y1 + z1)
- x3 = mods (y2 + z2)
- t5000 = mods (t500 * x3)
- x30 = mods (t1 + t2)
- t50000 = mods (t5000 - x30)
- z3 = mods (a * t40000)
- x300 = mods (b3 * t2)
- z30 = mods (x300 + z3)
- x3000 = mods (t1 - z30)
- z300 = mods (t1 + z30)
- y3 = mods (x3000 * z300)
- t10 = mods (t0 + t0)
- t100 = mods (t10 + t0)
- t20 = mods (a * t2)
- t400000 = mods (b3 * t40000)
- t1000 = mods (t100 + t20)
- t200 = mods (t0 - t20)
- t2000 = mods (a * t200)
- t4000000 = mods (t400000 + t2000)
- t00 = mods (t1000 * t4000000)
- y30 = mods (y3 + t00)
- t000 = mods (t50000 * t4000000)
- x30000 = mods (t300 * x3000)
- x300000 = mods (x30000 - t000)
- t0000 = mods (t300 * t1000)
- z3000 = mods (t50000 * z300)
- z30000 = mods (z3000 + t0000)
- in Projective x300000 y30 z30000
-
--- algo 7, "complete addition formulas for prime order elliptic curves,"
--- renes et al, 2015
-add' :: Projective -> Projective -> Projective
-add' (Projective x1 y1 z1) (Projective x2 y2 z2) = runST $ do
let b = curve_b secp256k1
x3 <- newSTRef 0
y3 <- newSTRef 0
diff --git a/test/Main.hs b/test/Main.hs
@@ -14,8 +14,6 @@ units :: TestTree
units = testGroup "unit tests" [
parse_tests
, add_tests
- , add_pure_tests
- , add'_tests
]
parse_tests :: TestTree
@@ -52,20 +50,6 @@ add_tests = testGroup "ec addition, algo 1" [
, add_test_qr
]
-add'_tests :: TestTree
-add'_tests = testGroup "ec addition, algo 7" [
- add'_test_pq
- , add'_test_pr
- , add'_test_qr
- ]
-
-add_pure_tests :: TestTree
-add_pure_tests = testGroup "ec addition, algo 1, pure" [
- add_pure_test_pq
- , add_pure_test_pr
- , add_pure_test_qr
- ]
-
add_test_pq :: TestTree
add_test_pq = testCase "p + q" $
assertEqual mempty pq_pro (p_pro `add` q_pro)
@@ -78,30 +62,6 @@ add_test_qr :: TestTree
add_test_qr = testCase "q + r" $
assertEqual mempty qr_pro (q_pro `add` r_pro)
-add'_test_pq :: TestTree
-add'_test_pq = testCase "p + q" $
- assertEqual mempty pq_pro (p_pro `add'` q_pro)
-
-add'_test_pr :: TestTree
-add'_test_pr = testCase "p + r" $
- assertEqual mempty pr_pro (p_pro `add'` r_pro)
-
-add'_test_qr :: TestTree
-add'_test_qr = testCase "q + r" $
- assertEqual mempty qr_pro (q_pro `add'` r_pro)
-
-add_pure_test_pq :: TestTree
-add_pure_test_pq = testCase "p + q" $
- assertEqual mempty pq_pro (p_pro `add_pure` q_pro)
-
-add_pure_test_pr :: TestTree
-add_pure_test_pr = testCase "p + r" $
- assertEqual mempty pr_pro (p_pro `add_pure` r_pro)
-
-add_pure_test_qr :: TestTree
-add_pure_test_qr = testCase "q + r" $
- assertEqual mempty qr_pro (q_pro `add_pure` r_pro)
-
p_hex :: BS.ByteString
p_hex = "0279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798"
