diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,23 @@ # Changelog +- 0.2.0 (2024-11-08) + * Adds wNAF ("w-ary non-adjacent form") scalar multiplication, as + well as fast 'sign' and 'verify' variants for Schnorr and ECDSA + (disambiguated by a trailing apostrophe) that make use of it. + + Each wNAF-powered function requires a 'Context' consisting of + precomputed secp256k1 generator multiples; one can be gotten via + 'precompute'. + + Note that the non-wNAF-powered sign and verify functions have + incurred a slight performance decrease (on the order of tens to + hundreds of microseconds) as a result. + + * Adds 'parse_sig' for parsing compact signatures. + + * Adds a dependency on the 'primitive' library (already transitively required + via 'ppad-hmac-drbg'). + - 0.1.0 (2024-10-19) * Initial release, supporting public key derivation and Schnorr & ECDSA signatures on secp256k1. diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -13,6 +13,7 @@ instance NFData S.Projective instance NFData S.Affine instance NFData S.ECDSA +instance NFData S.Context instance NFData S.Word256 main :: IO () @@ -20,6 +21,8 @@ parse_point , add , mul + , precompute + , mul_wnaf , derive_pub , schnorr , ecdsa @@ -73,6 +76,22 @@ setup = pure . S.parse_int256 $ B16.decodeLenient "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed" +precompute :: Benchmark +precompute = bench "precompute" $ nfIO (pure S.precompute) + +mul_wnaf :: Benchmark +mul_wnaf = env setup $ \ ~(tex, x) -> + bgroup "mul_wnaf" [ + bench "2 G" $ nf (S.mul_wnaf tex) 2 + , bench "(2 ^ 255 - 19) G" $ nf (S.mul_wnaf tex) x + ] + where + setup = do + let !tex = S.precompute + !int = S.parse_int256 $ B16.decodeLenient + "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed" + pure (tex, int) + derive_pub :: Benchmark derive_pub = env setup $ \x -> bgroup "derive_pub" [ @@ -84,31 +103,41 @@ "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed" schnorr :: Benchmark -schnorr = env setup $ \big -> +schnorr = env setup $ \ ~(tex, big) -> bgroup "schnorr" [ - bench "sign_schnorr (small secret)" $ nf (S.sign_schnorr 2 s_msg) s_aux - , bench "sign_schnorr (large secret)" $ nf (S.sign_schnorr big s_msg) s_aux + bench "sign_schnorr (small)" $ nf (S.sign_schnorr 2 s_msg) s_aux + , bench "sign_schnorr (large)" $ nf (S.sign_schnorr big s_msg) s_aux + , bench "sign_schnorr' (small)" $ nf (S.sign_schnorr' tex 2 s_msg) s_aux + , bench "sign_schnorr' (large)" $ nf (S.sign_schnorr' tex big s_msg) s_aux , bench "verify_schnorr" $ nf (S.verify_schnorr s_msg s_pk) s_sig + , bench "verify_schnorr'" $ nf (S.verify_schnorr' tex s_msg s_pk) s_sig ] where - setup = pure . S.parse_int256 $ B16.decodeLenient - "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed" + setup = do + let !tex = S.precompute + !int = S.parse_int256 $ B16.decodeLenient + "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed" + pure (tex, int) ecdsa :: Benchmark -ecdsa = env setup $ \ ~(big, pub, msg, sig) -> +ecdsa = env setup $ \ ~(tex, big, pub, msg, sig) -> bgroup "ecdsa" [ bench "sign_ecdsa (small)" $ nf (S.sign_ecdsa 2) s_msg , bench "sign_ecdsa (large)" $ nf (S.sign_ecdsa big) s_msg + , bench "sign_ecdsa' (small)" $ nf (S.sign_ecdsa' tex 2) s_msg + , bench "sign_ecdsa' (large)" $ nf (S.sign_ecdsa' tex big) s_msg , bench "verify_ecdsa" $ nf (S.verify_ecdsa msg pub) sig + , bench "verify_ecdsa'" $ nf (S.verify_ecdsa' tex msg pub) sig ] where setup = do - let big = S.parse_int256 $ B16.decodeLenient + let !tex = S.precompute + big = S.parse_int256 $ B16.decodeLenient "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed" pub = S.derive_pub big msg = "i approve of this message" sig = S.sign_ecdsa big s_msg - pure (big, pub, msg, sig) + pure (tex, big, pub, msg, sig) p_bs :: BS.ByteString p_bs = B16.decodeLenient diff --git a/lib/Crypto/Curve/Secp256k1.hs b/lib/Crypto/Curve/Secp256k1.hs --- a/lib/Crypto/Curve/Secp256k1.hs +++ b/lib/Crypto/Curve/Secp256k1.hs @@ -4,6 +4,7 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE UnboxedSums #-} {-# LANGUAGE ViewPatterns #-} @@ -27,18 +28,25 @@ -- * Parsing , parse_int256 , parse_point + , parse_sig -- * BIP0340 Schnorr signatures , sign_schnorr + , sign_schnorr' , verify_schnorr + , verify_schnorr' -- * RFC6979 ECDSA , ECDSA(..) , SigType(..) , sign_ecdsa + , sign_ecdsa' , sign_ecdsa_unrestricted + , sign_ecdsa_unrestricted' , verify_ecdsa + , verify_ecdsa' , verify_ecdsa_unrestricted + , verify_ecdsa_unrestricted' -- Elliptic curve group operations , neg @@ -47,6 +55,10 @@ , mul , mul_unsafe + , Context(..) + , precompute + , mul_wnaf + -- Coordinate systems and transformations , Affine(..) , Projective(..) @@ -57,6 +69,7 @@ -- for testing/benchmarking , Word256(..) , _sign_ecdsa_no_hash + , _sign_ecdsa_no_hash' , _CURVE_P , _CURVE_Q , _CURVE_G @@ -72,6 +85,7 @@ import qualified Data.Bits as B import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as BU +import qualified Data.Primitive.Array as A import Data.STRef import Data.Word (Word8, Word64) import GHC.Generics @@ -342,26 +356,26 @@ -- For a, return x such that a = x x mod _CURVE_P. modsqrtP :: Integer -> Maybe Integer modsqrtP n = runST $ do - r <- newSTRef 1 - num <- newSTRef n - e <- newSTRef ((_CURVE_P + 1) `I.integerQuot` 4) + r <- newSTRef 1 + num <- newSTRef n + e <- newSTRef ((_CURVE_P + 1) `I.integerQuot` 4) - let loop = do - ev <- readSTRef e - when (ev > 0) $ do - when (I.integerTestBit ev 0) $ do - numv <- readSTRef num - modifySTRef' r (\rv -> (rv * numv) `I.integerRem` _CURVE_P) - modifySTRef' num (\numv -> (numv * numv) `I.integerRem` _CURVE_P) - modifySTRef' e (`I.integerShiftR` 1) - loop + let loop = do + ev <- readSTRef e + when (ev > 0) $ do + when (I.integerTestBit ev 0) $ do + numv <- readSTRef num + modifySTRef' r (\rv -> (rv * numv) `I.integerRem` _CURVE_P) + modifySTRef' num (\numv -> (numv * numv) `I.integerRem` _CURVE_P) + modifySTRef' e (`I.integerShiftR` 1) + loop - loop - rv <- readSTRef r - pure $ - if remP (rv * rv) == n - then Just $! rv - else Nothing + loop + rv <- readSTRef r + pure $ + if remP (rv * rv) == n + then Just $! rv + else Nothing -- ec point operations -------------------------------------------------------- @@ -560,7 +574,7 @@ in if I.integerTestBit m 0 then loop (succ j) (add acc d) f nd nm else loop (succ j) acc (add f d) nd nm -{-# NOINLINE mul #-} +{-# INLINE mul #-} -- Timing-unsafe scalar multiplication of secp256k1 points. -- @@ -580,6 +594,90 @@ nr = if I.integerTestBit m 0 then add r d else r in loop nr nd nm +-- | Precomputed multiples of the secp256k1 base or generator point. +data Context = Context { + ctxW :: {-# UNPACK #-} !Int + , ctxArray :: !(A.Array Projective) + } deriving (Eq, Generic) + +instance Show Context where + show Context {} = "" + +-- | Create a secp256k1 context by precomputing multiples of the curve's +-- generator point. +-- +-- This should be used once to create a 'Context' to be reused +-- repeatedly afterwards. +-- +-- >>> let !tex = precompute +-- >>> sign_ecdsa' tex sec msg +-- >>> sign_schnorr' tex sec msg aux +precompute :: Context +precompute = _precompute 8 + +-- dumb strict pair +data Pair a b = Pair !a !b + +-- translation of noble-secp256k1's 'precompute' +_precompute :: Int -> Context +_precompute ctxW = Context {..} where + ctxArray = A.arrayFromListN size (loop_w mempty _CURVE_G 0) + capJ = (2 :: Int) ^ (ctxW - 1) + ws = 256 `quot` ctxW + 1 + size = ws * capJ + + loop_w !acc !p !w + | w == ws = reverse acc + | otherwise = + let b = p + !(Pair nacc nb) = loop_j p (b : acc) b 1 + np = double nb + in loop_w nacc np (succ w) + + loop_j !p !acc !b !j + | j == capJ = Pair acc b + | otherwise = + let nb = add b p + in loop_j p (nb : acc) nb (succ j) + +-- Timing-safe wNAF (w-ary non-adjacent form) scalar multiplication of +-- secp256k1 points. +mul_wnaf :: Context -> Integer -> Projective +mul_wnaf Context {..} _SECRET = + loop 0 _ZERO _CURVE_G _SECRET + where + wins = 256 `quot` ctxW + 1 + wsize = 2 ^ (ctxW - 1) + mask = 2 ^ ctxW - 1 + mnum = 2 ^ ctxW + + loop !w !acc !f !n + | w == wins = acc + | otherwise = + let !off0 = w * fi wsize + + !b0 = n `I.integerAnd` mask + !n0 = n `I.integerShiftR` fi ctxW + + !(Pair b1 n1) | b0 > wsize = Pair (b0 - mnum) (n0 + 1) + | otherwise = Pair b0 n0 + + !c0 = B.testBit w 0 + !c1 = b1 < 0 + + !off1 = off0 + fi (abs b1) - 1 + + in if b1 == 0 + then let !pr = A.indexArray ctxArray off0 + !pt | c0 = neg pr + | otherwise = pr + in loop (w + 1) acc (add f pt) n1 + else let !pr = A.indexArray ctxArray off1 + !pt | c1 = neg pr + | otherwise = pr + in loop (w + 1) (add acc pt) f n1 +{-# INLINE mul_wnaf #-} + -- | Derive a public key (i.e., a secp256k1 point) from the provided -- secret. -- @@ -659,6 +757,17 @@ then Just $! p else Nothing +-- | Parse an ECDSA signature encoded in 64-byte "compact" form. +-- +-- >>> parse_sig <64-byte compact signature> +-- "" +parse_sig :: BS.ByteString -> Maybe ECDSA +parse_sig bs + | BS.length bs /= 64 = Nothing + | otherwise = pure $ + let (roll -> r, roll -> s) = BS.splitAt 32 bs + in ECDSA r s + -- schnorr -------------------------------------------------------------------- -- see https://github.com/bitcoin/bips/blob/master/bip-0340.mediawiki @@ -682,10 +791,37 @@ -> BS.ByteString -- ^ message -> BS.ByteString -- ^ 32 bytes of auxilliary random data -> BS.ByteString -- ^ 64-byte Schnorr signature -sign_schnorr _SECRET m a +sign_schnorr = _sign_schnorr (mul _CURVE_G) + +-- | The same as 'sign_schnorr', except uses a 'Context' to optimise +-- internal calculations. +-- +-- You can expect about a 2x performance increase when using this +-- function, compared to 'sign_schnorr'. +-- +-- >>> import qualified System.Entropy as E +-- >>> aux <- E.getEntropy 32 +-- >>> let !tex = precompute +-- >>> sign_schnorr' tex sec msg aux +-- "<64-byte schnorr signature>" +sign_schnorr' + :: Context -- ^ secp256k1 context + -> Integer -- ^ secret key + -> BS.ByteString -- ^ message + -> BS.ByteString -- ^ 32 bytes of auxilliary random data + -> BS.ByteString -- ^ 64-byte Schnorr signature +sign_schnorr' tex = _sign_schnorr (mul_wnaf tex) + +_sign_schnorr + :: (Integer -> Projective) -- partially-applied multiplication function + -> Integer -- secret key + -> BS.ByteString -- message + -> BS.ByteString -- 32 bytes of auxilliary random data + -> BS.ByteString +_sign_schnorr _mul _SECRET m a | not (ge _SECRET) = error "ppad-secp256k1 (sign_schnorr): invalid secret key" | otherwise = - let p_proj = mul _CURVE_G _SECRET + let p_proj = _mul _SECRET Affine x_p y_p = affine p_proj d | I.integerTestBit y_p 0 = _CURVE_Q - _SECRET | otherwise = _SECRET @@ -702,7 +838,7 @@ in if k' == 0 -- negligible probability then error "ppad-secp256k1 (sign_schnorr): invalid k" else - let Affine x_r y_r = affine (mul _CURVE_G k') + let Affine x_r y_r = affine (_mul k') k | I.integerTestBit y_r 0 = _CURVE_Q - k' | otherwise = k' @@ -717,6 +853,7 @@ in if verify_schnorr m p_proj sig then sig else error "ppad-secp256k1 (sign_schnorr): invalid signature" +{-# INLINE _sign_schnorr #-} -- | Verify a 64-byte Schnorr signature for the provided message with -- the supplied public key. @@ -730,7 +867,34 @@ -> Pub -- ^ public key -> BS.ByteString -- ^ 64-byte Schnorr signature -> Bool -verify_schnorr m (affine -> Affine x_p _) sig +verify_schnorr = _verify_schnorr (mul_unsafe _CURVE_G) + +-- | The same as 'verify_schnorr', except uses a 'Context' to optimise +-- internal calculations. +-- +-- You can expect about a 1.5x performance increase when using this +-- function, compared to 'verify_schnorr'. +-- +-- >>> let !tex = precompute +-- >>> verify_schnorr' tex msg pub +-- True +-- >>> verify_schnorr' tex msg pub +-- False +verify_schnorr' + :: Context -- ^ secp256k1 context + -> BS.ByteString -- ^ message + -> Pub -- ^ public key + -> BS.ByteString -- ^ 64-byte Schnorr signature + -> Bool +verify_schnorr' tex = _verify_schnorr (mul_wnaf tex) + +_verify_schnorr + :: (Integer -> Projective) -- partially-applied multiplication function + -> BS.ByteString + -> Pub + -> BS.ByteString + -> Bool +_verify_schnorr _mul m (affine -> Affine x_p _) sig | BS.length sig /= 64 = False | otherwise = case lift x_p of Nothing -> False @@ -740,12 +904,13 @@ then False else let e = modQ . roll32 $ hash_tagged "BIP0340/challenge" (unroll32 r <> unroll32 x_P <> m) - dif = add (mul_unsafe _CURVE_G s) + dif = add (_mul s) (neg (mul_unsafe (projective capP) e)) in if dif == _ZERO then False else let Affine x_R y_R = affine dif in not (I.integerTestBit y_R 0 || x_R /= r) +{-# INLINE _verify_schnorr #-} -- ecdsa ---------------------------------------------------------------------- -- see https://www.rfc-editor.org/rfc/rfc6979, https://secg.org/sec1-v2.pdf @@ -810,8 +975,24 @@ :: Integer -- ^ secret key -> BS.ByteString -- ^ message -> ECDSA -sign_ecdsa = _sign_ecdsa LowS Hash +sign_ecdsa = _sign_ecdsa (mul _CURVE_G) LowS Hash +-- | The same as 'sign_ecdsa', except uses a 'Context' to optimise internal +-- calculations. +-- +-- You can expect about a 10x performance increase when using this +-- function, compared to 'sign_ecdsa'. +-- +-- >>> let !tex = precompute +-- >>> sign_ecdsa' tex sec msg +-- "" +sign_ecdsa' + :: Context -- ^ secp256k1 context + -> Integer -- ^ secret key + -> BS.ByteString -- ^ message + -> ECDSA +sign_ecdsa' tex = _sign_ecdsa (mul_wnaf tex) LowS Hash + -- | Produce an ECDSA signature for the provided message, using the -- provided private key. -- @@ -826,8 +1007,24 @@ :: Integer -- ^ secret key -> BS.ByteString -- ^ message -> ECDSA -sign_ecdsa_unrestricted = _sign_ecdsa Unrestricted Hash +sign_ecdsa_unrestricted = _sign_ecdsa (mul _CURVE_G) Unrestricted Hash +-- | The same as 'sign_ecdsa_unrestricted', except uses a 'Context' to +-- optimise internal calculations. +-- +-- You can expect about a 10x performance increase when using this +-- function, compared to 'sign_ecdsa_unrestricted'. +-- +-- >>> let !tex = precompute +-- >>> sign_ecdsa_unrestricted' tex sec msg +-- "" +sign_ecdsa_unrestricted' + :: Context -- ^ secp256k1 context + -> Integer -- ^ secret key + -> BS.ByteString -- ^ message + -> ECDSA +sign_ecdsa_unrestricted' tex = _sign_ecdsa (mul_wnaf tex) Unrestricted Hash + -- Produce a "low-s" ECDSA signature for the provided message, using -- the provided private key. Assumes that the message has already been -- pre-hashed. @@ -838,14 +1035,27 @@ :: Integer -- ^ secret key -> BS.ByteString -- ^ message digest -> ECDSA -_sign_ecdsa_no_hash = _sign_ecdsa LowS NoHash +_sign_ecdsa_no_hash = _sign_ecdsa (mul _CURVE_G) LowS NoHash -_sign_ecdsa :: SigType -> HashFlag -> Integer -> BS.ByteString -> ECDSA -_sign_ecdsa ty hf _SECRET m +_sign_ecdsa_no_hash' + :: Context + -> Integer + -> BS.ByteString + -> ECDSA +_sign_ecdsa_no_hash' tex = _sign_ecdsa (mul_wnaf tex) LowS NoHash + +_sign_ecdsa + :: (Integer -> Projective) -- partially-applied multiplication function + -> SigType + -> HashFlag + -> Integer + -> BS.ByteString + -> ECDSA +_sign_ecdsa _mul ty hf _SECRET m | not (ge _SECRET) = error "ppad-secp256k1 (sign_ecdsa): invalid secret key" | otherwise = runST $ do -- RFC6979 sec 3.3a - let entropy = int2octets _SECRET -- XX timing concern + let entropy = int2octets _SECRET nonce = bits2octets h drbg <- DRBG.new SHA256.hmac entropy nonce mempty -- RFC6979 sec 2.4 @@ -859,7 +1069,7 @@ sign_loop g = do k <- gen_k g - let kg = mul _CURVE_G k + let kg = _mul k Affine (modQ -> r) _ = affine kg s = case modinv k (fi _CURVE_Q) of Nothing -> error "ppad-secp256k1 (sign_ecdsa): bad k value" @@ -870,6 +1080,7 @@ in case ty of Unrestricted -> pure sig LowS -> pure (low sig) +{-# INLINE _sign_ecdsa #-} -- RFC6979 sec 3.3b gen_k :: DRBG.DRBG s -> ST s Integer @@ -909,6 +1120,27 @@ | s > B.unsafeShiftR _CURVE_Q 1 = False | otherwise = verify_ecdsa_unrestricted m p sig +-- | The same as 'verify_ecdsa', except uses a 'Context' to optimise +-- internal calculations. +-- +-- You can expect about a 2x performance increase when using this +-- function, compared to 'verify_ecdsa'. +-- +-- let !tex = precompute +-- >>> verify_ecdsa' tex msg pub valid_sig +-- True +-- >>> verify_ecdsa' tex msg pub invalid_sig +-- False +verify_ecdsa' + :: Context -- ^ secp256k1 context + -> BS.ByteString -- ^ message + -> Pub -- ^ public key + -> ECDSA -- ^ signature + -> Bool +verify_ecdsa' tex m p sig@(ECDSA _ s) + | s > B.unsafeShiftR _CURVE_Q 1 = False + | otherwise = verify_ecdsa_unrestricted' tex m p sig + -- | Verify an unrestricted ECDSA signature for the provided message and -- public key. -- @@ -921,7 +1153,34 @@ -> Pub -- ^ public key -> ECDSA -- ^ signature -> Bool -verify_ecdsa_unrestricted (SHA256.hash -> h) p (ECDSA r s) +verify_ecdsa_unrestricted = _verify_ecdsa_unrestricted (mul_unsafe _CURVE_G) + +-- | The same as 'verify_ecdsa_unrestricted', except uses a 'Context' to +-- optimise internal calculations. +-- +-- You can expect about a 2x performance increase when using this +-- function, compared to 'verify_ecdsa_unrestricted'. +-- +-- let !tex = precompute +-- >>> verify_ecdsa_unrestricted' tex msg pub valid_sig +-- True +-- >>> verify_ecdsa_unrestricted' tex msg pub invalid_sig +-- False +verify_ecdsa_unrestricted' + :: Context -- ^ secp256k1 context + -> BS.ByteString -- ^ message + -> Pub -- ^ public key + -> ECDSA -- ^ signature + -> Bool +verify_ecdsa_unrestricted' tex = _verify_ecdsa_unrestricted (mul_wnaf tex) + +_verify_ecdsa_unrestricted + :: (Integer -> Projective) -- partially-applied multiplication function + -> BS.ByteString + -> Pub + -> ECDSA + -> Bool +_verify_ecdsa_unrestricted _mul (SHA256.hash -> h) p (ECDSA r s) -- SEC1-v2 4.1.4 | not (ge r) || not (ge s) = False | otherwise = @@ -933,9 +1192,10 @@ Just si -> si u1 = remQ (e * s_inv) u2 = remQ (r * s_inv) - capR = add (mul_unsafe _CURVE_G u1) (mul_unsafe p u2) + capR = add (_mul u1) (mul_unsafe p u2) in if capR == _ZERO then False else let Affine (modQ -> v) _ = affine capR in v == r +{-# INLINE _verify_ecdsa_unrestricted #-} diff --git a/ppad-secp256k1.cabal b/ppad-secp256k1.cabal --- a/ppad-secp256k1.cabal +++ b/ppad-secp256k1.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: ppad-secp256k1 -version: 0.1.0 +version: 0.2.0 synopsis: Schnorr signatures & ECDSA on the elliptic curve secp256k1 license: MIT license-file: LICENSE @@ -30,6 +30,7 @@ , bytestring >= 0.9 && < 0.13 , ppad-hmac-drbg >= 0.1 && < 0.2 , ppad-sha256 >= 0.2 && < 0.3 + , primitive >= 0.8 && < 0.10 test-suite secp256k1-tests type: exitcode-stdio-1.0 diff --git a/test/BIP340.hs b/test/BIP340.hs --- a/test/BIP340.hs +++ b/test/BIP340.hs @@ -37,26 +37,38 @@ , c_comment :: !BS.ByteString } deriving Show -execute :: Case -> TestTree -execute Case {..} = testCase ("bip0340 " <> show c_index) $ +execute :: Context -> Case -> TestTree +execute tex Case {..} = testCase ("bip0340 " <> show c_index) $ case parse_point (B16.decodeLenient c_pk) of Nothing -> assertBool mempty (not c_res) Just pk -> do if c_sk == mempty then do -- no signature; test verification - let ver = verify_schnorr c_msg pk c_sig + let ver = verify_schnorr c_msg pk c_sig + ver' = verify_schnorr' tex c_msg pk c_sig if c_res - then assertBool mempty ver - else assertBool mempty (not ver) + then do + assertBool mempty ver + assertBool mempty ver' + else do + assertBool mempty (not ver) + assertBool mempty (not ver') -- XX test pubkey derivation from sk else do -- signature present; test sig too let sk = roll c_sk - sig = sign_schnorr sk c_msg c_aux - ver = verify_schnorr c_msg pk sig + sig = sign_schnorr sk c_msg c_aux + sig' = sign_schnorr' tex sk c_msg c_aux + ver = verify_schnorr c_msg pk sig + ver' = verify_schnorr' tex c_msg pk sig assertEqual mempty c_sig sig + assertEqual mempty c_sig sig' if c_res - then assertBool mempty ver - else assertBool mempty (not ver) + then do + assertBool mempty ver + assertBool mempty ver' + else do + assertBool mempty (not ver) + assertBool mempty (not ver') header :: AT.Parser () header = do diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -27,7 +27,8 @@ "etc/ecdsa_secp256k1_sha256_bitcoin_test.json" noble_ecdsa <- TIO.readFile "etc/noble_ecdsa.json" bip340 <- BS.readFile "etc/bip-0340-test-vectors.csv" - let quar = do + let !tex = precompute + 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 @@ -39,16 +40,17 @@ Nothing -> error "couldn't parse wycheproof vectors" 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 tex "(ecdsa, sha256)" Unrestricted w0 + , wycheproof_ecdsa_verify_tests tex "(ecdsa, sha256, low-s)" LowS w1 + , N.execute_ecdsa tex no + , testGroup "bip0340 vectors (schnorr)" (fmap (BIP340.execute tex) ip) ] -wycheproof_ecdsa_verify_tests :: String -> SigType -> W.Wycheproof -> TestTree -wycheproof_ecdsa_verify_tests msg ty W.Wycheproof {..} = +wycheproof_ecdsa_verify_tests + :: Context -> String -> SigType -> W.Wycheproof -> TestTree +wycheproof_ecdsa_verify_tests tex msg ty W.Wycheproof {..} = testGroup ("wycheproof vectors " <> msg) $ - fmap (W.execute_group ty) wp_testGroups + fmap (W.execute_group tex ty) wp_testGroups units :: TestTree units = testGroup "unit tests" [ diff --git a/test/Noble.hs b/test/Noble.hs --- a/test/Noble.hs +++ b/test/Noble.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} @@ -24,46 +25,51 @@ , ec_invalid :: !InvalidTest } deriving Show -execute_ecdsa :: Ecdsa -> TestTree -execute_ecdsa Ecdsa {..} = testGroup "noble_ecdsa" [ - testGroup "valid" (fmap execute_valid ec_valid) - , testGroup "invalid (sign)" (fmap execute_invalid_sign iv_sign) - , testGroup "invalid (verify)" (fmap execute_invalid_verify iv_verify) +execute_ecdsa :: Context -> Ecdsa -> TestTree +execute_ecdsa tex Ecdsa {..} = testGroup "noble_ecdsa" [ + testGroup "valid" (fmap (execute_valid tex) ec_valid) + , testGroup "invalid (sign)" (fmap (execute_invalid_sign tex) iv_sign) + , testGroup "invalid (verify)" (fmap (execute_invalid_verify tex) iv_verify) ] where InvalidTest {..} = ec_invalid -execute_valid :: (Int, ValidTest) -> TestTree -execute_valid (label, ValidTest {..}) = +execute_valid :: Context -> (Int, ValidTest) -> TestTree +execute_valid tex (label, ValidTest {..}) = testCase ("noble-secp256k1, valid (" <> show label <> ")") $ do let msg = vt_m x = vt_d pec = parse_compact vt_signature sig = _sign_ecdsa_no_hash x msg + sig' = _sign_ecdsa_no_hash' tex x msg + assertEqual mempty sig sig' assertEqual mempty pec sig -execute_invalid_sign :: (Int, InvalidSignTest) -> TestTree -execute_invalid_sign (label, InvalidSignTest {..}) = +execute_invalid_sign :: Context -> (Int, InvalidSignTest) -> TestTree +execute_invalid_sign tex (label, InvalidSignTest {..}) = testCase ("noble-secp256k1, invalid sign (" <> show label <> ")") $ do let x = ivs_d m = ivs_m err <- catch (pure (_sign_ecdsa_no_hash x m) >> pure False) handler - if err + err' <- catch (pure (_sign_ecdsa_no_hash' tex x m) >> pure False) handler + if err || err' then assertFailure "expected error not caught" else pure () where handler :: ErrorCall -> IO Bool handler _ = pure True -execute_invalid_verify :: (Int, InvalidVerifyTest) -> TestTree -execute_invalid_verify (label, InvalidVerifyTest {..}) = +execute_invalid_verify :: Context -> (Int, InvalidVerifyTest) -> TestTree +execute_invalid_verify tex (label, InvalidVerifyTest {..}) = testCase ("noble-secp256k1, invalid verify (" <> show label <> ")") $ case parse_point (B16.decodeLenient ivv_Q) of Nothing -> assertBool "no parse" True Just pub -> do let sig = parse_compact ivv_signature ver = verify_ecdsa ivv_m pub sig + ver' = verify_ecdsa' tex ivv_m pub sig assertBool mempty (not ver) + assertBool mempty (not ver') fi :: (Integral a, Num b) => a -> b fi = fromIntegral @@ -100,9 +106,9 @@ <*> fmap toBS (m .: "signature") parse_compact :: BS.ByteString -> ECDSA -parse_compact bs = - let (roll -> r, roll -> s) = BS.splitAt 32 bs - in ECDSA r s +parse_compact bs = case parse_sig bs of + Nothing -> error "bang" + Just s -> s data InvalidTest = InvalidTest { iv_sign :: ![(Int, InvalidSignTest)] diff --git a/test/Wycheproof.hs b/test/Wycheproof.hs --- a/test/Wycheproof.hs +++ b/test/Wycheproof.hs @@ -30,23 +30,24 @@ roll = BS.foldl' unstep 0 where unstep a (fi -> b) = (a `I.integerShiftL` 8) `I.integerOr` b -execute_group :: SigType -> EcdsaTestGroup -> TestTree -execute_group ty EcdsaTestGroup {..} = - testGroup msg (fmap (execute ty pk_uncompressed) etg_tests) +execute_group :: Context -> SigType -> EcdsaTestGroup -> TestTree +execute_group tex ty EcdsaTestGroup {..} = + testGroup msg (fmap (execute tex ty pk_uncompressed) etg_tests) where msg = "wycheproof (" <> T.unpack etg_type <> ", " <> T.unpack etg_sha <> ")" PublicKey {..} = etg_publicKey -execute :: SigType -> Projective -> EcdsaVerifyTest -> TestTree -execute ty pub EcdsaVerifyTest {..} = testCase report $ do +execute :: Context -> SigType -> Projective -> EcdsaVerifyTest -> TestTree +execute tex ty pub EcdsaVerifyTest {..} = testCase report $ do let msg = B16.decodeLenient (TE.encodeUtf8 t_msg) sig = toEcdsa t_sig case sig of Left _ -> assertBool mempty (t_result == "invalid") Right s -> do let ver = case ty of - LowS -> verify_ecdsa msg pub s + LowS -> verify_ecdsa msg pub s && verify_ecdsa' tex msg pub s Unrestricted -> verify_ecdsa_unrestricted msg pub s + && verify_ecdsa_unrestricted' tex msg pub s if t_result == "invalid" then assertBool mempty (not ver) else assertBool mempty ver