commit 4ecf9d76f5798d5f943c60e8fd1697988bc44549
parent dc56efbecf8a78413c32234f1d6926d4fdca5f60
Author: Jared Tobin <jared@jtobin.io>
Date: Sun, 21 Dec 2025 19:47:58 -0330
lib: update for secp256k1 v0.5
Diffstat:
6 files changed, 201 insertions(+), 58 deletions(-)
diff --git a/README.md b/README.md
@@ -45,43 +45,43 @@ Haddocks (API documentation, etc.) are hosted at
## Performance
-The aim is best-in-class performance for pure, highly-auditable Haskell
-code. Most time is spent on elliptic curve multiplication or hashing;
-strict BIP32 functionality is only a small layer on top of that.
+The aim is best-in-class performance for pure Haskell code. Most time
+is spent on elliptic curve multiplication or hashing; strict BIP32
+functionality is only a small layer on top of that.
Current benchmark figures on an M4 Silicon MacBook Air look like (use
`cabal bench` to run the benchmark suite):
```
benchmarking ppad-bip32/derive_child_pub
- time 2.668 ms (2.663 ms .. 2.672 ms)
+ time 426.1 μs (425.1 μs .. 427.1 μs)
1.000 R² (1.000 R² .. 1.000 R²)
- mean 2.661 ms (2.658 ms .. 2.664 ms)
- std dev 8.440 μs (6.211 μs .. 13.00 μs)
+ mean 424.5 μs (423.9 μs .. 425.4 μs)
+ std dev 2.450 μs (1.972 μs .. 3.001 μs)
benchmarking ppad-bip32/derive_child_priv
- time 1.784 ms (1.783 ms .. 1.785 ms)
+ time 291.2 μs (290.5 μs .. 291.7 μs)
1.000 R² (1.000 R² .. 1.000 R²)
- mean 1.781 ms (1.780 ms .. 1.782 ms)
- std dev 2.300 μs (1.939 μs .. 2.835 μs)
+ mean 290.4 μs (289.9 μs .. 290.8 μs)
+ std dev 1.595 μs (1.411 μs .. 1.876 μs)
benchmarking ppad-bip32/xpub
- time 901.1 μs (900.0 μs .. 902.3 μs)
+ time 151.4 μs (151.2 μs .. 151.6 μs)
1.000 R² (1.000 R² .. 1.000 R²)
- mean 900.3 μs (899.7 μs .. 901.7 μs)
- std dev 3.053 μs (1.724 μs .. 5.362 μs)
+ mean 151.1 μs (150.9 μs .. 151.3 μs)
+ std dev 608.5 ns (449.2 ns .. 919.9 ns)
benchmarking ppad-bip32/xprv
- time 8.665 μs (8.656 μs .. 8.673 μs)
+ time 8.374 μs (8.363 μs .. 8.386 μs)
1.000 R² (1.000 R² .. 1.000 R²)
- mean 8.667 μs (8.663 μs .. 8.670 μs)
- std dev 12.75 ns (9.805 ns .. 17.26 ns)
+ mean 8.390 μs (8.379 μs .. 8.409 μs)
+ std dev 47.10 ns (31.45 ns .. 76.90 ns)
benchmarking ppad-bip32/parse
- time 9.295 μs (9.273 μs .. 9.330 μs)
+ time 8.576 μs (8.573 μs .. 8.580 μs)
1.000 R² (1.000 R² .. 1.000 R²)
- mean 9.294 μs (9.288 μs .. 9.308 μs)
- std dev 27.58 ns (11.06 ns .. 55.76 ns)
+ mean 8.567 μs (8.559 μs .. 8.574 μs)
+ std dev 25.37 ns (21.07 ns .. 30.30 ns)
```
## Security
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -11,9 +11,10 @@ import Crypto.HDKey.BIP32
import Control.DeepSeq
import Crypto.Curve.Secp256k1 as S
import qualified Data.Maybe as M
+import qualified Data.Word.Wider as W
instance NFData S.Projective
-instance NFData (X Integer)
+instance NFData (X W.Wider)
instance NFData (X S.Projective)
instance NFData XPub
instance NFData XPrv
diff --git a/flake.lock b/flake.lock
@@ -142,19 +142,16 @@
"ppad-fixed": {
"inputs": {
"flake-utils": [
- "ppad-secp256k1",
"ppad-fixed",
"ppad-nixpkgs",
"flake-utils"
],
"nixpkgs": [
- "ppad-secp256k1",
"ppad-fixed",
"ppad-nixpkgs",
"nixpkgs"
],
"ppad-nixpkgs": [
- "ppad-secp256k1",
"ppad-nixpkgs"
]
},
@@ -285,7 +282,9 @@
"ppad-base16": [
"ppad-base16"
],
- "ppad-fixed": "ppad-fixed",
+ "ppad-fixed": [
+ "ppad-fixed"
+ ],
"ppad-hmac-drbg": "ppad-hmac-drbg",
"ppad-nixpkgs": [
"ppad-nixpkgs"
@@ -392,6 +391,7 @@
],
"ppad-base16": "ppad-base16",
"ppad-base58": "ppad-base58",
+ "ppad-fixed": "ppad-fixed",
"ppad-nixpkgs": "ppad-nixpkgs",
"ppad-ripemd160": "ppad-ripemd160",
"ppad-secp256k1": "ppad-secp256k1",
diff --git a/flake.nix b/flake.nix
@@ -21,6 +21,12 @@
inputs.ppad-base16.follows = "ppad-base16";
inputs.ppad-sha256.follows = "ppad-sha256";
};
+ ppad-fixed = {
+ type = "git";
+ url = "git://git.ppad.tech/fixed.git";
+ ref = "master";
+ inputs.ppad-nixpkgs.follows = "ppad-nixpkgs";
+ };
ppad-sha256 = {
type = "git";
url = "git://git.ppad.tech/sha256.git";
@@ -48,6 +54,7 @@
ref = "master";
inputs.ppad-nixpkgs.follows = "ppad-nixpkgs";
inputs.ppad-base16.follows = "ppad-base16";
+ inputs.ppad-fixed.follows = "ppad-fixed";
inputs.ppad-sha256.follows = "ppad-sha256";
inputs.ppad-sha512.follows = "ppad-sha512";
};
@@ -56,6 +63,7 @@
};
outputs = { self, nixpkgs, flake-utils, ppad-nixpkgs
+ , ppad-fixed
, ppad-sha256, ppad-sha512, ppad-ripemd160
, ppad-base16, ppad-base58
, ppad-secp256k1 }:
@@ -65,15 +73,29 @@
pkgs = import nixpkgs { inherit system; };
hlib = pkgs.haskell.lib;
+ llvm = pkgs.llvmPackages_15.llvm;
+
+ fixed = ppad-fixed.packages.${system}.default;
+ fixed-llvm =
+ hlib.addBuildTools
+ (hlib.enableCabalFlag fixed "llvm")
+ [ llvm ];
+
+ secp256k1 = ppad-secp256k1.packages.${system}.default;
+ secp256k1-llvm =
+ hlib.addBuildTools
+ (hlib.enableCabalFlag secp256k1 "llvm")
+ [ llvm ];
hpkgs = pkgs.haskell.packages.ghc981.extend (new: old: {
${lib} = old.callCabal2nixWithOptions lib ./. "--enable-profiling" {};
ppad-sha256 = ppad-sha256.packages.${system}.default;
ppad-sha512 = ppad-sha512.packages.${system}.default;
ppad-ripemd160 = ppad-ripemd160.packages.${system}.default;
+ ppad-fixed = fixed-llvm;
ppad-base16 = ppad-base16.packages.${system}.default;
ppad-base58 = ppad-base58.packages.${system}.default;
- ppad-secp256k1 = ppad-secp256k1.packages.${system}.default;
+ ppad-secp256k1 = secp256k1-llvm;
});
cc = pkgs.stdenv.cc;
@@ -91,6 +113,7 @@
buildInputs = [
cabal
cc
+ llvm
];
doBenchmark = true;
@@ -101,6 +124,7 @@
echo "cc: $(${cc}/bin/cc --version)"
echo "ghc: $(${ghc}/bin/ghc --version)"
echo "cabal: $(${cabal}/bin/cabal --version)"
+ echo "llc: $(${llvm}/bin/llc --version | head -2 | tail -1)"
'';
};
}
diff --git a/lib/Crypto/HDKey/BIP32.hs b/lib/Crypto/HDKey/BIP32.hs
@@ -3,9 +3,11 @@
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MagicHash #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE ViewPatterns #-}
-- |
@@ -59,14 +61,103 @@ import qualified Crypto.Hash.SHA256 as SHA256
import qualified Crypto.Hash.SHA512 as SHA512
import qualified Crypto.Hash.RIPEMD160 as RIPEMD160
import qualified Crypto.Curve.Secp256k1 as Secp256k1
-import Data.Bits ((.<<.), (.>>.), (.|.), (.&.))
+import Data.Bits ((.>>.), (.&.))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Base58Check as B58C
import qualified Data.ByteString.Builder as BSB
import qualified Data.ByteString.Internal as BI
+import qualified Data.ByteString.Unsafe as BU
import Data.Word (Word8, Word32)
+import Data.Word.Limb (Limb(..))
+import qualified Data.Word.Limb as L
+import Data.Word.Wider (Wider(..))
+import qualified Foreign.Storable as Storable (pokeByteOff)
+import qualified GHC.Exts as Exts
import GHC.Generics
+import qualified GHC.Word (Word8(..))
+import qualified Numeric.Montgomery.Secp256k1.Scalar as S
+
+-- parsing utilities ----------------------------------------------------------
+
+-- convert a Word8 to a Limb
+limb :: Word8 -> Limb
+limb (GHC.Word.W8# (Exts.word8ToWord# -> w)) = Limb w
+{-# INLINABLE limb #-}
+
+-- convert a Limb to a Word8
+word8 :: Limb -> Word8
+word8 (Limb w) = GHC.Word.W8# (Exts.wordToWord8# w)
+{-# INLINABLE word8 #-}
+
+-- unsafely extract the first 64-bit word from a big-endian-encoded bytestring
+unsafe_word0 :: BS.ByteString -> Limb
+unsafe_word0 bs =
+ (limb (BU.unsafeIndex bs 00) `L.shl#` 56#)
+ `L.or#` (limb (BU.unsafeIndex bs 01) `L.shl#` 48#)
+ `L.or#` (limb (BU.unsafeIndex bs 02) `L.shl#` 40#)
+ `L.or#` (limb (BU.unsafeIndex bs 03) `L.shl#` 32#)
+ `L.or#` (limb (BU.unsafeIndex bs 04) `L.shl#` 24#)
+ `L.or#` (limb (BU.unsafeIndex bs 05) `L.shl#` 16#)
+ `L.or#` (limb (BU.unsafeIndex bs 06) `L.shl#` 08#)
+ `L.or#` (limb (BU.unsafeIndex bs 07))
+{-# INLINABLE unsafe_word0 #-}
+
+-- unsafely extract the second 64-bit word from a big-endian-encoded bytestring
+unsafe_word1 :: BS.ByteString -> Limb
+unsafe_word1 bs =
+ (limb (BU.unsafeIndex bs 08) `L.shl#` 56#)
+ `L.or#` (limb (BU.unsafeIndex bs 09) `L.shl#` 48#)
+ `L.or#` (limb (BU.unsafeIndex bs 10) `L.shl#` 40#)
+ `L.or#` (limb (BU.unsafeIndex bs 11) `L.shl#` 32#)
+ `L.or#` (limb (BU.unsafeIndex bs 12) `L.shl#` 24#)
+ `L.or#` (limb (BU.unsafeIndex bs 13) `L.shl#` 16#)
+ `L.or#` (limb (BU.unsafeIndex bs 14) `L.shl#` 08#)
+ `L.or#` (limb (BU.unsafeIndex bs 15))
+{-# INLINABLE unsafe_word1 #-}
+
+-- unsafely extract the third 64-bit word from a big-endian-encoded bytestring
+unsafe_word2 :: BS.ByteString -> Limb
+unsafe_word2 bs =
+ (limb (BU.unsafeIndex bs 16) `L.shl#` 56#)
+ `L.or#` (limb (BU.unsafeIndex bs 17) `L.shl#` 48#)
+ `L.or#` (limb (BU.unsafeIndex bs 18) `L.shl#` 40#)
+ `L.or#` (limb (BU.unsafeIndex bs 19) `L.shl#` 32#)
+ `L.or#` (limb (BU.unsafeIndex bs 20) `L.shl#` 24#)
+ `L.or#` (limb (BU.unsafeIndex bs 21) `L.shl#` 16#)
+ `L.or#` (limb (BU.unsafeIndex bs 22) `L.shl#` 08#)
+ `L.or#` (limb (BU.unsafeIndex bs 23))
+{-# INLINABLE unsafe_word2 #-}
+
+-- unsafely extract the fourth 64-bit word from a big-endian-encoded bytestring
+unsafe_word3 :: BS.ByteString -> Limb
+unsafe_word3 bs =
+ (limb (BU.unsafeIndex bs 24) `L.shl#` 56#)
+ `L.or#` (limb (BU.unsafeIndex bs 25) `L.shl#` 48#)
+ `L.or#` (limb (BU.unsafeIndex bs 26) `L.shl#` 40#)
+ `L.or#` (limb (BU.unsafeIndex bs 27) `L.shl#` 32#)
+ `L.or#` (limb (BU.unsafeIndex bs 28) `L.shl#` 24#)
+ `L.or#` (limb (BU.unsafeIndex bs 29) `L.shl#` 16#)
+ `L.or#` (limb (BU.unsafeIndex bs 30) `L.shl#` 08#)
+ `L.or#` (limb (BU.unsafeIndex bs 31))
+{-# INLINABLE unsafe_word3 #-}
+
+-- 256-bit big-endian bytestring decoding. the input size is not checked!
+unsafe_roll32 :: BS.ByteString -> Wider
+unsafe_roll32 bs =
+ let !w0 = unsafe_word0 bs
+ !w1 = unsafe_word1 bs
+ !w2 = unsafe_word2 bs
+ !w3 = unsafe_word3 bs
+ in Wider (# w3, w2, w1, w0 #)
+{-# INLINABLE unsafe_roll32 #-}
+
+-- convert a Limb to a Word8 after right-shifting
+word8s :: Limb -> Exts.Int# -> Word8
+word8s l s =
+ let !(Limb w) = L.shr# l s
+ in GHC.Word.W8# (Exts.wordToWord8# w)
+{-# INLINABLE word8s #-}
-- utilities ------------------------------------------------------------------
@@ -74,29 +165,47 @@ fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
{-# INLINE fi #-}
--- big-endian bytestring encoding
-unroll :: Integer -> BS.ByteString
-unroll i = case i of
- 0 -> BS.singleton 0
- _ -> BS.reverse $ BS.unfoldr coalg i
- where
- coalg 0 = Nothing
- coalg m = Just (fi m, m .>>. 8)
-
--- parse 32 bytes to a 256-bit integer
-parse256 :: BS.ByteString -> Integer
-parse256 bs@(BI.PS _ _ l)
- | l == 32 = BS.foldl' alg 0 bs
- | otherwise = error "ppad-bip32 (parse256): internal error"
- where
- alg !a (fi -> !b) = (a .<<. 8) .|. b
-
--- serialize a 256-bit integer to 32 bytes, left-padding with zeros if
--- necessary. the size of the integer is not checked.
-ser256 :: Integer -> BS.ByteString
-ser256 (unroll -> u@(BI.PS _ _ l))
- | l < 32 = BS.replicate (32 - l) 0 <> u
- | otherwise = u
+-- 256-bit big-endian bytestring encoding
+unroll32 :: Wider -> BS.ByteString
+unroll32 (Wider (# w0, w1, w2, w3 #)) =
+ BI.unsafeCreate 32 $ \ptr -> do
+ -- w0
+ Storable.pokeByteOff ptr 00 (word8s w3 56#)
+ Storable.pokeByteOff ptr 01 (word8s w3 48#)
+ Storable.pokeByteOff ptr 02 (word8s w3 40#)
+ Storable.pokeByteOff ptr 03 (word8s w3 32#)
+ Storable.pokeByteOff ptr 04 (word8s w3 24#)
+ Storable.pokeByteOff ptr 05 (word8s w3 16#)
+ Storable.pokeByteOff ptr 06 (word8s w3 08#)
+ Storable.pokeByteOff ptr 07 (word8 w3)
+ -- w1
+ Storable.pokeByteOff ptr 08 (word8s w2 56#)
+ Storable.pokeByteOff ptr 09 (word8s w2 48#)
+ Storable.pokeByteOff ptr 10 (word8s w2 40#)
+ Storable.pokeByteOff ptr 11 (word8s w2 32#)
+ Storable.pokeByteOff ptr 12 (word8s w2 24#)
+ Storable.pokeByteOff ptr 13 (word8s w2 16#)
+ Storable.pokeByteOff ptr 14 (word8s w2 08#)
+ Storable.pokeByteOff ptr 15 (word8 w2)
+ -- w2
+ Storable.pokeByteOff ptr 16 (word8s w1 56#)
+ Storable.pokeByteOff ptr 17 (word8s w1 48#)
+ Storable.pokeByteOff ptr 18 (word8s w1 40#)
+ Storable.pokeByteOff ptr 19 (word8s w1 32#)
+ Storable.pokeByteOff ptr 20 (word8s w1 24#)
+ Storable.pokeByteOff ptr 21 (word8s w1 16#)
+ Storable.pokeByteOff ptr 22 (word8s w1 08#)
+ Storable.pokeByteOff ptr 23 (word8 w1)
+ -- w3
+ Storable.pokeByteOff ptr 24 (word8s w0 56#)
+ Storable.pokeByteOff ptr 25 (word8s w0 48#)
+ Storable.pokeByteOff ptr 26 (word8s w0 40#)
+ Storable.pokeByteOff ptr 27 (word8s w0 32#)
+ Storable.pokeByteOff ptr 28 (word8s w0 24#)
+ Storable.pokeByteOff ptr 29 (word8s w0 16#)
+ Storable.pokeByteOff ptr 30 (word8s w0 08#)
+ Storable.pokeByteOff ptr 31 (word8 w0)
+{-# INLINABLE unroll32 #-}
-- serialize a 32-bit word, MSB first
ser32 :: Word32 -> BS.ByteString
@@ -123,11 +232,11 @@ xpub_cod :: XPub -> BS.ByteString
xpub_cod (XPub (X _ cod)) = cod
-- | An extended private key.
-newtype XPrv = XPrv (X Integer)
+newtype XPrv = XPrv (X Wider)
deriving (Eq, Show, Generic)
-- | Read the raw private key from an 'XPrv'.
-xprv_key :: XPrv -> Integer
+xprv_key :: XPrv -> Wider
xprv_key (XPrv (X sec _)) = sec
-- | Read the raw chain code from an 'XPrv'.
@@ -184,7 +293,7 @@ _master seed@(BI.PS _ _ l)
| otherwise = do
let i = SHA512.hmac "Bitcoin seed" seed
(il, c) = BS.splitAt 32 i
- s = parse256 il -- safe due to 512-bit hmac
+ s = unsafe_roll32 il -- safe due to 512-bit hmac
pure $! (XPrv (X s c))
-- private parent key -> private child key
@@ -192,13 +301,13 @@ ckd_priv :: XPrv -> Word32 -> XPrv
ckd_priv _xprv@(XPrv (X sec cod)) i =
let l = SHA512.hmac cod dat
(il, ci) = BS.splitAt 32 l
- pil = parse256 il -- safe due to 512-bit hmac
- ki = Secp256k1.modQ (pil + sec)
+ pil = unsafe_roll32 il -- safe due to 512-bit hmac
+ ki = S.from (S.to pil + S.to sec)
in if pil >= Secp256k1._CURVE_Q || ki == 0 -- negl
then ckd_priv _xprv (succ i)
else XPrv (X ki ci)
where
- dat | hardened i = BS.singleton 0x00 <> ser256 sec <> ser32 i
+ dat | hardened i = BS.singleton 0x00 <> unroll32 sec <> ser32 i
| otherwise = case Secp256k1.mul Secp256k1._CURVE_G sec of
Nothing ->
error "ppad-bip32 (ckd_priv): internal error, evil extended key"
@@ -212,8 +321,8 @@ ckd_pub _xpub@(XPub (X pub cod)) i
let dat = Secp256k1.serialize_point pub <> ser32 i
l = SHA512.hmac cod dat
(il, ci) = BS.splitAt 32 l
- pil = parse256 il -- safe due to 512-bit hmac
- pt <- Secp256k1.mul_unsafe Secp256k1._CURVE_G pil
+ pil = unsafe_roll32 il -- safe due to 512-bit hmac
+ pt <- Secp256k1.mul_vartime Secp256k1._CURVE_G pil
let ki = pt `Secp256k1.add` pub
if pil >= Secp256k1._CURVE_Q || ki == Secp256k1._CURVE_ZERO -- negl
then ckd_pub _xpub (succ i)
@@ -457,7 +566,7 @@ _serialize version HDKey {..} =
Right (XPrv (X sec cod)) ->
BSB.byteString cod
<> BSB.word8 0x00
- <> BSB.byteString (ser256 sec)
+ <> BSB.byteString (unroll32 sec)
-- parsing --------------------------------------------------------------------
@@ -505,7 +614,7 @@ parse b58 = do
let hd_key = Left (XPub (X pub cod))
pure HDKey {..}
Prv -> do
- (b, parse256 -> prv) <- BS.uncons key -- safe due to guarded keylen
+ (b, unsafe_roll32 -> prv) <- BS.uncons key -- safe, guarded keylen
guard (b == 0)
guard (prv > 0 && prv < Secp256k1._CURVE_Q)
let hd_key = Right (XPrv (X prv cod))
diff --git a/ppad-bip32.cabal b/ppad-bip32.cabal
@@ -15,6 +15,11 @@ description:
hierarchical deterministic wallets and extended keys, with support for
serialization and parsing.
+flag llvm
+ description: Use GHC's LLVM backend.
+ default: False
+ manual: True
+
source-repository head
type: git
location: git.ppad.tech/bip32.git
@@ -24,12 +29,15 @@ library
hs-source-dirs: lib
ghc-options:
-Wall
+ if flag(llvm)
+ ghc-options: -fllvm -O2
exposed-modules:
Crypto.HDKey.BIP32
build-depends:
base >= 4.9 && < 5
, bytestring >= 0.9 && < 0.13
, ppad-base58 >= 0.2 && < 0.3
+ , ppad-fixed >= 0.1 && < 0.2
, ppad-ripemd160 >= 0.1.3 && < 0.2
, ppad-secp256k1 >= 0.5 && < 0.6
, ppad-sha256 >= 0.2.3 && < 0.3
@@ -70,5 +78,6 @@ benchmark bip32-bench
, criterion
, deepseq
, ppad-bip32
+ , ppad-fixed
, ppad-secp256k1
