secp256k1

commit c44988dbfc3acec2b3fa950b9b0760507992e8c1
parent c539e6187bbd1ab0079b3e5a74ead4143a54ebe1
Author: Jared Tobin <jared@jtobin.io>
Date:   Tue, 15 Oct 2024 11:21:33 +0400

lib: bip0340 vectors passing

Diffstat:
M
lib/Crypto/Curve/Secp256k1.hs
 | 
76
++++++++++++++++++++++++++++++++++++++++++++++++++--------------------------
M
test/Main.hs
 | 
13
+++++++++----

2 files changed, 59 insertions(+), 30 deletions(-)
diff --git a/lib/Crypto/Curve/Secp256k1.hs b/lib/Crypto/Curve/Secp256k1.hs
@@ -6,9 +6,21 @@
 {-# LANGUAGE UnboxedSums #-}
 {-# LANGUAGE ViewPatterns #-}
 
+-- XX clean up export list
 module Crypto.Curve.Secp256k1 (
+  -- * Curve parameters and modular arithmetic utilities
+    _CURVE_P
+  , _CURVE_Q
+  , _CURVE_G
+  , modexp
+  , modinv
+  , modP
+  , modQ
+  , fe
+  , ge
+
   -- * Coordinate systems and transformations
-    Affine(..)
+  , Affine(..)
   , Projective(..)
   , affine
   , projective
@@ -482,6 +494,15 @@ roll :: BS.ByteString -> Integer
 roll = BS.foldl' alg 0 where
   alg a (fi -> b) = (a `I.integerShiftL` 8) `I.integerOr` b
 
+-- unroll a 256-bit integer, left-padding with zeros if necessary
+-- the size of the integer is not checked
+unroll32 :: Integer -> BS.ByteString
+unroll32 (unroll -> u)
+    | l < 32 = BS.replicate (32 - l) 0 <> u
+    | otherwise = u
+  where
+    l = BS.length u
+
 -- big-endian bytestring encoding
 unroll :: Integer -> BS.ByteString
 unroll i = case i of
@@ -664,7 +685,23 @@ verify_ecdsa_unrestricted (SHA256.hash -> h) p (ECDSA r s)
 -- see https://github.com/bitcoin/bips/blob/master/bip-0340.mediawiki
 
 hash_tagged :: BS.ByteString -> BS.ByteString -> BS.ByteString
-hash_tagged tag x = SHA256.hash (SHA256.hash tag <> SHA256.hash tag <> x)
+hash_tagged tag x =
+  let !h = SHA256.hash tag
+  in  SHA256.hash (h <> h <> x)
+
+-- return point with x coordinate == x and with even y coordinate
+lift :: Integer -> Maybe Affine
+lift x
+  | not (fe x) = Nothing
+  | otherwise =
+      let c = modP (modexp x 3 _CURVE_P + 7)
+          y = modexp c ((_CURVE_P + 1) `div` 4) _CURVE_P
+          y_p
+            | y `rem` 2 == 0 = y
+            | otherwise      = _CURVE_P - y
+      in  if   c /= modexp y 2 _CURVE_P
+          then Nothing
+          else Just $! (Affine x y_p)
 
 sign_schnorr
   :: Integer        -- ^ secret key
@@ -678,11 +715,11 @@ sign_schnorr d' m a
           d | y_p `rem` 2 == 0 = d'
             | otherwise = _CURVE_Q - d'
 
-          bytes_d = unroll d
+          bytes_d = unroll32 d
           h_a = hash_tagged "BIP0340/aux" a
           t = xor bytes_d h_a
 
-          bytes_p = unroll x_p
+          bytes_p = unroll32 x_p
           rand = hash_tagged "BIP0340/nonce" (t <> bytes_p <> m)
 
           k' = modQ (roll rand)
@@ -694,13 +731,11 @@ sign_schnorr d' m a
                 k | y_r `rem` 2 == 0 = k'
                   | otherwise = _CURVE_Q - k'
 
-                bytes_r = unroll x_r
-                e = modQ
-                  . roll
-                  . hash_tagged "BIP0340/challenge"
+                bytes_r = unroll32 x_r
+                e = modQ . roll . hash_tagged "BIP0340/challenge"
                   $ bytes_r <> bytes_p <> m
 
-                bytes_ked = unroll (modQ (k + e * d))
+                bytes_ked = unroll32 (modQ (k + e * d))
 
                 sig = bytes_r <> bytes_ked
 
@@ -708,19 +743,6 @@ sign_schnorr d' m a
                 then sig
                 else error "ppad-secp256k1 (sign_schnorr): invalid signature"
 
-lift :: Integer -> Maybe Affine
-lift x
-  | not (fe x) = Nothing
-  | otherwise =
-      let c = modP (modexp x 3 _CURVE_P + 7)
-          y = modexp c ((_CURVE_P + 1) `div` 4) _CURVE_P
-          y_p
-            | y `rem` 2 == 0 = y
-            | otherwise      = _CURVE_P - y
-      in  if   c /= modexp y 2 _CURVE_P
-          then Nothing
-          else Just $! (Affine x y_p)
-
 verify_schnorr
   :: BS.ByteString  -- ^ message
   -> Affine         -- ^ public key
@@ -733,8 +755,10 @@ verify_schnorr m (Affine x_p _) sig = case lift x_p of
     in  if   r >= _CURVE_P || s >= _CURVE_Q
         then False
         else let e = modQ . roll $ hash_tagged "BIP0340/challenge"
-                       (unroll r <> unroll x_P <> m)
-                 Affine x_R y_R = affine $
-                   add (mul _CURVE_G s) (neg (mul (projective capP) e))
-             in  not (y_R `rem` 2 /= 0 || x_R /= r)
+                       (unroll32 r <> unroll32 x_P <> m)
+                 dif = add (mul _CURVE_G s) (neg (mul (projective capP) e))
+             in  if   dif == _ZERO
+                 then False
+                 else let Affine x_R y_R = affine dif
+                      in  not (y_R `rem` 2 /= 0 || x_R /= r)
 
diff --git a/test/Main.hs b/test/Main.hs
@@ -30,18 +30,23 @@ main = do
   wp_ecdsa_sha256_bitcoin <- TIO.readFile
     "etc/ecdsa_secp256k1_sha256_bitcoin_test.json"
   noble_ecdsa <- TIO.readFile "etc/noble_ecdsa.json"
-  let trip = do
+  bip340 <- BS.readFile "etc/bip-0340-test-vectors.csv"
+  let quar = do
         wp0 <- A.decodeStrictText wp_ecdsa_sha256 :: Maybe W.Wycheproof
         wp1 <- A.decodeStrictText wp_ecdsa_sha256_bitcoin :: Maybe W.Wycheproof
         nob <- A.decodeStrictText noble_ecdsa :: Maybe N.Ecdsa
-        pure (wp0, wp1, nob)
-  case trip of
+        bip <- case AT.parseOnly BIP340.cases bip340 of
+                 Left _ -> Nothing
+                 Right b -> pure b
+        pure (wp0, wp1, nob, bip)
+  case quar of
     Nothing -> error "couldn't parse wycheproof vectors"
-    Just (w0, w1, no) -> defaultMain $ testGroup "ppad-secp256k1" [
+    Just (w0, w1, no, ip) -> defaultMain $ testGroup "ppad-secp256k1" [
         units
       , wycheproof_ecdsa_verify_tests "(ecdsa, sha256)" Unrestricted w0
       , wycheproof_ecdsa_verify_tests "(ecdsa, sha256, low-s)" LowS w1
       , N.execute_ecdsa no
+      , testGroup "bip0340 vectors (schnorr)" (fmap BIP340.execute ip)
       ]
 
 wycheproof_ecdsa_verify_tests :: String -> SigType -> W.Wycheproof -> TestTree