commit 5465c786427b6475239b562aa4dc4fe70178aab0
parent 6b6e784010ba5b6ddb938e62a90eccb07bf5a3fb
Author: Jared Tobin <jared@jtobin.io>
Date: Sun, 22 Jun 2025 13:22:05 +0400
lib: vertical integration
Diffstat:
10 files changed, 124 insertions(+), 47 deletions(-)
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -15,6 +15,11 @@ instance NFData S.Affine
instance NFData S.ECDSA
instance NFData S.Context
+decodeLenient :: BS.ByteString -> BS.ByteString
+decodeLenient bs = case B16.decode bs of
+ Nothing -> error "bang"
+ Just b -> b
+
main :: IO ()
main = defaultMain [
parse_point
@@ -40,7 +45,7 @@ remQ = env setup $ \x ->
, bench "remQ (2 ^ 255 - 19)" $ nf S.remQ x
]
where
- setup = pure . parse_int256 $ B16.decodeLenient
+ setup = pure . parse_int256 $ decodeLenient
"7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"
parse_point :: Benchmark
@@ -78,7 +83,7 @@ mul = env setup $ \x ->
, bench "(2 ^ 255 - 19) G" $ nf (S.mul S._CURVE_G) x
]
where
- setup = pure . parse_int256 $ B16.decodeLenient
+ setup = pure . parse_int256 $ decodeLenient
"7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"
precompute :: Benchmark
@@ -93,7 +98,7 @@ mul_wnaf = env setup $ \ ~(tex, x) ->
where
setup = do
let !tex = S.precompute
- !int = parse_int256 $ B16.decodeLenient
+ !int = parse_int256 $ decodeLenient
"7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"
pure (tex, int)
@@ -108,7 +113,7 @@ derive_pub = env setup $ \ ~(tex, x) ->
where
setup = do
let !tex = S.precompute
- !int = parse_int256 $ B16.decodeLenient
+ !int = parse_int256 $ decodeLenient
"7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"
pure (tex, int)
@@ -125,7 +130,7 @@ schnorr = env setup $ \ ~(tex, big) ->
where
setup = do
let !tex = S.precompute
- !int = parse_int256 $ B16.decodeLenient
+ !int = parse_int256 $ decodeLenient
"7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"
pure (tex, int)
@@ -142,7 +147,7 @@ ecdsa = env setup $ \ ~(tex, big, pub, msg, sig) ->
where
setup = do
let !tex = S.precompute
- big = parse_int256 $ B16.decodeLenient
+ big = parse_int256 $ decodeLenient
"7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"
Just pub = S.derive_pub big
msg = "i approve of this message"
@@ -159,12 +164,12 @@ ecdh = env setup $ \ ~(big, pub) ->
setup = do
let !big =
0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed
- !(Just !pub) = S.parse_point . B16.decodeLenient $
+ !(Just !pub) = S.parse_point . decodeLenient $
"bd02b9dfc8ef760708950bd972f2dc244893b61b6b46c3b19be1b2da7b034ac5"
pure (big, pub)
p_bs :: BS.ByteString
-p_bs = B16.decodeLenient
+p_bs = decodeLenient
"0279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798"
p :: S.Projective
@@ -173,7 +178,7 @@ p = case S.parse_point p_bs of
Just !pt -> pt
q_bs :: BS.ByteString
-q_bs = B16.decodeLenient
+q_bs = decodeLenient
"02f9308a019258c31049344f85f89d5229b531c845836f99b08601f113bce036f9"
q :: S.Projective
@@ -182,7 +187,7 @@ q = case S.parse_point q_bs of
Just !pt -> pt
r_bs :: BS.ByteString
-r_bs = B16.decodeLenient
+r_bs = decodeLenient
"03a2113cf152585d96791a42cdd78782757fbfb5c6b2c11b59857eb4f7fda0b0e8"
r :: S.Projective
@@ -191,7 +196,7 @@ r = case S.parse_point r_bs of
Just !pt -> pt
s_bs :: BS.ByteString
-s_bs = B16.decodeLenient
+s_bs = decodeLenient
"0306413898a49c93cccf3db6e9078c1b6a8e62568e4a4770e0d7d96792d1c580ad"
s :: S.Projective
@@ -200,7 +205,7 @@ s = case S.parse_point s_bs of
Just !pt -> pt
t_bs :: BS.ByteString
-t_bs = B16.decodeLenient "04b838ff44e5bc177bf21189d0766082fc9d843226887fc9760371100b7ee20a6ff0c9d75bfba7b31a6bca1974496eeb56de357071955d83c4b1badaa0b21832e9"
+t_bs = decodeLenient "04b838ff44e5bc177bf21189d0766082fc9d843226887fc9760371100b7ee20a6ff0c9d75bfba7b31a6bca1974496eeb56de357071955d83c4b1badaa0b21832e9"
t :: S.Projective
t = case S.parse_point t_bs of
@@ -208,14 +213,14 @@ t = case S.parse_point t_bs of
Just !pt -> pt
s_sk :: Integer
-s_sk = parse_int256 . B16.decodeLenient $
+s_sk = parse_int256 . decodeLenient $
"B7E151628AED2A6ABF7158809CF4F3C762E7160F38B4DA56A784D9045190CFEF"
s_sig :: BS.ByteString
-s_sig = B16.decodeLenient "6896BD60EEAE296DB48A229FF71DFE071BDE413E6D43F917DC8DCF8C78DE33418906D11AC976ABCCB20B091292BFF4EA897EFCB639EA871CFA95F6DE339E4B0A"
+s_sig = decodeLenient "6896BD60EEAE296DB48A229FF71DFE071BDE413E6D43F917DC8DCF8C78DE33418906D11AC976ABCCB20B091292BFF4EA897EFCB639EA871CFA95F6DE339E4B0A"
s_pk_raw :: BS.ByteString
-s_pk_raw = B16.decodeLenient
+s_pk_raw = decodeLenient
"DFF1D77F2A671C5F36183726DB2341BE58FEAE1DA2DECED843240F7B502BA659"
s_pk :: S.Projective
@@ -224,13 +229,13 @@ s_pk = case S.parse_point s_pk_raw of
Just !pt -> pt
s_msg :: BS.ByteString
-s_msg = B16.decodeLenient
+s_msg = decodeLenient
"243F6A8885A308D313198A2E03707344A4093822299F31D0082EFA98EC4E6C89"
s_aux :: BS.ByteString
-s_aux = B16.decodeLenient
+s_aux = decodeLenient
"0000000000000000000000000000000000000000000000000000000000000001"
--- e_msg = B16.decodeLenient "313233343030"
--- e_sig = B16.decodeLenient "3045022100813ef79ccefa9a56f7ba805f0e478584fe5f0dd5f567bc09b5123ccbc983236502206ff18a52dcc0336f7af62400a6dd9b810732baf1ff758000d6f613a556eb31ba"
+-- e_msg = decodeLenient "313233343030"
+-- e_sig = decodeLenient "3045022100813ef79ccefa9a56f7ba805f0e478584fe5f0dd5f567bc09b5123ccbc983236502206ff18a52dcc0336f7af62400a6dd9b810732baf1ff758000d6f613a556eb31ba"
diff --git a/bench/Weight.hs b/bench/Weight.hs
@@ -15,6 +15,11 @@ instance NFData S.Affine
instance NFData S.ECDSA
instance NFData S.Context
+decodeLenient :: BS.ByteString -> BS.ByteString
+decodeLenient bs = case B16.decode bs of
+ Nothing -> error "bang"
+ Just b -> b
+
parse_int :: BS.ByteString -> Integer
parse_int bs = case S.parse_int256 bs of
Nothing -> error "bang"
@@ -109,18 +114,18 @@ ecdh = W.wgroup "ecdh" $ do
W.func "ecdh (large)" (S.ecdh pub) b
where
b = 0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed
- Just pub = S.parse_point . B16.decodeLenient $
+ Just pub = S.parse_point . decodeLenient $
"bd02b9dfc8ef760708950bd972f2dc244893b61b6b46c3b19be1b2da7b034ac5"
s_sk :: Integer
-s_sk = parse_int . B16.decodeLenient $
+s_sk = parse_int . decodeLenient $
"B7E151628AED2A6ABF7158809CF4F3C762E7160F38B4DA56A784D9045190CFEF"
s_sig :: BS.ByteString
-s_sig = B16.decodeLenient "6896BD60EEAE296DB48A229FF71DFE071BDE413E6D43F917DC8DCF8C78DE33418906D11AC976ABCCB20B091292BFF4EA897EFCB639EA871CFA95F6DE339E4B0A"
+s_sig = decodeLenient "6896BD60EEAE296DB48A229FF71DFE071BDE413E6D43F917DC8DCF8C78DE33418906D11AC976ABCCB20B091292BFF4EA897EFCB639EA871CFA95F6DE339E4B0A"
s_pk_raw :: BS.ByteString
-s_pk_raw = B16.decodeLenient
+s_pk_raw = decodeLenient
"DFF1D77F2A671C5F36183726DB2341BE58FEAE1DA2DECED843240F7B502BA659"
s_pk :: S.Projective
@@ -129,15 +134,15 @@ s_pk = case S.parse_point s_pk_raw of
Just !pt -> pt
s_msg :: BS.ByteString
-s_msg = B16.decodeLenient
+s_msg = decodeLenient
"243F6A8885A308D313198A2E03707344A4093822299F31D0082EFA98EC4E6C89"
s_aux :: BS.ByteString
-s_aux = B16.decodeLenient
+s_aux = decodeLenient
"0000000000000000000000000000000000000000000000000000000000000001"
p_bs :: BS.ByteString
-p_bs = B16.decodeLenient
+p_bs = decodeLenient
"0279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798"
p :: S.Projective
@@ -146,7 +151,7 @@ p = case S.parse_point p_bs of
Just !pt -> pt
q_bs :: BS.ByteString
-q_bs = B16.decodeLenient
+q_bs = decodeLenient
"02f9308a019258c31049344f85f89d5229b531c845836f99b08601f113bce036f9"
q :: S.Projective
@@ -155,7 +160,7 @@ q = case S.parse_point q_bs of
Just !pt -> pt
r_bs :: BS.ByteString
-r_bs = B16.decodeLenient
+r_bs = decodeLenient
"03a2113cf152585d96791a42cdd78782757fbfb5c6b2c11b59857eb4f7fda0b0e8"
r :: S.Projective
@@ -164,7 +169,7 @@ r = case S.parse_point r_bs of
Just !pt -> pt
s_bs :: BS.ByteString
-s_bs = B16.decodeLenient
+s_bs = decodeLenient
"0306413898a49c93cccf3db6e9078c1b6a8e62568e4a4770e0d7d96792d1c580ad"
s :: S.Projective
diff --git a/flake.lock b/flake.lock
@@ -34,6 +34,37 @@
"type": "github"
}
},
+ "ppad-base16": {
+ "inputs": {
+ "flake-utils": [
+ "ppad-base16",
+ "ppad-nixpkgs",
+ "flake-utils"
+ ],
+ "nixpkgs": [
+ "ppad-base16",
+ "ppad-nixpkgs",
+ "nixpkgs"
+ ],
+ "ppad-nixpkgs": [
+ "ppad-nixpkgs"
+ ]
+ },
+ "locked": {
+ "lastModified": 1741625558,
+ "narHash": "sha256-ZBDXRD5fsVqA5bGrAlcnhiu67Eo50q0M9614nR3NBwY=",
+ "ref": "master",
+ "rev": "fb63457f2e894eda28250dfe65d0fcd1d195ac2f",
+ "revCount": 24,
+ "type": "git",
+ "url": "git://git.ppad.tech/base16.git"
+ },
+ "original": {
+ "ref": "master",
+ "type": "git",
+ "url": "git://git.ppad.tech/base16.git"
+ }
+ },
"ppad-hmac-drbg": {
"inputs": {
"flake-utils": [
@@ -163,6 +194,7 @@
"ppad-nixpkgs",
"nixpkgs"
],
+ "ppad-base16": "ppad-base16",
"ppad-hmac-drbg": "ppad-hmac-drbg",
"ppad-nixpkgs": "ppad-nixpkgs",
"ppad-sha256": "ppad-sha256",
diff --git a/flake.nix b/flake.nix
@@ -7,6 +7,12 @@
url = "git://git.ppad.tech/nixpkgs.git";
ref = "master";
};
+ ppad-base16 = {
+ type = "git";
+ url = "git://git.ppad.tech/base16.git";
+ ref = "master";
+ inputs.ppad-nixpkgs.follows = "ppad-nixpkgs";
+ };
ppad-sha256 = {
type = "git";
url = "git://git.ppad.tech/sha256.git";
@@ -32,6 +38,7 @@
};
outputs = { self, nixpkgs, flake-utils, ppad-nixpkgs
+ , ppad-base16
, ppad-sha256, ppad-sha512
, ppad-hmac-drbg
}:
@@ -42,13 +49,16 @@
pkgs = import nixpkgs { inherit system; };
hlib = pkgs.haskell.lib;
+ base16 = ppad-base16.packages.${system}.default;
sha256 = ppad-sha256.packages.${system}.default;
hmac-drbg = ppad-hmac-drbg.packages.${system}.default;
hpkgs = pkgs.haskell.packages.ghc981.extend (new: old: {
+ ppad-base16 = base16;
ppad-sha256 = sha256;
ppad-hmac-drbg = hmac-drbg;
${lib} = new.callCabal2nix lib ./. {
+ ppad-base16 = new.ppad-base16;
ppad-sha256 = new.ppad-sha256;
ppad-hmac-drbg = new.ppad-hmac-drbg;
};
diff --git a/ppad-secp256k1.cabal b/ppad-secp256k1.cabal
@@ -51,8 +51,8 @@ test-suite secp256k1-tests
aeson
, attoparsec
, base
- , base16-bytestring
, bytestring
+ , ppad-base16
, ppad-secp256k1
, ppad-sha256
, tasty
@@ -70,10 +70,10 @@ benchmark secp256k1-bench
build-depends:
base
- , base16-bytestring
, bytestring
, criterion
, deepseq
+ , ppad-base16
, ppad-secp256k1
benchmark secp256k1-weigh
@@ -87,9 +87,9 @@ benchmark secp256k1-weigh
build-depends:
base
- , base16-bytestring
, bytestring
, deepseq
+ , ppad-base16
, ppad-secp256k1
, weigh
diff --git a/test/BIP340.hs b/test/BIP340.hs
@@ -19,6 +19,11 @@ 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 #-}
@@ -40,7 +45,7 @@ data Case = Case {
execute :: Context -> Case -> TestTree
execute tex Case {..} = testCase ("bip0340 " <> show c_index) $
- case parse_point (B16.decodeLenient c_pk) of
+ case parse_point (decodeLenient c_pk) of
Nothing -> assertBool mempty (not c_res)
Just pk -> do
if c_sk == mempty
@@ -80,15 +85,15 @@ test_case :: AT.Parser Case
test_case = do
c_index <- AT.decimal AT.<?> "index"
_ <- AT.char ','
- c_sk <- fmap B16.decodeLenient (AT.takeWhile (/= ',') AT.<?> "sk")
+ c_sk <- fmap decodeLenient (AT.takeWhile (/= ',') AT.<?> "sk")
_ <- AT.char ','
c_pk <- AT.takeWhile1 (/= ',') AT.<?> "pk"
_ <- AT.char ','
- c_aux <- fmap B16.decodeLenient (AT.takeWhile (/= ',') AT.<?> "aux")
+ c_aux <- fmap decodeLenient (AT.takeWhile (/= ',') AT.<?> "aux")
_ <- AT.char ','
- c_msg <- fmap B16.decodeLenient (AT.takeWhile (/= ',') AT.<?> "msg")
+ c_msg <- fmap decodeLenient (AT.takeWhile (/= ',') AT.<?> "msg")
_ <- AT.char ','
- c_sig <- fmap B16.decodeLenient (AT.takeWhile1 (/= ',') AT.<?> "sig")
+ c_sig <- fmap decodeLenient (AT.takeWhile1 (/= ',') AT.<?> "sig")
_ <- AT.char ','
c_res <- (AT.string "TRUE" *> pure True) <|> (AT.string "FALSE" *> pure False)
AT.<?> "res"
diff --git a/test/Main.hs b/test/Main.hs
@@ -21,6 +21,11 @@ fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
{-# INLINE fi #-}
+decodeLenient :: BS.ByteString -> BS.ByteString
+decodeLenient bs = case B16.decode bs of
+ Nothing -> error "bang"
+ Just b -> b
+
main :: IO ()
main = do
wp_ecdsa_sha256 <- TIO.readFile "etc/ecdsa_secp256k1_sha256_test.json"
@@ -89,19 +94,19 @@ render = filter (`notElem` ("\"" :: String)) . show
parse_point_test_p :: TestTree
parse_point_test_p = testCase (render p_hex) $
- case parse_point (B16.decodeLenient p_hex) of
+ case parse_point (decodeLenient p_hex) of
Nothing -> assertFailure "bad parse"
Just p -> assertEqual mempty p_pro p
parse_point_test_q :: TestTree
parse_point_test_q = testCase (render q_hex) $
- case parse_point (B16.decodeLenient q_hex) of
+ case parse_point (decodeLenient q_hex) of
Nothing -> assertFailure "bad parse"
Just q -> assertEqual mempty q_pro q
parse_point_test_r :: TestTree
parse_point_test_r = testCase (render r_hex) $
- case parse_point (B16.decodeLenient r_hex) of
+ case parse_point (decodeLenient r_hex) of
Nothing -> assertFailure "bad parse"
Just r -> assertEqual mempty r_pro r
diff --git a/test/Noble.hs b/test/Noble.hs
@@ -21,6 +21,11 @@ import qualified GHC.Num.Integer as I
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (assertEqual, assertBool, assertFailure, testCase)
+decodeLenient :: BS.ByteString -> BS.ByteString
+decodeLenient bs = case B16.decode bs of
+ Nothing -> error "bang"
+ Just b -> b
+
data Ecdsa = Ecdsa {
ec_valid :: ![(Int, ValidTest)]
, ec_invalid :: !InvalidTest
@@ -63,7 +68,7 @@ execute_invalid_sign tex (label, InvalidSignTest {..}) =
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
+ case parse_point (decodeLenient ivv_Q) of
Nothing -> assertBool "no parse" True
Just pub -> do
let sig = parse_compact ivv_signature
@@ -78,7 +83,7 @@ fi = fromIntegral
-- parser helper
toBS :: T.Text -> BS.ByteString
-toBS = B16.decodeLenient . TE.encodeUtf8
+toBS = decodeLenient . TE.encodeUtf8
-- parser helper
toSecKey :: T.Text -> Integer
diff --git a/test/Wycheproof.hs b/test/Wycheproof.hs
@@ -21,6 +21,11 @@ import qualified GHC.Num.Integer as I
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (assertBool, testCase)
+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 #-}
@@ -39,7 +44,7 @@ execute_group tex ty EcdsaTestGroup {..} =
execute :: Context -> SigType -> Projective -> EcdsaVerifyTest -> TestTree
execute tex ty pub EcdsaVerifyTest {..} = testCase report $ do
- let msg = B16.decodeLenient (TE.encodeUtf8 t_msg)
+ let msg = decodeLenient (TE.encodeUtf8 t_msg)
sig = toEcdsa t_sig
case sig of
Left _ -> assertBool mempty (t_result == "invalid")
@@ -136,7 +141,7 @@ data PublicKey = PublicKey {
} deriving Show
toProjective :: T.Text -> Projective
-toProjective (B16.decodeLenient . TE.encodeUtf8 -> bs) = case parse_point bs of
+toProjective (decodeLenient . TE.encodeUtf8 -> bs) = case parse_point bs of
Nothing -> error "wycheproof: couldn't parse pubkey"
Just p -> p
@@ -148,7 +153,7 @@ instance A.FromJSON PublicKey where
<*> fmap toProjective (m .: "uncompressed")
toEcdsa :: T.Text -> Either String ECDSA
-toEcdsa (B16.decodeLenient . TE.encodeUtf8 -> bs) =
+toEcdsa (decodeLenient . TE.encodeUtf8 -> bs) =
AT.parseOnly parse_der_sig bs
data EcdsaVerifyTest = EcdsaVerifyTest {
diff --git a/test/WycheproofEcdh.hs b/test/WycheproofEcdh.hs
@@ -21,6 +21,11 @@ import qualified Data.Text.Encoding as TE
import Test.Tasty (TestTree, testGroup)
import qualified Test.Tasty.HUnit as H (assertBool, assertEqual, testCase)
+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 #-}
@@ -129,11 +134,11 @@ parse_der_subjectpubkey = do
Just pt -> pure pt
der_to_pub :: T.Text -> Either String Projective
-der_to_pub (B16.decodeLenient . TE.encodeUtf8 -> bs) =
+der_to_pub (decodeLenient . TE.encodeUtf8 -> bs) =
AT.parseOnly parse_der_pub bs
parse_bigint :: T.Text -> Integer
-parse_bigint (B16.decodeLenient . TE.encodeUtf8 -> bs) = roll bs where
+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
