diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,21 @@ # Changelog +- 0.5.8 (2026-08-01) + * Addresses a number of minor issues found by an LLM scan: + + * Fixes potential out-of-bounds reads that could occur if anyone + used the _no_hash-suffixed ECDSA internal entry points on invalid + digest inputs. + + * Removes an entry point for the EC monoidal identity / point at + infinity to make it into both the ECDSA and Schnorr signature + machinery. + + * Fixes a validation lapse in sign_ecdsa, which previously e.g. + accepted an invalid secret key of zero. + + * Fixes other minor spec conformance and testing issues. + - 0.5.7 (2026-06-07) * Improves the performance of all wNAF-based signing & verification functions by about 1.5-2x, due to optimizations in 1) the 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 @@ -424,6 +424,14 @@ valid :: Projective -> Bool valid (affine -> Affine x y) = C.eq_vartime (C.sqr y) (weierstrass x) +-- Point is the identity, i.e. the point at infinity. +-- +-- Note that 'affine' maps the identity to (0, 0), so a point must be +-- tested here, and not via its affine coordinates. +is_inf :: Projective -> Bool +is_inf (Projective _ _ z) = CT.decide (C.eq z 0) +{-# INLINE is_inf #-} + -- (bip0340) return point with x coordinate == x and with even y coordinate -- -- conceptually: @@ -711,6 +719,10 @@ {-# INLINABLE add_proj #-} -- algo 8, renes et al, 2015 +-- +-- the second point must be affine, i.e. have z == 1. this is not +-- checked, and the result is meaningless otherwise; use add_proj if +-- the second point may be in projective form. add_mixed :: Projective -> Projective -> Projective add_mixed (P ax ay az) (P bx by bz) = let !(# x, y, z #) = add_mixed# (# ax, ay, az #) (# bx, by, bz #) @@ -884,17 +896,20 @@ parse_point :: BS.ByteString -> Maybe Projective parse_point bs | len == 32 = _parse_bip0340 bs - | len == 33 = _parse_compressed h t - | len == 65 = _parse_uncompressed h t - | otherwise = Nothing + | otherwise = case BS.uncons bs of + Nothing -> Nothing + Just (h, t) + | len == 33 -> _parse_compressed h t + | len == 65 -> _parse_uncompressed h t + | otherwise -> Nothing where len = BS.length bs - h = BU.unsafeIndex bs 0 -- lazy - t = BS.drop 1 bs -- input is guaranteed to be 32B in length _parse_bip0340 :: BS.ByteString -> Maybe Projective -_parse_bip0340 = fmap projective . lift_vartime . C.to . unsafe_roll32 +_parse_bip0340 (unsafe_roll32 -> x) = do + guard (fe x) -- bip0340 "fail if x >= p"; x == 0 has no lift anyway + fmap projective (lift_vartime (C.to x)) -- bytestring input is guaranteed to be 32B in length _parse_compressed :: Word8 -> BS.ByteString -> Maybe Projective @@ -916,6 +931,7 @@ _parse_uncompressed h bs = do let (unsafe_roll32 -> x, unsafe_roll32 -> y) = BS.splitAt _CURVE_Q_BYTES bs guard (h == 0x04) + guard (fe x && fe y) -- sec1-v2 requires both in [0, p - 1] let !p = Projective (C.to x) (C.to y) 1 guard (valid p) pure $! p @@ -985,8 +1001,10 @@ -- injection" attacks). This entropy is /supplemental/ to security, -- and the cryptographic security of the signature scheme itself does -- not rely on it, so it is not strictly required; 32 zero bytes can --- be used in its stead (and can be supplied via 'mempty'). +-- be used in its stead. -- +-- The auxiliary input is hashed, so any length input is accepted. +-- -- >>> import qualified System.Entropy as E -- >>> aux <- E.getEntropy 32 -- >>> sign_schnorr sec msg aux @@ -1033,7 +1051,9 @@ t = xor bytes_d (hash_aux a) rand = hash_nonce (t <> bytes_p <> m) k' = S.to (unsafe_roll32 rand) - guard (not (S.eq_vartime k' 0)) -- negligible probability + -- negligible probability, but k' is secret, so compare without + -- short-circuiting and decide only on the result + guard (not (CT.decide (S.eq k' 0))) pt <- _mul (S.retr k') let Affine (C.retr -> x_r) (C.retr -> y_r) = affine pt k = S.select k' (negate k') (W.odd y_r) @@ -1090,14 +1110,22 @@ -> Bool _verify_schnorr _mul m p sig | BS.length sig /= 64 = False + -- e * P vanishes for the identity, dropping the challenge from the + -- verification equation entirely + | is_inf p = False | otherwise = M.isJust $ do let capP = even_y_vartime p (unsafe_roll32 -> r, unsafe_roll32 -> s) = BS.splitAt 32 sig - guard (fe r && ge s) + -- bip0340 fails only on r >= p and s >= n, so zero is permitted + guard (W.lt_vartime r _CURVE_P && W.lt_vartime s _CURVE_Q) let Affine (C.retr -> x_P) _ = affine capP e = modQ . unsafe_roll32 $ hash_challenge (unroll32 r <> unroll32 x_P <> m) - pt0 <- _mul s + -- mul_wnaf rejects a zero scalar, mul_vartime does not; agree on + -- the identity so both multiplication functions behave alike + pt0 <- if W.eq_vartime s 0 + then pure _CURVE_ZERO + else _mul s pt1 <- mul_vartime capP e let dif = add pt0 (neg pt1) guard (dif /= _CURVE_ZERO) @@ -1239,7 +1267,7 @@ -- Produce a "low-s" ECDSA signature for the provided message, using -- the provided private key. Assumes that the message has already been --- pre-hashed. +-- pre-hashed, such that the digest is exactly 32 bytes. -- -- (Useful for testing against noble-secp256k1's suite, in which messages -- in the test vectors have already been hashed.) @@ -1247,14 +1275,18 @@ :: Wider -- ^ secret key -> BS.ByteString -- ^ message digest -> Maybe ECDSA -_sign_ecdsa_no_hash = _sign_ecdsa (mul _CURVE_G) LowS NoHash +_sign_ecdsa_no_hash _SECRET m + | BS.length m /= _CURVE_Q_BYTES = Nothing + | otherwise = _sign_ecdsa (mul _CURVE_G) LowS NoHash _SECRET m _sign_ecdsa_no_hash' :: Context -> Wider -> BS.ByteString -> Maybe ECDSA -_sign_ecdsa_no_hash' tex = _sign_ecdsa (mul_wnaf tex) LowS NoHash +_sign_ecdsa_no_hash' tex _SECRET m + | BS.length m /= _CURVE_Q_BYTES = Nothing + | otherwise = _sign_ecdsa (mul_wnaf tex) LowS NoHash _SECRET m _sign_ecdsa :: (Wider -> Maybe Projective) -- partially-applied multiplication function @@ -1263,13 +1295,15 @@ -> Wider -> BS.ByteString -> Maybe ECDSA -_sign_ecdsa _mul ty hf _SECRET m = runST $ do - -- RFC6979 sec 3.3a - let entropy = int2octets _SECRET - nonce = bits2octets h - drbg <- DRBG.new entropy nonce mempty - -- RFC6979 sec 2.4 - sign_loop drbg +_sign_ecdsa _mul ty hf _SECRET m + | not (ge _SECRET) = Nothing + | otherwise = runST $ do + -- RFC6979 sec 3.3a + let entropy = int2octets _SECRET + nonce = bits2octets h + drbg <- DRBG.new entropy nonce mempty + -- RFC6979 sec 2.4 + sign_loop drbg where d = S.to _SECRET hm = S.to (bits2int h) @@ -1290,7 +1324,8 @@ DRBG.wipe g pure Nothing Just (r, s) - | W.eq_vartime r 0 -> sign_loop g -- negligible probability + -- sec1-v2 4.1.3 retries on either being zero + | W.eq_vartime r 0 || W.eq_vartime s 0 -> sign_loop g | otherwise -> do DRBG.wipe g let !sig = Just $! ECDSA r s @@ -1308,9 +1343,9 @@ Left {} -> error "ppad-secp256k1: internal error (please report a bug!)" Right bs -> do let can = bits2int bs - case W.cmp_vartime can _CURVE_Q of - LT -> pure can - _ -> loop drbg -- 2 ^ -128 probability + if ge can -- rfc6979 requires k in [1, q - 1] + then pure can + else loop drbg -- 2 ^ -128 probability {-# INLINE gen_k #-} -- | Verify a "low-s" ECDSA signature for the provided message and @@ -1400,6 +1435,9 @@ let h = case hf of Hash -> SHA256.hash m NoHash -> m + -- u2 * P vanishes for the identity, leaving an equation an attacker + -- can satisfy by choosing s freely + guard (not (is_inf p)) guard (ge r0 && ge s0) let r = S.to r0 s = S.to s0 @@ -1421,7 +1459,8 @@ -- and public key. -- -- Mirrors 'verify_ecdsa', but skips the internal SHA256 step, --- treating the input as the message digest itself. +-- treating the input as the message digest itself. Fails to verify +-- if the digest is not exactly 32 bytes. -- -- >>> _verify_ecdsa_no_hash dig pub valid_sig -- True @@ -1433,6 +1472,7 @@ -> ECDSA -- ^ signature -> Bool _verify_ecdsa_no_hash m p sig@(ECDSA _ s) + | BS.length m /= _CURVE_Q_BYTES = False | W.gt_vartime s _CURVE_QH = False | otherwise = _verify_ecdsa_unrestricted (mul_vartime _CURVE_G) NoHash m p sig @@ -1455,6 +1495,7 @@ -> ECDSA -- ^ signature -> Bool _verify_ecdsa_no_hash' tex m p sig@(ECDSA _ s) + | BS.length m /= _CURVE_Q_BYTES = False | W.gt_vartime s _CURVE_QH = False | otherwise = _verify_ecdsa_unrestricted (mul_wnaf tex) NoHash m p sig 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.5.7 +version: 0.5.8 synopsis: Schnorr signatures, ECDSA, and ECDH on the elliptic curve secp256k1 license: MIT @@ -38,7 +38,7 @@ , bytestring >= 0.9 && < 0.13 , ppad-hmac-drbg >= 0.3.1 && < 0.4 , ppad-sha256 >= 0.3.2 && < 0.4 - , ppad-fixed >= 0.1.5 && < 0.2 + , ppad-fixed >= 0.2.0 && < 0.3 , primitive >= 0.8 && < 0.10 test-suite secp256k1-tests diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -5,10 +5,13 @@ module Main where import Crypto.Curve.Secp256k1 +import qualified Crypto.Hash.SHA256 as SHA256 import qualified Data.Aeson as A import qualified Data.Attoparsec.ByteString as AT import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as B16 +import qualified Data.Maybe as M +import qualified Numeric.Montgomery.Secp256k1.Scalar as S import Test.Tasty import Test.Tasty.HUnit import qualified Data.Text.IO as TIO @@ -48,7 +51,7 @@ case pen of Nothing -> error "couldn't parse wycheproof vectors" Just (w0, w1, w2, no, ip) -> defaultMain $ testGroup "ppad-secp256k1" [ - units + units tex , wycheproof_ecdsa_verify_tests tex "(ecdsa, sha256)" Unrestricted w0 , wycheproof_ecdsa_verify_tests tex "(ecdsa, sha256, low-s)" LowS w1 , wycheproof_ecdh_tests "(ecdh)" w2 @@ -67,20 +70,105 @@ testGroup ("wycheproof vectors " <> msg) $ fmap (WE.execute_group) wp_testGroups -units :: TestTree -units = testGroup "unit tests" [ +units :: Context -> TestTree +units tex = testGroup "unit tests" [ parse_point_tests , serialize_point_tests , add_tests , dub_tests + , identity_pubkey_tests tex ] +-- A public key at infinity annihilates the term carrying the challenge +-- (schnorr) or the key (ecdsa), leaving a verification equation an +-- attacker can satisfy for any message. +identity_pubkey_tests :: Context -> TestTree +identity_pubkey_tests tex = testGroup "identity public key" [ + schnorr_identity_test tex + , ecdsa_identity_test tex + ] + +forgery_msg :: BS.ByteString +forgery_msg = "arbitrary attacker-chosen message" + +-- The recovered point is s * G - e * O = s * G for every challenge e, +-- so (x(s * G), s) satisfies the equation whenever s * G has even y. +schnorr_forgery :: Maybe (Projective, BS.ByteString) +schnorr_forgery = do + let sec_bytes = decodeLenient + "b7e151628aed2a6abf7158809cf4f3c762e7160f38b4da56a784d9045190cfef" + sec <- parse_int256 sec_bytes + pub <- derive_pub sec + pure (pub, BS.drop 1 (serialize_point pub) <> sec_bytes) + +schnorr_identity_test :: Context -> TestTree +schnorr_identity_test tex = + testCase "schnorr verification rejects the identity" $ + case schnorr_forgery of + Nothing -> assertFailure "couldn't construct forgery" + Just (pub, sig) -> do + assertEqual "forgery is well-formed (even y)" + "\002" (BS.take 1 (serialize_point pub)) + assertBool mempty (not (verify_schnorr forgery_msg _CURVE_ZERO sig)) + assertBool mempty + (not (verify_schnorr' tex forgery_msg _CURVE_ZERO sig)) + +-- Verification reduces to x(u1 * G) == r for u1 = e / s, so choosing +-- u1 freely and setting s = e / u1 satisfies it for any message. +ecdsa_forgery :: Maybe ECDSA +ecdsa_forgery = do + e <- parse_int256 (SHA256.hash forgery_msg) + u1 <- parse_int256 (BS.replicate 32 0x22) + cap <- derive_pub u1 + r <- parse_int256 (BS.drop 1 (serialize_point cap)) + pure (ECDSA r (S.retr (S.to e * S.inv (S.to u1)))) + +ecdsa_identity_test :: Context -> TestTree +ecdsa_identity_test tex = + testCase "ecdsa verification rejects the identity" $ + case ecdsa_forgery of + Nothing -> assertFailure "couldn't construct forgery" + Just sig@(ECDSA r s) -> do + assertBool "forgery is well-formed (r in range)" (ge r) + assertBool "forgery is well-formed (s in range)" (ge s) + assertBool mempty + (not (verify_ecdsa_unrestricted forgery_msg _CURVE_ZERO sig)) + assertBool mempty + (not (verify_ecdsa_unrestricted' tex forgery_msg _CURVE_ZERO sig)) + parse_point_tests :: TestTree parse_point_tests = testGroup "parse_point tests" [ parse_point_test_p , parse_point_test_q , parse_point_test_r + , noncanonical_tests ] + +-- The field prime is within 2 ^ 32 of 2 ^ 256, so a coordinate in +-- [p, 2 ^ 256) reduces to a small one, giving a second encoding of a +-- point with a small x. x = 1 is such a point. +noncanonical_tests :: TestTree +noncanonical_tests = testGroup "non-canonical coordinates" [ + testCase "32-byte x-only, x = 1" $ + assertBool mempty (M.isJust (parse_point (decodeLenient x1_hex))) + , testCase "32-byte x-only, x = p + 1" $ + assertEqual mempty Nothing + (fmap serialize_point (parse_point (decodeLenient p1_hex))) + , testCase "65-byte uncompressed, x = 1" $ + assertBool mempty + (M.isJust (parse_point (decodeLenient ("04" <> x1_hex <> y1_hex)))) + , testCase "65-byte uncompressed, x = p + 1" $ + assertEqual mempty Nothing + (fmap serialize_point + (parse_point (decodeLenient ("04" <> p1_hex <> y1_hex)))) + ] + +-- x-coordinate of a curve point, and the field prime plus that +-- coordinate, which must not parse +x1_hex, p1_hex, y1_hex :: BS.ByteString +x1_hex = "0000000000000000000000000000000000000000000000000000000000000001" +p1_hex = "fffffffffffffffffffffffffffffffffffffffffffffffffffffffefffffc30" +y1_hex = "4218f20ae6c646b363db68605822fb14264ca8d2587fdd6fbc750d587e76a7ee" serialize_point_tests :: TestTree serialize_point_tests = testGroup "serialize_point tests" [ diff --git a/test/Noble.hs b/test/Noble.hs --- a/test/Noble.hs +++ b/test/Noble.hs @@ -9,7 +9,6 @@ , execute_ecdsa ) where -import Control.Exception import Crypto.Curve.Secp256k1 import Data.Aeson ((.:)) import qualified Data.Aeson as A @@ -61,28 +60,26 @@ 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 - err' <- catch (pure (_sign_ecdsa_no_hash' tex x m) >> pure False) handler - if err || err' - then assertFailure "expected error not caught" - else pure () + expect_nothing (_sign_ecdsa_no_hash ivs_d ivs_m) + expect_nothing (_sign_ecdsa_no_hash' tex ivs_d ivs_m) where - handler :: ErrorCall -> IO Bool - handler _ = pure True + expect_nothing :: Maybe ECDSA -> IO () + expect_nothing Nothing = pure () + expect_nothing (Just _) = + assertFailure "signed with an out-of-range secret key" execute_invalid_verify :: Context -> (Int, InvalidVerifyTest) -> TestTree execute_invalid_verify tex (label, InvalidVerifyTest {..}) = - testCase ("noble-secp256k1, invalid verify (" <> show label <> ")") $ - case parse_point (decodeLenient ivv_Q) of - Nothing -> assertBool "no parse" True - Just pub -> do + testCase ("noble-secp256k1, invalid verify (" <> show label <> ")") $ + -- every vector in this group must be rejected, whether by the + -- point parser or by verification itself + assertBool mempty (not accepted) + where + accepted = case parse_point (decodeLenient ivv_Q) of + Nothing -> False + Just pub -> 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') + in verify_ecdsa ivv_m pub sig || verify_ecdsa' tex ivv_m pub sig -- parser helper toBS :: T.Text -> BS.ByteString