commit 5d1ba01983c7e005d4cb88227f6eee7932267242
parent da830adde161d1b87e1355423be5b96f207f5412
Author: Jared Tobin <jared@jtobin.io>
Date: Fri, 19 Dec 2025 10:18:22 -0330
test: passing again
Diffstat:
6 files changed, 44 insertions(+), 79 deletions(-)
diff --git a/lib/Crypto/Curve/Secp256k1.hs b/lib/Crypto/Curve/Secp256k1.hs
@@ -87,6 +87,9 @@ module Crypto.Curve.Secp256k1 (
-- for testing/benchmarking
, _sign_ecdsa_no_hash
, _sign_ecdsa_no_hash'
+ , roll32
+ , unsafe_roll32
+ , unroll32
) where
import Control.Monad (guard)
@@ -218,10 +221,14 @@ unsafe_roll32 bs =
{-# INLINABLE unsafe_roll32 #-}
-- arbitrary-size big-endian bytestring decoding
-roll :: BS.ByteString -> Wider
-roll = BS.foldl' alg 0 where
- alg !a (word8_to_wider -> !b) = (a `W.shl_limb` 8) `W.or` b
-{-# INLINABLE roll #-}
+roll32 :: BS.ByteString -> Maybe Wider
+roll32 bs
+ | BS.length stripped > 32 = Nothing
+ | otherwise = Just $! BS.foldl' alg 0 stripped
+ where
+ stripped = BS.dropWhile (== 0) bs
+ alg !a (word8_to_wider -> !b) = (a `W.shl_limb` 8) `W.or` b
+{-# INLINABLE roll32 #-}
-- 256-bit big-endian bytestring encoding
unroll32 :: Wider -> BS.ByteString
@@ -314,16 +321,12 @@ _CURVE_Bm3 = 21
-- Is field element?
fe :: Wider -> Bool
-fe n = case W.cmp n _CURVE_P of
- LT -> True
- _ -> False
+fe n = n > 0 && n < _CURVE_P
{-# INLINE fe #-}
-- Is group element?
ge :: Wider -> Bool
-ge n = case W.cmp n _CURVE_Q of
- LT -> True
- _ -> False
+ge n = n > 0 && n < _CURVE_Q
{-# INLINE ge #-}
-- curve points ---------------------------------------------------------------
@@ -798,7 +801,7 @@ _parse_compressed h (unsafe_roll32 -> x)
_parse_uncompressed :: Word8 -> BS.ByteString -> Maybe Projective
_parse_uncompressed h bs = do
let (unsafe_roll32 -> x, unsafe_roll32 -> y) = BS.splitAt _CURVE_Q_BYTES bs
- guard (h /= 0x04)
+ guard (h == 0x04)
let !p = Projective (C.to x) (C.to y) 1
guard (valid p)
pure $! p
@@ -808,11 +811,12 @@ _parse_uncompressed h bs = do
-- >>> parse_sig <64-byte compact signature>
-- Just "<ecdsa 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
+parse_sig bs = do
+ guard (BS.length bs == 64)
+ let (r0, s0) = BS.splitAt 32 bs
+ r <- roll32 r0
+ s <- roll32 s0
+ pure $! ECDSA r s
-- serializing ----------------------------------------------------------------
diff --git a/ppad-secp256k1.cabal b/ppad-secp256k1.cabal
@@ -54,6 +54,7 @@ test-suite secp256k1-tests
, base
, bytestring
, ppad-base16
+ , ppad-fixed
, ppad-secp256k1
, ppad-sha256
, tasty
diff --git a/test/BIP340.hs b/test/BIP340.hs
@@ -13,25 +13,14 @@ import Crypto.Curve.Secp256k1
import qualified Data.Attoparsec.ByteString.Char8 as AT
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
-import qualified GHC.Num.Integer as I
import Test.Tasty
import Test.Tasty.HUnit
--- XX make a test prelude instead of copying/pasting these things everywhere
-
decodeLenient :: BS.ByteString -> BS.ByteString
decodeLenient bs = case B16.decode bs of
Nothing -> error "bang"
Just b -> b
-fi :: (Integral a, Num b) => a -> b
-fi = fromIntegral
-{-# INLINE fi #-}
-
-roll :: BS.ByteString -> Integer
-roll = BS.foldl' unstep 0 where
- unstep a (fi -> b) = (a `I.integerShiftL` 8) `I.integerOr` b
-
data Case = Case {
c_index :: !Int
, c_sk :: !BS.ByteString
@@ -61,7 +50,7 @@ execute tex Case {..} = testCase ("bip0340 " <> show c_index) $
assertBool mempty (not ver')
-- XX test pubkey derivation from sk
else do -- signature present; test sig too
- let sk = roll c_sk
+ let sk = unsafe_roll32 c_sk
Just sig = sign_schnorr sk c_msg c_aux
Just sig' = sign_schnorr' tex sk c_msg c_aux
ver = verify_schnorr c_msg pk sig
diff --git a/test/Noble.hs b/test/Noble.hs
@@ -17,7 +17,7 @@ import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
-import qualified GHC.Num.Integer as I
+import Data.Word.Wider (Wider(..))
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (assertEqual, assertBool, assertFailure, testCase)
@@ -77,22 +77,13 @@ execute_invalid_verify tex (label, InvalidVerifyTest {..}) =
assertBool mempty (not ver)
assertBool mempty (not ver')
-fi :: (Integral a, Num b) => a -> b
-fi = fromIntegral
-{-# INLINE fi #-}
-
-- parser helper
toBS :: T.Text -> BS.ByteString
toBS = decodeLenient . TE.encodeUtf8
-- parser helper
-toSecKey :: T.Text -> Integer
-toSecKey = roll . toBS
-
--- big-endian bytestring decoding
-roll :: BS.ByteString -> Integer
-roll = BS.foldl' unstep 0 where
- unstep a (fi -> b) = (a `I.integerShiftL` 8) `I.integerOr` b
+toSecKey :: T.Text -> Wider
+toSecKey = unsafe_roll32 . toBS
instance A.FromJSON Ecdsa where
parseJSON = A.withObject "Ecdsa" $ \m -> Ecdsa
@@ -100,7 +91,7 @@ instance A.FromJSON Ecdsa where
<*> m .: "invalid"
data ValidTest = ValidTest {
- vt_d :: !Integer
+ vt_d :: !Wider
, vt_m :: !BS.ByteString
, vt_signature :: !BS.ByteString
} deriving Show
@@ -127,7 +118,7 @@ instance A.FromJSON InvalidTest where
<*> fmap (zip [0..]) (m .: "verify")
data InvalidSignTest = InvalidSignTest {
- ivs_d :: !Integer
+ ivs_d :: !Wider
, ivs_m :: !BS.ByteString
} deriving Show
diff --git a/test/Wycheproof.hs b/test/Wycheproof.hs
@@ -17,7 +17,6 @@ import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
-import qualified GHC.Num.Integer as I
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (assertBool, testCase)
@@ -30,11 +29,6 @@ fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
{-# INLINE fi #-}
--- big-endian bytestring decoding
-roll :: BS.ByteString -> Integer
-roll = BS.foldl' unstep 0 where
- unstep a (fi -> b) = (a `I.integerShiftL` 8) `I.integerOr` b
-
execute_group :: Context -> SigType -> EcdsaTestGroup -> TestTree
execute_group tex ty EcdsaTestGroup {..} =
testGroup msg (fmap (execute tex ty pk_uncompressed) etg_tests)
@@ -74,13 +68,18 @@ parse_der_sig = do
meat len = do
(lr, bs_r) <- parseAsnInt
(ls, bs_s) <- parseAsnInt
- let r = fi (roll bs_r)
- s = fi (roll bs_s)
- checks = lr + ls == len
- rest <- AT.takeByteString
- if rest == mempty && checks
- then pure (ECDSA r s)
- else fail "input remaining or length mismatch"
+ let rs = do
+ r <- roll32 bs_r
+ s <- roll32 bs_s
+ pure (r, s)
+ case rs of
+ Nothing -> fail "signature components too large"
+ Just (r, s) -> do
+ let checks = lr + ls == len
+ rest <- AT.takeByteString
+ if rest == mempty && checks
+ then pure (ECDSA r s)
+ else fail "input remaining or length mismatch"
parseAsnInt :: AT.Parser (Int, BS.ByteString)
parseAsnInt = do
diff --git a/test/WycheproofEcdh.hs b/test/WycheproofEcdh.hs
@@ -13,11 +13,11 @@ import qualified Crypto.Hash.SHA256 as SHA256
import Data.Aeson ((.:))
import qualified Data.Aeson as A
import qualified Data.Attoparsec.ByteString as AT
-import Data.Bits ((.<<.), (.>>.), (.|.))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
+import Data.Word.Wider (Wider(..))
import Test.Tasty (TestTree, testGroup)
import qualified Test.Tasty.HUnit as H (assertBool, assertEqual, testCase)
@@ -137,29 +137,10 @@ der_to_pub :: T.Text -> Either String Projective
der_to_pub (decodeLenient . TE.encodeUtf8 -> bs) =
AT.parseOnly parse_der_pub bs
-parse_bigint :: T.Text -> Integer
-parse_bigint (decodeLenient . TE.encodeUtf8 -> bs) = roll bs where
- roll :: BS.ByteString -> Integer
- roll = BS.foldl' alg 0 where
- alg !a (fi -> !b) = (a .<<. 8) .|. b
-
--- big-endian bytestring encoding
-unroll :: Integer -> BS.ByteString
-unroll i = case i of
- 0 -> BS.singleton 0
- _ -> BS.reverse $ BS.unfoldr step i
- where
- step 0 = Nothing
- step m = Just (fi m, m .>>. 8)
-
--- big-endian bytestring encoding for 256-bit ints, 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
+parse_bigint :: T.Text -> Wider
+parse_bigint (decodeLenient . TE.encodeUtf8 -> bs) = case roll32 bs of
+ Nothing -> error "couldn't parse_bigint"
+ Just v -> v
data Wycheproof = Wycheproof {
wp_testGroups :: ![EcdhTestGroup]
