commit bd500270efe9a96fd477fa192b9abfc4c786647c
parent 9c44769dfa00e89cc8971bd5748c42cdbbb3edfe
Author: Jared Tobin <jared@jtobin.io>
Date: Thu, 10 Oct 2024 16:39:58 +0400
test: noble valid suite passing
Diffstat:
6 files changed, 191 insertions(+), 37 deletions(-)
diff --git a/etc/ecdsa.json b/etc/noble_ecdsa.json
diff --git a/lib/Crypto/Curve/Secp256k1.hs b/lib/Crypto/Curve/Secp256k1.hs
@@ -7,7 +7,14 @@
{-# LANGUAGE ViewPatterns #-}
module Crypto.Curve.Secp256k1 (
- Affine(..)
+ _CURVE_G
+ , _ZERO
+ , _CURVE_A
+ , _CURVE_B
+ , _CURVE_P
+ , _CURVE_Q
+
+ , Affine(..)
, Projective(..)
, affine
, projective
@@ -23,9 +30,12 @@ module Crypto.Curve.Secp256k1 (
, ECDSA(..)
, SigType(..)
, sign
- , verify
, sign_unrestricted
+ , verify
, verify_unrestricted
+
+ -- for testing
+ , _sign_no_hash
) where
import Control.Monad (when)
@@ -497,11 +507,28 @@ data ECDSA = ECDSA {
}
deriving (Eq, Show, Generic)
+-- ECDSA signature type.
data SigType =
LowS
| Unrestricted
deriving Show
+-- Hash message, or assume already hashed.
+data HashFlag =
+ Hash
+ | NoHash
+ deriving Show
+
+-- Produce a "low-s" ECDSA signature for the provided message, using
+-- the provided private key.
+--
+-- Assumes that the message has already been pre-hashed.
+--
+-- Useful for testing against noble-secp256k1's suite, in which messages
+-- have already been hashed.
+_sign_no_hash :: Integer -> BS.ByteString -> ECDSA
+_sign_no_hash = _sign LowS NoHash
+
-- | Produce an ECDSA signature for the provided message, using the
-- provided private key.
--
@@ -512,7 +539,7 @@ sign
:: Integer
-> BS.ByteString
-> ECDSA
-sign = _sign LowS
+sign = _sign LowS Hash
-- | Produce an ECDSA signature for the provided message, using the
-- provided private key.
@@ -524,10 +551,10 @@ sign_unrestricted
:: Integer
-> BS.ByteString
-> ECDSA
-sign_unrestricted = _sign Unrestricted
+sign_unrestricted = _sign Unrestricted Hash
-_sign :: SigType -> Integer -> BS.ByteString -> ECDSA
-_sign ty x (SHA256.hash -> h) = runST $ do
+_sign :: SigType -> HashFlag -> Integer -> BS.ByteString -> ECDSA
+_sign ty hf x m = runST $ do
-- RFC6979 sec 3.3a
let entropy = int2octets x
nonce = bits2octets h
@@ -552,6 +579,10 @@ _sign ty x (SHA256.hash -> h) = runST $ do
Unrestricted -> pure sig
LowS -> pure (low sig)
+ h = case hf of
+ Hash -> SHA256.hash m
+ NoHash -> m
+
-- RFC6979 sec 3.3b
gen_k :: DRBG.DRBG s -> ST s Integer
gen_k g = loop g where
diff --git a/ppad-secp256k1.cabal b/ppad-secp256k1.cabal
@@ -38,7 +38,8 @@ test-suite secp256k1-tests
hs-source-dirs: test
main-is: Main.hs
other-modules:
- Wycheproof
+ Noble
+ , Wycheproof
ghc-options:
-rtsopts -Wall
diff --git a/test/Main.hs b/test/Main.hs
@@ -16,6 +16,7 @@ import Test.Tasty
import Test.Tasty.HUnit
import qualified Data.Text.IO as TIO
import qualified Data.Text.Encoding as TE
+import qualified Noble as N
import qualified Wycheproof as W
fi :: (Integral a, Num b) => a -> b
@@ -27,45 +28,25 @@ main = do
wp_ecdsa_sha256 <- TIO.readFile "etc/ecdsa_secp256k1_sha256_test.json"
wp_ecdsa_sha256_bitcoin <- TIO.readFile
"etc/ecdsa_secp256k1_sha256_bitcoin_test.json"
- let pair = do
+ noble_ecdsa <- TIO.readFile "etc/noble_ecdsa.json"
+ let trip = do
wp0 <- A.decodeStrictText wp_ecdsa_sha256 :: Maybe W.Wycheproof
wp1 <- A.decodeStrictText wp_ecdsa_sha256_bitcoin :: Maybe W.Wycheproof
- pure (wp0, wp1)
- case pair of
+ nob <- A.decodeStrictText noble_ecdsa :: Maybe N.Ecdsa
+ pure (wp0, wp1, nob)
+ case trip of
Nothing -> error "couldn't parse wycheproof vectors"
- Just (w0, w1) -> defaultMain $ testGroup "ppad-secp256k1" [
+ Just (w0, w1, no) -> 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
]
wycheproof_ecdsa_verify_tests :: String -> SigType -> W.Wycheproof -> TestTree
wycheproof_ecdsa_verify_tests msg ty W.Wycheproof {..} =
testGroup ("wycheproof vectors " <> msg) $
- fmap (execute_group ty) wp_testGroups
-
-execute_group :: SigType -> W.EcdsaTestGroup -> TestTree
-execute_group ty W.EcdsaTestGroup {..} =
- testGroup msg (fmap (execute ty pk_uncompressed) etg_tests)
- where
- msg = mempty
- W.PublicKey {..} = etg_publicKey
-
-execute :: SigType -> Projective -> W.EcdsaVerifyTest -> TestTree
-execute ty pub W.EcdsaVerifyTest {..} = testCase report $ do
- let msg = B16.decodeLenient (TE.encodeUtf8 t_msg)
- sig = W.toEcdsa t_sig
- case sig of
- Left _ -> assertBool mempty (t_result == "invalid")
- Right s -> do
- let ver = case ty of
- LowS -> verify msg pub s
- Unrestricted -> verify_unrestricted msg pub s
- if t_result == "invalid"
- then assertBool mempty (not ver)
- else assertBool mempty ver
- where
- report = "test " <> show t_tcId
+ fmap (W.execute_group ty) wp_testGroups
units :: TestTree
units = testGroup "unit tests" [
diff --git a/test/Noble.hs b/test/Noble.hs
@@ -0,0 +1,113 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module Noble (
+ Ecdsa(..)
+ , execute_ecdsa
+ , execute_valid
+
+ , parse_compact
+ , roll -- uh
+ ) where
+
+import Crypto.Curve.Secp256k1
+import Data.Aeson ((.:))
+import qualified Data.Aeson as A
+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 (assertEqual, testCase)
+
+fi :: (Integral a, Num b) => a -> b
+fi = fromIntegral
+{-# INLINE fi #-}
+
+toBS :: T.Text -> BS.ByteString
+toBS = B16.decodeLenient . TE.encodeUtf8
+
+toSecKey :: T.Text -> Integer
+toSecKey = roll . toBS
+
+data Ecdsa = Ecdsa {
+ ec_valid :: ![(Int, ValidTest)]
+ , ec_invalid :: !InvalidTest
+ } deriving Show
+
+instance A.FromJSON Ecdsa where
+ parseJSON = A.withObject "Ecdsa" $ \m -> Ecdsa
+ <$> fmap (zip [0..]) (m .: "valid")
+ <*> m .: "invalid"
+
+-- XX run noble's invalid suites
+execute_ecdsa :: Ecdsa -> TestTree
+execute_ecdsa Ecdsa {..} = testGroup "noble_ecdsa" [
+ testGroup "valid" (fmap execute_valid ec_valid)
+ ]
+
+data ValidTest = ValidTest {
+ vt_d :: !Integer
+ , vt_m :: !BS.ByteString
+ , vt_signature :: !BS.ByteString
+ } deriving Show
+
+instance A.FromJSON ValidTest where
+ parseJSON = A.withObject "ValidTest" $ \m -> ValidTest
+ <$> fmap toSecKey (m .: "d")
+ <*> fmap toBS (m .: "m")
+ <*> fmap toBS (m .: "signature")
+
+-- 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
+
+parse_compact :: BS.ByteString -> ECDSA
+parse_compact bs =
+ let (roll -> r, roll -> s) = BS.splitAt 32 bs
+ in ECDSA r s
+
+execute_valid :: (Int, ValidTest) -> TestTree
+execute_valid (label, ValidTest {..}) =
+ testCase ("noble-secp256k1, valid (" <> show label <> ")") $ do
+ let msg = vt_m
+ x = vt_d
+ pec = parse_compact vt_signature
+ sig = _sign_no_hash x msg
+ assertEqual mempty pec sig
+
+data InvalidTest = InvalidTest {
+ iv_sign :: ![InvalidSignTest]
+ , iv_verify :: ![InvalidVerifyTest]
+ } deriving Show
+
+instance A.FromJSON InvalidTest where
+ parseJSON = A.withObject "InvalidTest" $ \m -> InvalidTest
+ <$> m .: "sign"
+ <*> m .: "verify"
+
+data InvalidSignTest = InvalidSignTest {
+ ivs_d :: !Integer
+ , ivs_m :: !BS.ByteString
+ } deriving Show
+
+instance A.FromJSON InvalidSignTest where
+ parseJSON = A.withObject "InvalidSignTest" $ \m -> InvalidSignTest
+ <$> fmap toSecKey (m .: "d")
+ <*> fmap toBS (m .: "m")
+
+data InvalidVerifyTest = InvalidVerifyTest {
+ ivv_Q :: !T.Text -- XX check noble pubkey encoding
+ , ivv_m :: !BS.ByteString
+ , ivv_signature :: !BS.ByteString -- XX to sig (from compact?)
+ } deriving Show
+
+instance A.FromJSON InvalidVerifyTest where
+ parseJSON = A.withObject "InvalidVerifyTest" $ \m -> InvalidVerifyTest
+ <$> m .: "Q"
+ <*> fmap toBS (m .: "m")
+ <*> fmap toBS (m .: "signature")
+
diff --git a/test/Wycheproof.hs b/test/Wycheproof.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
module Wycheproof (
@@ -11,6 +12,9 @@ module Wycheproof (
, parse_der_sig
, toProjective
, toEcdsa
+
+ , execute
+ , execute_group
) where
import Crypto.Curve.Secp256k1
@@ -23,6 +27,8 @@ 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)
fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
@@ -33,6 +39,29 @@ 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)
+ where
+ msg = mempty
+ PublicKey {..} = etg_publicKey
+
+execute :: SigType -> Projective -> EcdsaVerifyTest -> TestTree
+execute 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 msg pub s
+ Unrestricted -> verify_unrestricted msg pub s
+ if t_result == "invalid"
+ then assertBool mempty (not ver)
+ else assertBool mempty ver
+ where
+ report = "wycheproof (" <> show ty <> ") " <> show t_tcId
+
parse_der_sig :: AT.Parser ECDSA
parse_der_sig = do
_ <- AT.word8 0x30
@@ -128,14 +157,13 @@ instance A.FromJSON PublicKey where
toEcdsa :: T.Text -> Either String ECDSA
toEcdsa (B16.decodeLenient . TE.encodeUtf8 -> bs) =
- -- AT.parseOnly parse_der_len bs
AT.parseOnly parse_der_sig bs
data EcdsaVerifyTest = EcdsaVerifyTest {
t_tcId :: !Int
, t_comment :: !T.Text
, t_msg :: !T.Text
- , t_sig :: !T.Text -- XX invalid sigs prevent 'fmap toEcdsa'
+ , t_sig :: !T.Text
, t_result :: !T.Text
} deriving Show
