diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,11 @@ # Changelog +- 0.3.0 (2025-12-21) + * Upgrades to ppad-secp256k1 v0.5, with significant performance + improvements as a result. + * Adds wNAF-enabled functions, suffixed by an apostrophe, which perform + about 2x faster than normal variants. + - 0.2.0 (2025-06-21) * The 'xprv' and 'tprv' functions are now total, returning 'Nothing' when derivation is impossible. diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -9,16 +9,21 @@ import Criterion.Main import Crypto.HDKey.BIP32 import Control.DeepSeq -import Crypto.Curve.Secp256k1 as S +import qualified 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 instance NFData HDKey +-- precomputed context for wNAF benchmarks +ctx :: Context +ctx = precompute + main :: IO () main = defaultMain [ bgroup "ppad-bip32" [ @@ -28,7 +33,11 @@ , bench_xpub , bench_xprv , bench_parse - ] + ] + , bgroup "ppad-bip32 (wNAF)" [ + bench_derive_pub_wnaf + , bench_derive_priv_wnaf + ] ] m :: HDKey @@ -53,4 +62,14 @@ bench_parse :: Benchmark bench_parse = bench "parse" $ nf parse (M.fromJust (xprv m)) + +-- wNAF variants + +bench_derive_pub_wnaf :: Benchmark +bench_derive_pub_wnaf = + bench "derive_child_pub'" $ nf (derive_child_pub' ctx m) 0 + +bench_derive_priv_wnaf :: Benchmark +bench_derive_priv_wnaf = + bench "derive_child_priv'" $ nf (derive_child_priv' ctx m) 0 diff --git a/lib/Crypto/HDKey/BIP32.hs b/lib/Crypto/HDKey/BIP32.hs --- 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 #-} -- | @@ -52,6 +54,17 @@ -- * Child key derivation functions , derive_child_pub , derive_child_priv + + -- * Fast wNAF variants + , Context + , precompute + , ckd_priv' + , ckd_pub' + , n' + , derive' + , derive_partial' + , derive_child_priv' + , derive_child_pub' ) where import Control.Monad (guard) @@ -59,44 +72,165 @@ 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 +-- | Precomputed multiples of the secp256k1 generator point, for faster +-- scalar multiplication. +type Context = Secp256k1.Context + +-- | Create a secp256k1 context by precomputing multiples of the curve's +-- generator point. +-- +-- This should be computed once and reused for all derivations. +-- +-- >>> let !ctx = precompute +-- >>> derive' ctx hd "m/44'/0'/0'/0/0" +precompute :: Context +precompute = Secp256k1.precompute + +-- 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 ------------------------------------------------------------------ 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 +257,11 @@ 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 +318,7 @@ | 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 +326,13 @@ 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 +346,8 @@ 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) @@ -225,6 +359,48 @@ Nothing -> error "ppad-bip32 (n): internal error, evil extended key" Just p -> XPub (X p cod) +-- fast variants -------------------------------------------------------------- + +-- | The same as 'ckd_priv', but uses a 'Context' to optimise internal +-- calculations. +ckd_priv' :: Context -> XPrv -> Word32 -> XPrv +ckd_priv' ctx _xprv@(XPrv (X sec cod)) i = + let l = SHA512.hmac cod dat + (il, ci) = BS.splitAt 32 l + 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' ctx _xprv (succ i) + else XPrv (X ki ci) + where + dat | hardened i = BS.singleton 0x00 <> unroll32 sec <> ser32 i + | otherwise = case Secp256k1.mul_wnaf ctx sec of + Nothing -> + error "ppad-bip32 (ckd_priv'): internal error, evil extended key" + Just p -> Secp256k1.serialize_point p <> ser32 i + +-- | The same as 'ckd_pub', but uses a 'Context' to optimise internal +-- calculations. +ckd_pub' :: Context -> XPub -> Word32 -> Maybe XPub +ckd_pub' ctx _xpub@(XPub (X pub cod)) i + | hardened i = Nothing + | otherwise = do + let dat = Secp256k1.serialize_point pub <> ser32 i + l = SHA512.hmac cod dat + (il, ci) = BS.splitAt 32 l + pil = unsafe_roll32 il -- safe due to 512-bit hmac + pt <- Secp256k1.mul_wnaf ctx pil + let ki = pt `Secp256k1.add` pub + if pil >= Secp256k1._CURVE_Q || ki == Secp256k1._CURVE_ZERO -- negl + then ckd_pub' ctx _xpub (succ i) + else pure (XPub (X ki ci)) + +-- | The same as 'n', but uses a 'Context' to optimise internal calculations. +n' :: Context -> XPrv -> XPub +n' ctx (XPrv (X sec cod)) = case Secp256k1.mul_wnaf ctx sec of + Nothing -> error "ppad-bip32 (n'): internal error, evil extended key" + Just p -> XPub (X p cod) + -- hierarchical deterministic keys -------------------------------------------- -- | A BIP32 hierarchical deterministic key. @@ -299,6 +475,33 @@ child = ser32 i pure $! HDKey (Left key) depth parent child +-- | The same as 'derive_child_priv', but uses a 'Context' to optimise +-- internal calculations. +derive_child_priv' :: Context -> HDKey -> Word32 -> Maybe HDKey +derive_child_priv' ctx HDKey {..} i = case hd_key of + Left _ -> Nothing + Right _xprv -> pure $! + let key = Right (ckd_priv' ctx _xprv i) + depth = hd_depth + 1 + parent = fingerprint _xprv + child = ser32 i + in HDKey key depth parent child + +-- | The same as 'derive_child_pub', but uses a 'Context' to optimise +-- internal calculations. +derive_child_pub' :: Context -> HDKey -> Word32 -> Maybe HDKey +derive_child_pub' ctx HDKey {..} i = do + (key, parent) <- case hd_key of + Left _xpub -> do + pub <- ckd_pub' ctx _xpub i + pure $! (pub, fingerprint _xpub) + Right _xprv -> + let pub = n' ctx (ckd_priv' ctx _xprv i) + in pure $! (pub, fingerprint _xprv) + let depth = hd_depth + 1 + child = ser32 i + pure $! HDKey (Left key) depth parent child + -- derivation path expression ------------------------------------------------- -- recursive derivation path @@ -375,6 +578,44 @@ Nothing -> error "ppad-bip32 (derive_partial): couldn't derive extended key" Just hdkey -> hdkey +-- | The same as 'derive', but uses a 'Context' to optimise internal +-- calculations. +-- +-- >>> let !ctx = precompute +-- >>> let Just child = derive' ctx hd "m/44'/0'/0'/0/0" +derive' + :: Context + -> HDKey + -> BS.ByteString -- ^ derivation path + -> Maybe HDKey +derive' ctx hd pat = case parse_path pat of + Nothing -> Nothing + Just p -> go p + where + go = \case + M -> pure hd + p :| i -> do + hdkey <- go p + derive_child_priv' ctx hdkey (0x8000_0000 + i) -- 2 ^ 31 + p :/ i -> do + hdkey <- go p + derive_child_priv' ctx hdkey i + +-- | The same as 'derive_partial', but uses a 'Context' to optimise internal +-- calculations. +-- +-- >>> let !ctx = precompute +-- >>> let child = derive_partial' ctx hd "m/44'/0'/0'/0/0" +derive_partial' + :: Context + -> HDKey + -> BS.ByteString + -> HDKey +derive_partial' ctx hd pat = case derive' ctx hd pat of + Nothing -> + error "ppad-bip32 (derive_partial'): couldn't derive extended key" + Just hdkey -> hdkey + -- serialization -------------------------------------------------------------- _MAINNET_PUB, _MAINNET_PRV :: Word32 @@ -457,7 +698,7 @@ Right (XPrv (X sec cod)) -> BSB.byteString cod <> BSB.word8 0x00 - <> BSB.byteString (ser256 sec) + <> BSB.byteString (unroll32 sec) -- parsing -------------------------------------------------------------------- @@ -505,7 +746,7 @@ 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 --- a/ppad-bip32.cabal +++ b/ppad-bip32.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: ppad-bip32 -version: 0.2.0 +version: 0.3.0 synopsis: BIP32 hierarchical deterministic wallets. license: MIT license-file: LICENSE @@ -15,6 +15,11 @@ 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,14 +29,17 @@ 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.4 && < 0.5 + , ppad-secp256k1 >= 0.5 && < 0.6 , ppad-sha256 >= 0.2.3 && < 0.3 , ppad-sha512 >= 0.1.3 && < 0.2 @@ -70,5 +78,6 @@ , criterion , deepseq , ppad-bip32 + , ppad-fixed , ppad-secp256k1 diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -15,13 +15,25 @@ Nothing -> error "bang" Just v -> v +-- precomputed context for wNAF tests +ctx :: Context +ctx = precompute + main :: IO () main = defaultMain $ testGroup "BIP32 vectors" [ - vector_1 - , vector_2 - , vector_3 - , vector_4 - , vector_5 + testGroup "standard" [ + vector_1 + , vector_2 + , vector_3 + , vector_4 + , vector_5 + ] + , testGroup "wNAF" [ + vector_1_wnaf + , vector_2_wnaf + , vector_3_wnaf + , vector_4_wnaf + ] ] seed_1 :: BS.ByteString @@ -205,4 +217,138 @@ H.assertEqual "k14" Nothing (parse "xpub661MyMwAqRbcEYS8w7XLSVeEsBXy79zSzH1J8vCdxAZningWLdN3zgtU6Q5JXayek4PRsn35jii4veMimro1xefsM58PgBMrvdYre8QyULY") H.assertEqual "k15" Nothing (parse "xprv9s21ZrQH143K3QTDL4LXw2F7HEK3wJUD2nW2nRk4stbPy6cq3jPPqjiChkVvvNKmPGJxWUtg6LnF5kejMRNNU3TGtRBeJgk33yuGBxrMPHL") +-- wNAF variants -------------------------------------------------------------- +vector_1_wnaf :: TestTree +vector_1_wnaf = H.testCase "BIP32 vector 1 (wNAF)" $ do + let Just _m = master seed_1 + H.assertEqual "M" xpub_1_m (xpub _m) + H.assertEqual "m" xprv_1_m (xprv_partial _m) + let Just _m_0' = derive_child_priv' ctx _m 0x80000000 + H.assertEqual "M/0'" xpub_1_m_0' (xpub _m_0') + H.assertEqual "m/0'" xprv_1_m_0' (xprv_partial _m_0') + H.assertEqual "M/0', path" xpub_1_m_0' + (xpub (derive_partial' ctx _m "m/0'")) + H.assertEqual "m/0', path" xprv_1_m_0' + (xprv_partial (derive_partial' ctx _m "m/0'")) + let Just _m_0'_1 = derive_child_priv' ctx _m_0' 1 + H.assertEqual "M/0'/1" xpub_1_m_0'_1 (xpub _m_0'_1) + H.assertEqual "m/0'/1" xprv_1_m_0'_1 (xprv_partial _m_0'_1) + H.assertEqual "M/0'/1" xpub_1_m_0'_1 + (xpub (derive_partial' ctx _m "m/0'/1")) + H.assertEqual "m/0'/1" xprv_1_m_0'_1 + (xprv_partial (derive_partial' ctx _m "m/0'/1")) + let Just _m_0'_1_2' = derive_child_priv' ctx _m_0'_1 (0x80000000 + 2) + H.assertEqual "M/0'/1/2'" xpub_1_m_0'_1_2' (xpub _m_0'_1_2') + H.assertEqual "m/0'/1/2'" xprv_1_m_0'_1_2' (xprv_partial _m_0'_1_2') + H.assertEqual "M/0'/1/2'" xpub_1_m_0'_1_2' + (xpub (derive_partial' ctx _m "m/0'/1/2'")) + H.assertEqual "m/0'/1/2'" xprv_1_m_0'_1_2' + (xprv_partial (derive_partial' ctx _m "m/0'/1/2'")) + let Just _m_0'_1_2'_2 = derive_child_priv' ctx _m_0'_1_2' 2 + H.assertEqual "M/0'/1/2'/2" xpub_1_m_0'_1_2'_2 (xpub _m_0'_1_2'_2) + H.assertEqual "m/0'/1/2'/2" xprv_1_m_0'_1_2'_2 (xprv_partial _m_0'_1_2'_2) + H.assertEqual "M/0'/1/2'/2" xpub_1_m_0'_1_2'_2 + (xpub (derive_partial' ctx _m "m/0'/1/2'/2")) + H.assertEqual "m/0'/1/2'/2" xprv_1_m_0'_1_2'_2 + (xprv_partial (derive_partial' ctx _m "m/0'/1/2'/2")) + let Just _m_0'_1_2'_2_1000000000 = derive_child_priv' ctx _m_0'_1_2'_2 1000000000 + H.assertEqual "M/0'/1/2'/2/1000000000" xpub_1_m_0'_1_2'_2_1000000000 + (xpub _m_0'_1_2'_2_1000000000) + H.assertEqual "m/0'/1/2'/2/1000000000" xprv_1_m_0'_1_2'_2_1000000000 + (xprv_partial _m_0'_1_2'_2_1000000000) + H.assertEqual "M/0'/1/2'/2/1000000000" xpub_1_m_0'_1_2'_2_1000000000 + (xpub (derive_partial' ctx _m "m/0'/1/2'/2/1000000000")) + H.assertEqual "m/0'/1/2'/2/1000000000" xprv_1_m_0'_1_2'_2_1000000000 + (xprv_partial (derive_partial' ctx _m "m/0'/1/2'/2/1000000000")) + +vector_2_wnaf :: TestTree +vector_2_wnaf = H.testCase "BIP32 vector 2 (wNAF)" $ do + let Just mas = master seed_2 + _m = derive_partial' ctx mas "m" + H.assertEqual "M" + "xpub661MyMwAqRbcFW31YEwpkMuc5THy2PSt5bDMsktWQcFF8syAmRUapSCGu8ED9W6oDMSgv6Zz8idoc4a6mr8BDzTJY47LJhkJ8UB7WEGuduB" + (xpub _m) + H.assertEqual "m" + "xprv9s21ZrQH143K31xYSDQpPDxsXRTUcvj2iNHm5NUtrGiGG5e2DtALGdso3pGz6ssrdK4PFmM8NSpSBHNqPqm55Qn3LqFtT2emdEXVYsCzC2U" + (xprv_partial _m) + let _m_0 = derive_partial' ctx mas "m/0" + H.assertEqual "M/0" + "xpub69H7F5d8KSRgmmdJg2KhpAK8SR3DjMwAdkxj3ZuxV27CprR9LgpeyGmXUbC6wb7ERfvrnKZjXoUmmDznezpbZb7ap6r1D3tgFxHmwMkQTPH" + (xpub _m_0) + H.assertEqual "m/0" + "xprv9vHkqa6EV4sPZHYqZznhT2NPtPCjKuDKGY38FBWLvgaDx45zo9WQRUT3dKYnjwih2yJD9mkrocEZXo1ex8G81dwSM1fwqWpWkeS3v86pgKt" + (xprv_partial _m_0) + let _m_0_2147483647' = derive_partial' ctx mas "m/0/2147483647'" + H.assertEqual "M/0/2147483647'" + "xpub6ASAVgeehLbnwdqV6UKMHVzgqAG8Gr6riv3Fxxpj8ksbH9ebxaEyBLZ85ySDhKiLDBrQSARLq1uNRts8RuJiHjaDMBU4Zn9h8LZNnBC5y4a" + (xpub _m_0_2147483647') + H.assertEqual "m/0/2147483647'" + "xprv9wSp6B7kry3Vj9m1zSnLvN3xH8RdsPP1Mh7fAaR7aRLcQMKTR2vidYEeEg2mUCTAwCd6vnxVrcjfy2kRgVsFawNzmjuHc2YmYRmagcEPdU9" + (xprv_partial _m_0_2147483647') + let _m_0_2147483647'_1 = derive_partial' ctx mas "m/0/2147483647'/1" + H.assertEqual "M/0/2147483647'/1" + "xpub6DF8uhdarytz3FWdA8TvFSvvAh8dP3283MY7p2V4SeE2wyWmG5mg5EwVvmdMVCQcoNJxGoWaU9DCWh89LojfZ537wTfunKau47EL2dhHKon" + (xpub _m_0_2147483647'_1) + H.assertEqual "m/0/2147483647'/1" + "xprv9zFnWC6h2cLgpmSA46vutJzBcfJ8yaJGg8cX1e5StJh45BBciYTRXSd25UEPVuesF9yog62tGAQtHjXajPPdbRCHuWS6T8XA2ECKADdw4Ef" + (xprv_partial _m_0_2147483647'_1) + let _m_0_2147483647'_1_2147483646' = + derive_partial' ctx mas "m/0/2147483647'/1/2147483646'" + H.assertEqual "M/0/2147483647'/1/2147483646'" + "xpub6ERApfZwUNrhLCkDtcHTcxd75RbzS1ed54G1LkBUHQVHQKqhMkhgbmJbZRkrgZw4koxb5JaHWkY4ALHY2grBGRjaDMzQLcgJvLJuZZvRcEL" + (xpub _m_0_2147483647'_1_2147483646') + H.assertEqual "m/0/2147483647'/1/2147483646'" + "xprvA1RpRA33e1JQ7ifknakTFpgNXPmW2YvmhqLQYMmrj4xJXXWYpDPS3xz7iAxn8L39njGVyuoseXzU6rcxFLJ8HFsTjSyQbLYnMpCqE2VbFWc" + (xprv_partial _m_0_2147483647'_1_2147483646') + let _m_0_2147483647'_1_2147483646'_2 = + derive_partial' ctx mas "m/0/2147483647'/1/2147483646'/2" + H.assertEqual "M/0/2147483647'/1/2147483646'/2" + "xpub6FnCn6nSzZAw5Tw7cgR9bi15UV96gLZhjDstkXXxvCLsUXBGXPdSnLFbdpq8p9HmGsApME5hQTZ3emM2rnY5agb9rXpVGyy3bdW6EEgAtqt" + (xpub _m_0_2147483647'_1_2147483646'_2) + H.assertEqual "m/0/2147483647'/1/2147483646'/2" + "xprvA2nrNbFZABcdryreWet9Ea4LvTJcGsqrMzxHx98MMrotbir7yrKCEXw7nadnHM8Dq38EGfSh6dqA9QWTyefMLEcBYJUuekgW4BYPJcr9E7j" + (xprv_partial _m_0_2147483647'_1_2147483646'_2) + +vector_3_wnaf :: TestTree +vector_3_wnaf = H.testCase "BIP32 vector 3 (wNAF)" $ do + let Just mas = master seed_3 + _m = derive_partial' ctx mas "m" + H.assertEqual "M" + "xpub661MyMwAqRbcEZVB4dScxMAdx6d4nFc9nvyvH3v4gJL378CSRZiYmhRoP7mBy6gSPSCYk6SzXPTf3ND1cZAceL7SfJ1Z3GC8vBgp2epUt13" + (xpub _m) + H.assertEqual "m" + "xprv9s21ZrQH143K25QhxbucbDDuQ4naNntJRi4KUfWT7xo4EKsHt2QJDu7KXp1A3u7Bi1j8ph3EGsZ9Xvz9dGuVrtHHs7pXeTzjuxBrCmmhgC6" + (xprv_partial _m) + let _m_0' = derive_partial' ctx mas "m/0'" + H.assertEqual "M/0'" + "xpub68NZiKmJWnxxS6aaHmn81bvJeTESw724CRDs6HbuccFQN9Ku14VQrADWgqbhhTHBaohPX4CjNLf9fq9MYo6oDaPPLPxSb7gwQN3ih19Zm4Y" + (xpub _m_0') + H.assertEqual "m/0'" + "xprv9uPDJpEQgRQfDcW7BkF7eTya6RPxXeJCqCJGHuCJ4GiRVLzkTXBAJMu2qaMWPrS7AANYqdq6vcBcBUdJCVVFceUvJFjaPdGZ2y9WACViL4L" + (xprv_partial _m_0') + +vector_4_wnaf :: TestTree +vector_4_wnaf = H.testCase "BIP32 vector 4 (wNAF)" $ do + let Just mas = master seed_4 + _m = derive_partial' ctx mas "m" + H.assertEqual "M" + "xpub661MyMwAqRbcGczjuMoRm6dXaLDEhW1u34gKenbeYqAix21mdUKJyuyu5F1rzYGVxyL6tmgBUAEPrEz92mBXjByMRiJdba9wpnN37RLLAXa" + (xpub _m) + H.assertEqual "m" + "xprv9s21ZrQH143K48vGoLGRPxgo2JNkJ3J3fqkirQC2zVdk5Dgd5w14S7fRDyHH4dWNHUgkvsvNDCkvAwcSHNAQwhwgNMgZhLtQC63zxwhQmRv" + (xprv_partial _m) + let _m_0' = derive_partial' ctx mas "m/0'" + H.assertEqual "M/0'" + "xpub69AUMk3qDBi3uW1sXgjCmVjJ2G6WQoYSnNHyzkmdCHEhSZ4tBok37xfFEqHd2AddP56Tqp4o56AePAgCjYdvpW2PU2jbUPFKsav5ut6Ch1m" + (xpub _m_0') + H.assertEqual "m/0'" + "xprv9vB7xEWwNp9kh1wQRfCCQMnZUEG21LpbR9NPCNN1dwhiZkjjeGRnaALmPXCX7SgjFTiCTT6bXes17boXtjq3xLpcDjzEuGLQBM5ohqkao9G" + (xprv_partial _m_0') + let _m_0'_1' = derive_partial' ctx mas "m/0'/1'" + H.assertEqual "M/0'/1'" + "xpub6BJA1jSqiukeaesWfxe6sNK9CCGaujFFSJLomWHprUL9DePQ4JDkM5d88n49sMGJxrhpjazuXYWdMf17C9T5XnxkopaeS7jGk1GyyVziaMt" + (xpub _m_0'_1') + H.assertEqual "m/0'/1'" + "xprv9xJocDuwtYCMNAo3Zw76WENQeAS6WGXQ55RCy7tDJ8oALr4FWkuVoHJeHVAcAqiZLE7Je3vZJHxspZdFHfnBEjHqU5hG1Jaj32dVoS6XLT1" + (xprv_partial _m_0'_1')