commit 0d5916fe6754c86380ed81de58a40fc22c015257
parent b9f7f47b6d46c928307351c1ddef59fa92253bb7
Author: Jared Tobin <jared@jtobin.io>
Date: Thu, 7 Nov 2024 15:39:46 +0400
test: wycheproof skeleton work
Diffstat:
5 files changed, 181 insertions(+), 193 deletions(-)
diff --git a/flake.lock b/flake.lock
@@ -34,10 +34,37 @@
"type": "github"
}
},
- "root": {
+ "ppad-sha256": {
"inputs": {
"flake-utils": "flake-utils",
"nixpkgs": "nixpkgs"
+ },
+ "locked": {
+ "lastModified": 1728824578,
+ "narHash": "sha256-sMZLvmbl3fBUHpBePzGuLdUyUALba/P5DCgKVgqEH1k=",
+ "ref": "master",
+ "rev": "3cc6c146ae36f67d73c6c207486a199dbc77658e",
+ "revCount": 82,
+ "type": "git",
+ "url": "git://git.ppad.tech/sha256.git"
+ },
+ "original": {
+ "ref": "master",
+ "type": "git",
+ "url": "git://git.ppad.tech/sha256.git"
+ }
+ },
+ "root": {
+ "inputs": {
+ "flake-utils": [
+ "ppad-sha256",
+ "flake-utils"
+ ],
+ "nixpkgs": [
+ "ppad-sha256",
+ "nixpkgs"
+ ],
+ "ppad-sha256": "ppad-sha256"
}
},
"systems": {
diff --git a/flake.nix b/flake.nix
@@ -2,11 +2,16 @@
description = "ppad-csecp256k1";
inputs = {
- nixpkgs.url = "github:NixOS/nixpkgs/nixpkgs-unstable";
- flake-utils.url = "github:numtide/flake-utils";
+ ppad-sha256 = {
+ type = "git";
+ url = "git://git.ppad.tech/sha256.git";
+ ref = "master";
+ };
+ flake-utils.follows = "ppad-sha256/flake-utils";
+ nixpkgs.follows = "ppad-sha256/nixpkgs";
};
- outputs = { self, nixpkgs, flake-utils }:
+ outputs = { self, nixpkgs, flake-utils, ppad-sha256 }:
flake-utils.lib.eachDefaultSystem (system:
let
lib = "ppad-csecp256k1";
@@ -14,8 +19,13 @@
pkgs = import nixpkgs { inherit system; };
hlib = pkgs.haskell.lib;
+ sha256 = ppad-sha256.packages.${system}.default;
+
hpkgs = pkgs.haskell.packages.ghc981.extend (new: old: {
- ${lib} = old.callCabal2nix lib ./. {};
+ ppad-sha256 = sha256;
+ ${lib} = new.callCabal2nix lib ./. {
+ ppad-sha256 = new.ppad-sha256;
+ };
});
cc = pkgs.stdenv.cc;
diff --git a/ppad-csecp256k1.cabal b/ppad-csecp256k1.cabal
@@ -39,16 +39,23 @@ test-suite csecp256k1-tests
default-language: Haskell2010
hs-source-dirs: test
main-is: Main.hs
+ other-modules:
+ Wycheproof
ghc-options:
-rtsopts -Wall
build-depends:
- base
+ aeson
+ , attoparsec
+ , base
+ , base16-bytestring
, bytestring
, ppad-csecp256k1
+ , ppad-sha256
, tasty
, tasty-hunit
+ , text
benchmark csecp256k1-bench
type: exitcode-stdio-1.0
@@ -117,23 +124,3 @@ test-suite secp256k1-sys-tests
, tasty
, tasty-hunit
-test-suite wycheproof
- type: exitcode-stdio-1.0
- default-language: Haskell2010
- hs-source-dirs: test
- main-is: Wycheproof.hs
-
- ghc-options:
- -rtsopts -Wall
-
- build-depends:
- aeson
- , attoparsec
- , base
- , base16-bytestring
- , bytestring
- , ppad-csecp256k1
- , tasty
- , tasty-hunit
- , text
-
diff --git a/test/Main.hs b/test/Main.hs
@@ -1,14 +1,33 @@
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
module Main where
-import qualified Data.ByteString as BS
import Crypto.Curve.Secp256k1
+import qualified Data.Aeson as A
+import qualified Data.ByteString as BS
+import qualified Data.Text.IO as TIO
import Test.Tasty
import Test.Tasty.HUnit
+import qualified Wycheproof as W
main :: IO ()
-main = defaultMain units
+main = do
+ wp_ecdsa_sha256_bitcoin <- TIO.readFile
+ "etc/ecdsa_secp256k1_sha256_bitcoin_test.json"
+ let vec = A.decodeStrictText wp_ecdsa_sha256_bitcoin :: Maybe W.Wycheproof
+ case vec of
+ Nothing -> error "couldn't parse wycheproof vectors"
+ Just W.Wycheproof {..} -> wcontext $ \tex -> do
+ tree <- traverse (W.execute_group tex) wp_testGroups
+ defaultMain $ testGroup "ppad-csecp256k1" [
+ units
+ , wycheproof_ecdsa_verify_tests "(ecdsa, sha256, low-s)" tree
+ ]
+
+wycheproof_ecdsa_verify_tests :: String -> [TestTree] -> TestTree
+wycheproof_ecdsa_verify_tests msg ts =
+ testGroup ("wycheproof vectors " <> msg) ts
units :: TestTree
units = testGroup "unit tests" [
diff --git a/test/Wycheproof.hs b/test/Wycheproof.hs
@@ -3,170 +3,115 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
-module Main where
+module Wycheproof (
+ Wycheproof(..)
+ , execute_group
+ ) where
-main = pure ()
+import Control.Exception
+import Crypto.Curve.Secp256k1
+import qualified Crypto.Hash.SHA256 as SHA256
+import Data.Aeson ((.:))
+import qualified Data.Aeson as A
+import qualified Data.Attoparsec.ByteString as AT
+import qualified Data.Bits as B
+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)
+
+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 -> EcdsaTestGroup -> IO TestTree
+execute_group tex EcdsaTestGroup {..} = do
+ let raw = B16.decodeLenient (TE.encodeUtf8 pk_uncompressed)
+ pub <- parse_pub tex raw
+ let tests = fmap (execute tex pub) etg_tests
+ pure (testGroup msg tests)
+ where
+ msg = "wycheproof (" <> T.unpack etg_type <> ", " <> T.unpack etg_sha <> ")"
+ PublicKey {..} = etg_publicKey
+
+execute :: Context -> Pub -> EcdsaVerifyTest -> TestTree
+execute tex pub EcdsaVerifyTest {..} = testCase report $ do
+ let msg = B16.decodeLenient (TE.encodeUtf8 t_msg)
+ sig = B16.decodeLenient (TE.encodeUtf8 t_sig)
+ syg <- try (parse_der tex sig) :: IO (Either Secp256k1Exception Sig)
+ case syg of
+ Left _ -> assertBool mempty (t_result == "invalid")
+ Right s -> do
+ ver <- verify_ecdsa tex pub msg s
+ if t_result == "invalid"
+ then assertBool mempty (not ver)
+ else assertBool mempty ver
+ where
+ report = "wycheproof " <> show t_tcId
+
+data Wycheproof = Wycheproof {
+ wp_algorithm :: !T.Text
+ , wp_generatorVersion :: !T.Text
+ , wp_numberOfTests :: !Int
+ , wp_testGroups :: ![EcdsaTestGroup]
+ } deriving Show
+
+instance A.FromJSON Wycheproof where
+ parseJSON = A.withObject "Wycheproof" $ \m -> Wycheproof
+ <$> m .: "algorithm"
+ <*> m .: "generatorVersion"
+ <*> m .: "numberOfTests"
+ <*> m .: "testGroups"
+
+data EcdsaTestGroup = EcdsaTestGroup {
+ etg_type :: !T.Text
+ , etg_publicKey :: !PublicKey
+ , etg_sha :: !T.Text
+ , etg_tests :: ![EcdsaVerifyTest]
+ } deriving Show
+
+instance A.FromJSON EcdsaTestGroup where
+ parseJSON = A.withObject "EcdsaTestGroup" $ \m -> EcdsaTestGroup
+ <$> m .: "type"
+ <*> m .: "publicKey"
+ <*> m .: "sha"
+ <*> m .: "tests"
+
+data PublicKey = PublicKey {
+ pk_type :: !T.Text
+ , pk_curve :: !T.Text
+ , pk_keySize :: !Int
+ , pk_uncompressed :: !T.Text
+ } deriving Show
+
+instance A.FromJSON PublicKey where
+ parseJSON = A.withObject "PublicKey" $ \m -> PublicKey
+ <$> m .: "type"
+ <*> m .: "curve"
+ <*> m .: "keySize"
+ <*> m .: "uncompressed"
+
+data EcdsaVerifyTest = EcdsaVerifyTest {
+ t_tcId :: !Int
+ , t_comment :: !T.Text
+ , t_msg :: !T.Text
+ , t_sig :: !T.Text
+ , t_result :: !T.Text
+ } deriving Show
+
+instance A.FromJSON EcdsaVerifyTest where
+ parseJSON = A.withObject "EcdsaVerifyTest" $ \m -> EcdsaVerifyTest
+ <$> m .: "tcId"
+ <*> m .: "comment"
+ <*> m .: "msg"
+ <*> m .: "sig"
+ <*> m .: "result"
--- module Wycheproof (
--- Wycheproof(..)
--- , execute_group
--- ) where
---
--- import Crypto.Curve.Secp256k1
--- import Data.Aeson ((.:))
--- import qualified Data.Aeson as A
--- import qualified Data.Attoparsec.ByteString as AT
--- import qualified Data.Bits as B
--- 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)
---
--- 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 :: SigType -> EcdsaTestGroup -> TestTree
--- execute_group ty EcdsaTestGroup {..} =
--- testGroup msg (fmap (execute 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
--- 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
--- Unrestricted -> verify_ecdsa_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
--- len <- fmap fi AT.anyWord8
--- content <- AT.take len
--- etc <- AT.takeByteString
--- if BS.length content /= len || etc /= mempty
--- then fail "invalid content"
--- else case AT.parseOnly (meat len) content of
--- Left _ -> fail "invalid content"
--- Right v -> pure v
--- where
--- 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"
---
--- parseAsnInt :: AT.Parser (Int, BS.ByteString)
--- parseAsnInt = do
--- _ <- AT.word8 0x02
--- len <- fmap fi AT.anyWord8
--- content <- AT.take len
--- if BS.length content /= len
--- then fail "invalid length"
--- else if len == 1
--- then pure (len + 2, content) -- + tag byt + len byt
--- else case BS.uncons content of
--- Nothing -> fail "invalid content"
--- Just (h0, t0)
--- | B.testBit h0 7 -> fail "negative value"
--- | otherwise -> case BS.uncons t0 of
--- Nothing -> fail "invalid content"
--- Just (h1, _)
--- | h0 == 0x00 && not (B.testBit h1 7) -> fail "invalid padding"
--- | otherwise -> case BS.unsnoc content of
--- Nothing -> fail "invalid content"
--- Just (_, tn)
--- | tn == 0x00 -> fail "invalid padding"
--- | otherwise -> pure (len + 2, content)
---
--- data Wycheproof = Wycheproof {
--- wp_algorithm :: !T.Text
--- , wp_generatorVersion :: !T.Text
--- , wp_numberOfTests :: !Int
--- , wp_testGroups :: ![EcdsaTestGroup]
--- } deriving Show
---
--- instance A.FromJSON Wycheproof where
--- parseJSON = A.withObject "Wycheproof" $ \m -> Wycheproof
--- <$> m .: "algorithm"
--- <*> m .: "generatorVersion"
--- <*> m .: "numberOfTests"
--- <*> m .: "testGroups"
---
--- data EcdsaTestGroup = EcdsaTestGroup {
--- etg_type :: !T.Text
--- , etg_publicKey :: !PublicKey
--- , etg_sha :: !T.Text
--- , etg_tests :: ![EcdsaVerifyTest]
--- } deriving Show
---
--- instance A.FromJSON EcdsaTestGroup where
--- parseJSON = A.withObject "EcdsaTestGroup" $ \m -> EcdsaTestGroup
--- <$> m .: "type"
--- <*> m .: "publicKey"
--- <*> m .: "sha"
--- <*> m .: "tests"
---
--- data PublicKey = PublicKey {
--- pk_type :: !T.Text
--- , pk_curve :: !T.Text
--- , pk_keySize :: !Int
--- , pk_uncompressed :: !Projective
--- } deriving Show
---
--- toProjective :: T.Text -> Projective
--- toProjective (B16.decodeLenient . TE.encodeUtf8 -> bs) = case parse_point bs of
--- Nothing -> error "wycheproof: couldn't parse pubkey"
--- Just p -> p
---
--- instance A.FromJSON PublicKey where
--- parseJSON = A.withObject "PublicKey" $ \m -> PublicKey
--- <$> m .: "type"
--- <*> m .: "curve"
--- <*> m .: "keySize"
--- <*> fmap toProjective (m .: "uncompressed")
---
--- toEcdsa :: T.Text -> Either String ECDSA
--- toEcdsa (B16.decodeLenient . TE.encodeUtf8 -> 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
--- , t_result :: !T.Text
--- } deriving Show
---
--- instance A.FromJSON EcdsaVerifyTest where
--- parseJSON = A.withObject "EcdsaVerifyTest" $ \m -> EcdsaVerifyTest
--- <$> m .: "tcId"
--- <*> m .: "comment"
--- <*> m .: "msg"
--- <*> m .: "sig"
--- <*> m .: "result"
---
