commit f79d941b2b5b37b5aca2012b4f1b53bd23707e0a
parent 335c6e52236327caca4d2edc68276823c8ec2d89
Author: Jared Tobin <jared@jtobin.io>
Date: Fri, 8 Nov 2024 16:15:17 +0400
test: test wnaf-based stuff
Diffstat:
4 files changed, 56 insertions(+), 35 deletions(-)
diff --git a/test/BIP340.hs b/test/BIP340.hs
@@ -37,26 +37,38 @@ data Case = Case {
, 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
@@ -27,7 +27,8 @@ main = do
"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 @@ main = do
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
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
@@ -24,46 +25,51 @@ data Ecdsa = Ecdsa {
, 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
diff --git a/test/Wycheproof.hs b/test/Wycheproof.hs
@@ -30,23 +30,24 @@ roll :: BS.ByteString -> Integer
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
