diff --git a/CHANGELOG b/CHANGELOG new file mode 100644 --- /dev/null +++ b/CHANGELOG @@ -0,0 +1,6 @@ +# Changelog + +- 0.1.0 (2025-02-22) + * Initial release, supporting basic HD wallet functionality. + + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2025 Jared Tobin + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/bench/Main.hs b/bench/Main.hs new file mode 100644 --- /dev/null +++ b/bench/Main.hs @@ -0,0 +1,57 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StandaloneDeriving #-} + +module Main where + +import Criterion.Main +import Crypto.HDKey.BIP32 +import Control.DeepSeq +import Crypto.Curve.Secp256k1 as S + +instance NFData S.Projective + +instance NFData XPub where + rnf (XPub (X a b)) = a `deepseq` b `deepseq` () + +instance NFData XPrv where + rnf (XPrv (X a b)) = a `deepseq` b `deepseq` () + +instance NFData HDKey where + rnf (HDKey a b c d) = a `deepseq` b `deepseq` c `deepseq` d `deepseq` () + +main :: IO () +main = defaultMain [ + bgroup "ppad-bip32" [ + bench_master + , bench_derive_pub + , bench_derive_priv + , bench_xpub + , bench_xprv + ] + ] + +m :: HDKey +m = case master "my super entropic entropy" of + Just !s -> s + _ -> error "bang" + +bench_master :: Benchmark +bench_master = bench "master" $ nf master "my super entropic entropy" + +bench_derive_pub :: Benchmark +bench_derive_pub = bench "derive_child_pub" $ nf (derive_child_pub m) 0 + +bench_derive_priv :: Benchmark +bench_derive_priv = bench "derive_child_priv" $ nf (derive_child_priv m) 0 + +bench_xpub :: Benchmark +bench_xpub = bench "xpub" $ nf xpub m + +bench_xprv :: Benchmark +bench_xprv = bench "xprv" $ nf xprv m + +bench_parse :: Benchmark +bench_parse = bench "parse" $ nf parse (xprv m) + diff --git a/lib/Crypto/HDKey/BIP32.hs b/lib/Crypto/HDKey/BIP32.hs new file mode 100644 --- /dev/null +++ b/lib/Crypto/HDKey/BIP32.hs @@ -0,0 +1,446 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BinaryLiterals #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} + +-- | +-- Module: Crypto.HDKey.BIP32 +-- Copyright: (c) 2025 Jared Tobin +-- License: MIT +-- Maintainer: Jared Tobin +-- +-- [BIP32](https://github.com/bitcoin/bips/blob/master/bip-0032.mediawiki) +-- hierarchical deterministic wallets and extended keys, with support for +-- serialization and parsing. + +module Crypto.HDKey.BIP32 ( + -- * Hierarchical deterministic keys + HDKey(..) + , master + + -- * Extended keys + , Extended(..) + , XPub(..) + , XPrv(..) + , X(..) + + -- * Child derivation via path + , derive + , derive_partial + + -- * Serialization + , xpub + , xprv + , tpub + , tprv + + -- * Parsing + , parse + + -- * Child key derivation functions + , derive_child_pub + , derive_child_priv + ) where + +import Control.Monad (guard) +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 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 Data.Word (Word8, Word32) + +-- 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): invalid input" + 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 + +-- serialize a 32-bit word, MSB first +ser32 :: Word32 -> BS.ByteString +ser32 w = + let !mask = 0b00000000_00000000_00000000_11111111 + !w0 = fi (w .>>. 24) .&. mask + !w1 = fi (w .>>. 16) .&. mask + !w2 = fi (w .>>. 08) .&. mask + !w3 = fi w .&. mask + in BS.cons w0 (BS.cons w1 (BS.cons w2 (BS.singleton w3))) -- XX + +-- extended keys -------------------------------------------------------------- + +-- | A public or private key, extended with a chain code. +data X a = X !a !BS.ByteString + deriving (Eq, Show) + +-- | An extended public key. +newtype XPub = XPub (X Secp256k1.Projective) + deriving (Eq, Show) + +-- | An extended private key. +newtype XPrv = XPrv (X Integer) + deriving (Eq, Show) + +-- | Key types supporting identifier/fingerprint calculation. +class Extended k where + -- | Calculate the identifier for an extended key. + identifier :: k -> BS.ByteString + + -- | Calculate the fingerprint of an extended key. + fingerprint :: k -> BS.ByteString + fingerprint = BS.take 4 . identifier + +instance Extended XPub where + identifier (XPub (X pub _)) = + let ser = Secp256k1.serialize_point pub + in RIPEMD160.hash (SHA256.hash ser) + +instance Extended XPrv where + identifier (XPrv (X sec _)) = + let p = Secp256k1.mul Secp256k1._CURVE_G sec + ser = Secp256k1.serialize_point p + in RIPEMD160.hash (SHA256.hash ser) + +-- internal key derivation functions------------------------------------------- + +hardened :: Word32 -> Bool +hardened = (>= 0x8000_0000) + +-- master xprv from seed +_master :: BS.ByteString -> Maybe XPrv +_master seed@(BI.PS _ _ l) + | l < 16 = Nothing + | l > 64 = Nothing + | otherwise = do + let i = SHA512.hmac "Bitcoin seed" seed + (il, c) = BS.splitAt 32 i + s = parse256 il + pure $! (XPrv (X s c)) + +-- private parent key -> private child key +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 + ki = Secp256k1.modQ (pil + 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 + | otherwise = + let p = Secp256k1.mul Secp256k1._CURVE_G sec + in Secp256k1.serialize_point p <> ser32 i + +-- public parent key -> public child key +ckd_pub :: XPub -> Word32 -> Maybe XPub +ckd_pub _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 = parse256 il + ki = Secp256k1.mul_unsafe Secp256k1._CURVE_G pil `Secp256k1.add` pub + if pil >= Secp256k1._CURVE_Q || ki == Secp256k1._CURVE_ZERO -- negl + then ckd_pub _xpub (succ i) + else pure (XPub (X ki ci)) + +-- private parent key -> public child key +n :: XPrv -> XPub +n (XPrv (X sec cod)) = + let p = Secp256k1.mul Secp256k1._CURVE_G sec + in XPub (X p cod) + +-- hierarchical deterministic keys -------------------------------------------- + +-- | A BIP32 hierarchical deterministic key. +-- +-- This differs from lower-level "extended" keys in that it carries all +-- information required for serialization. +data HDKey = HDKey { + hd_key :: !(Either XPub XPrv) -- ^ extended public or private key + , hd_depth :: !Word8 -- ^ key depth + , hd_parent :: !BS.ByteString -- ^ parent fingerprint + , hd_child :: !BS.ByteString -- ^ index or child number + } + deriving (Eq, Show) + +instance Extended HDKey where + identifier (HDKey ekey _ _ _) = case ekey of + Left l -> identifier l + Right r -> identifier r + +-- | Derive a master 'HDKey' from a master seed. +-- +-- Fails with 'Nothing' if the provided seed has an invalid length. +master :: BS.ByteString -> Maybe HDKey +master seed = do + m <- _master seed + pure $! HDKey { + hd_key = Right m + , hd_depth = 0 + , hd_parent = "\NUL\NUL\NUL\NUL" -- 0x0000_0000 + , hd_child = ser32 0 + } + +-- | Derive a private child node at the provided index. +-- +-- Fails with 'Nothing' if derivation is impossible. +derive_child_priv :: HDKey -> Word32 -> Maybe HDKey +derive_child_priv HDKey {..} i = case hd_key of + Left _ -> Nothing + Right _xprv -> pure $! + let key = Right (ckd_priv _xprv i) + depth = hd_depth + 1 + parent = fingerprint _xprv + child = ser32 i + in HDKey key depth parent child + +-- | Derive a public child node at the provided index. +-- +-- Fails with 'Nothing' if derivation is impossible. +derive_child_pub :: HDKey -> Word32 -> Maybe HDKey +derive_child_pub HDKey {..} i = do + (key, parent) <- case hd_key of + Left _xpub -> do + pub <- ckd_pub _xpub i + pure (pub, fingerprint _xpub) + Right _xprv -> + let pub = n (ckd_priv _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 +data Path = + M + | !Path :| !Word32 -- hardened + | !Path :/ !Word32 + deriving (Eq, Show) + +parse_path :: BS.ByteString -> Maybe Path +parse_path bs = case BS.uncons bs of + Nothing -> Nothing + Just (h, t) + | h == 109 -> go M t -- == 'm' + | otherwise -> Nothing + where + child :: Path -> BS.ByteString -> Maybe (Path, BS.ByteString) + child pat b = case B8.readInt b of + Nothing -> Nothing + Just (fi -> i, etc) -> case BS.uncons etc of + Nothing -> Just $! (pat :/ i, mempty) + Just (h, t) + | h == 39 -> Just $! (pat :| i, t) -- ' + | otherwise -> Just $! (pat :/ i, etc) + + go pat b = case BS.uncons b of + Nothing -> Just pat + Just (h, t) + | h == 47 -> do -- / + (npat, etc) <- child pat t + go npat etc + | otherwise -> + Nothing + +-- | Derive a child node via the provided derivation path. +-- +-- Fails with 'Nothing' if derivation is impossible, or if the +-- provided path is invalid. +-- +-- >>> let hd = master "my very secret master seed" +-- >>> derive hd "m/44'/0'/0'/0/0" +derive + :: HDKey + -> BS.ByteString -- ^ derivation path + -> Maybe HDKey +derive 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 hdkey (0x8000_0000 + i) -- 2 ^ 31 + p :/ i -> do + hdkey <- go p + derive_child_priv hdkey i + +-- | Derive a child node via the provided derivation path. +-- +-- Fails with 'error' if derivation is impossible, or if the provided +-- path is invalid. +-- +-- >>> let hd = master "my very secret master seed" +-- >>> derive hd "m/44'/0'/0'/0/0" +derive_partial + :: HDKey + -> BS.ByteString + -> HDKey +derive_partial hd pat = case derive hd pat of + Nothing -> error "ppad-bip32 (derive_partial): couldn't derive extended key" + Just hdkey -> hdkey + +-- serialization -------------------------------------------------------------- + +_MAINNET_PUB, _MAINNET_PRV :: Word32 +_TESTNET_PUB, _TESTNET_PRV :: Word32 + +_MAINNET_PUB_BYTES, _MAINNET_PRV_BYTES :: BS.ByteString +_TESTNET_PUB_BYTES, _TESTNET_PRV_BYTES :: BS.ByteString + +_MAINNET_PUB = 0x0488B21E +_MAINNET_PUB_BYTES = "\EOT\136\178\RS" + +_MAINNET_PRV = 0x0488ADE4 +_MAINNET_PRV_BYTES = "\EOT\136\173\228" + +_TESTNET_PUB = 0x043587CF +_TESTNET_PUB_BYTES = "\EOT5\135\207" + +_TESTNET_PRV = 0x04358394 +_TESTNET_PRV_BYTES = "\EOT5\131\148" + +-- | Serialize a mainnet extended public key in base58check format. +xpub :: HDKey -> BS.ByteString +xpub x@HDKey {..} = B58C.encode . BS.toStrict . BSB.toLazyByteString $ + case hd_key of + Left _ -> _serialize _MAINNET_PUB x + Right e -> _serialize _MAINNET_PUB HDKey { + hd_key = Left (n e) + , .. + } + +-- | Serialize a mainnet extended private key in base58check format. +xprv :: HDKey -> BS.ByteString +xprv x@HDKey {..} = B58C.encode . BS.toStrict . BSB.toLazyByteString $ + case hd_key of + Left _ -> error "ppad-bip32 (xprv): no private key" + Right _ -> _serialize _MAINNET_PRV x + +-- | Serialize a testnet extended public key in base58check format. +tpub :: HDKey -> BS.ByteString +tpub x@HDKey {..} = B58C.encode . BS.toStrict . BSB.toLazyByteString $ + case hd_key of + Left _ -> _serialize _TESTNET_PUB x + Right e -> _serialize _TESTNET_PUB HDKey { + hd_key = Left (n e) + , .. + } + +-- | Serialize a testnet extended private key in base58check format. +tprv :: HDKey -> BS.ByteString +tprv x@HDKey {..} = B58C.encode . BS.toStrict . BSB.toLazyByteString $ + case hd_key of + Left _ -> error "ppad-bip32 (tprv): no private key" + Right _ -> _serialize _TESTNET_PRV x + +_serialize :: Word32 -> HDKey -> BSB.Builder +_serialize version HDKey {..} = + BSB.word32BE version + <> BSB.word8 hd_depth + <> BSB.byteString hd_parent + <> BSB.byteString hd_child + <> case hd_key of + Left (XPub (X pub cod)) -> + BSB.byteString cod + <> BSB.byteString (Secp256k1.serialize_point pub) + Right (XPrv (X sec cod)) -> + BSB.byteString cod + <> BSB.word8 0x00 + <> BSB.byteString (ser256 sec) + +-- parsing -------------------------------------------------------------------- + +data KeyType = + Pub + | Prv + +-- | Parse a base58check-encoded 'ByteString' into a 'HDKey'. +-- +-- Fails with 'Nothing' if the provided key is invalid. +parse :: BS.ByteString -> Maybe HDKey +parse b58 = do + bs <- B58C.decode b58 + case BS.splitAt 4 bs of + (version, etc) + | version == _MAINNET_PUB_BYTES || version == _TESTNET_PUB_BYTES -> + parse_pub etc + | version == _MAINNET_PRV_BYTES || version == _TESTNET_PRV_BYTES -> + parse_prv etc + | otherwise -> + Nothing + where + parse_pub = _parse Pub + parse_prv = _parse Prv + + _parse ktype bs = do + (hd_depth, etc0) <- BS.uncons bs + let (hd_parent, etc1) = BS.splitAt 4 etc0 + guard (BS.length hd_parent == 4) + let (hd_child, etc2) = BS.splitAt 4 etc1 + guard (BS.length hd_child == 4) + let (cod, etc3) = BS.splitAt 32 etc2 + guard (BS.length cod == 32) + let (key, etc4) = BS.splitAt 33 etc3 + guard (BS.length key == 33) + guard (BS.length etc4 == 0) + hd <- case ktype of + Pub -> do + pub <- Secp256k1.parse_point key + let hd_key = Left (XPub (X pub cod)) + pure HDKey {..} + Prv -> do + (b, parse256 -> prv) <- BS.uncons key + guard (b == 0) + guard (prv > 0 && prv < Secp256k1._CURVE_Q) + let hd_key = Right (XPrv (X prv cod)) + pure HDKey {..} + guard (valid_lineage hd) + pure hd + {-# INLINE _parse #-} + +valid_lineage :: HDKey -> Bool +valid_lineage HDKey {..} + | hd_depth == 0 = + hd_parent == "\NUL\NUL\NUL\NUL" + && hd_child == "\NUL\NUL\NUL\NUL" + | otherwise = True + diff --git a/ppad-bip32.cabal b/ppad-bip32.cabal new file mode 100644 --- /dev/null +++ b/ppad-bip32.cabal @@ -0,0 +1,74 @@ +cabal-version: 3.0 +name: ppad-bip32 +version: 0.1.0 +synopsis: BIP32 hierarchical deterministic wallets. +license: MIT +license-file: LICENSE +author: Jared Tobin +maintainer: jared@ppad.tech +category: Cryptography +build-type: Simple +tested-with: GHC == 9.8.1 +extra-doc-files: CHANGELOG +description: + [BIP32](https://github.com/bitcoin/bips/blob/master/bip-0032.mediawiki) + hierarchical deterministic wallets and extended keys, with support for + serialization and parsing. + +source-repository head + type: git + location: git.ppad.tech/bip32.git + +library + default-language: Haskell2010 + hs-source-dirs: lib + ghc-options: + -Wall + exposed-modules: + Crypto.HDKey.BIP32 + build-depends: + base >= 4.9 && < 5 + , bytestring >= 0.9 && < 0.13 + , ppad-base58 >= 0.2 && < 0.3 + , ppad-ripemd160 >= 0.1.3 && < 0.2 + , ppad-secp256k1 >= 0.2.2 && < 0.3 + , ppad-sha256 >= 0.2.3 && < 0.3 + , ppad-sha512 >= 0.1.3 && < 0.2 + +test-suite bip32-tests + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + main-is: Main.hs + + ghc-options: + -rtsopts -Wall -O2 + + build-depends: + base + , array + , bytestring + , ppad-base16 + , ppad-base58 + , ppad-bip32 + , tasty + , tasty-hunit + +benchmark bip32-bench + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: bench + main-is: Main.hs + + ghc-options: + -rtsopts -O2 -Wall + + build-depends: + base + , array + , bytestring + , criterion + , deepseq + , ppad-bip32 + , ppad-secp256k1 + diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,202 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Crypto.HDKey.BIP32 +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base16 as B16 +import Test.Tasty +import qualified Test.Tasty.HUnit as H + +main :: IO () +main = defaultMain $ testGroup "BIP32 vectors" [ + vector_1 + , vector_2 + , vector_3 + , vector_4 + , vector_5 + ] + +seed_1 :: BS.ByteString +seed_1 = case B16.decode "000102030405060708090a0b0c0d0e0f" of + Nothing -> error "bang" + Just b -> b + +xpub_1_m :: BS.ByteString +xpub_1_m = "xpub661MyMwAqRbcFtXgS5sYJABqqG9YLmC4Q1Rdap9gSE8NqtwybGhePY2gZ29ESFjqJoCu1Rupje8YtGqsefD265TMg7usUDFdp6W1EGMcet8" + +xprv_1_m :: BS.ByteString +xprv_1_m = "xprv9s21ZrQH143K3QTDL4LXw2F7HEK3wJUD2nW2nRk4stbPy6cq3jPPqjiChkVvvNKmPGJxWUtg6LnF5kejMRNNU3TGtRBeJgk33yuGBxrMPHi" + +xpub_1_m_0' :: BS.ByteString +xpub_1_m_0' = "xpub68Gmy5EdvgibQVfPdqkBBCHxA5htiqg55crXYuXoQRKfDBFA1WEjWgP6LHhwBZeNK1VTsfTFUHCdrfp1bgwQ9xv5ski8PX9rL2dZXvgGDnw" + +xprv_1_m_0' :: BS.ByteString +xprv_1_m_0' = "xprv9uHRZZhk6KAJC1avXpDAp4MDc3sQKNxDiPvvkX8Br5ngLNv1TxvUxt4cV1rGL5hj6KCesnDYUhd7oWgT11eZG7XnxHrnYeSvkzY7d2bhkJ7" + +xpub_1_m_0'_1 :: BS.ByteString +xpub_1_m_0'_1 = "xpub6ASuArnXKPbfEwhqN6e3mwBcDTgzisQN1wXN9BJcM47sSikHjJf3UFHKkNAWbWMiGj7Wf5uMash7SyYq527Hqck2AxYysAA7xmALppuCkwQ" + +xprv_1_m_0'_1 :: BS.ByteString +xprv_1_m_0'_1 = "xprv9wTYmMFdV23N2TdNG573QoEsfRrWKQgWeibmLntzniatZvR9BmLnvSxqu53Kw1UmYPxLgboyZQaXwTCg8MSY3H2EU4pWcQDnRnrVA1xe8fs" + +xpub_1_m_0'_1_2' :: BS.ByteString +xpub_1_m_0'_1_2' = "xpub6D4BDPcP2GT577Vvch3R8wDkScZWzQzMMUm3PWbmWvVJrZwQY4VUNgqFJPMM3No2dFDFGTsxxpG5uJh7n7epu4trkrX7x7DogT5Uv6fcLW5" + +xprv_1_m_0'_1_2' :: BS.ByteString +xprv_1_m_0'_1_2' = "xprv9z4pot5VBttmtdRTWfWQmoH1taj2axGVzFqSb8C9xaxKymcFzXBDptWmT7FwuEzG3ryjH4ktypQSAewRiNMjANTtpgP4mLTj34bhnZX7UiM" + +xpub_1_m_0'_1_2'_2 :: BS.ByteString +xpub_1_m_0'_1_2'_2 = "xpub6FHa3pjLCk84BayeJxFW2SP4XRrFd1JYnxeLeU8EqN3vDfZmbqBqaGJAyiLjTAwm6ZLRQUMv1ZACTj37sR62cfN7fe5JnJ7dh8zL4fiyLHV" + +xprv_1_m_0'_1_2'_2 :: BS.ByteString +xprv_1_m_0'_1_2'_2 = "xprvA2JDeKCSNNZky6uBCviVfJSKyQ1mDYahRjijr5idH2WwLsEd4Hsb2Tyh8RfQMuPh7f7RtyzTtdrbdqqsunu5Mm3wDvUAKRHSC34sJ7in334" + +xpub_1_m_0'_1_2'_2_1000000000 :: BS.ByteString +xpub_1_m_0'_1_2'_2_1000000000 = "xpub6H1LXWLaKsWFhvm6RVpEL9P4KfRZSW7abD2ttkWP3SSQvnyA8FSVqNTEcYFgJS2UaFcxupHiYkro49S8yGasTvXEYBVPamhGW6cFJodrTHy" + +xprv_1_m_0'_1_2'_2_1000000000 :: BS.ByteString +xprv_1_m_0'_1_2'_2_1000000000 = "xprvA41z7zogVVwxVSgdKUHDy1SKmdb533PjDz7J6N6mV6uS3ze1ai8FHa8kmHScGpWmj4WggLyQjgPie1rFSruoUihUZREPSL39UNdE3BBDu76" + +vector_1 :: TestTree +vector_1 = H.testCase "BIP32 vector 1" $ do + let Just _m = master seed_1 + H.assertEqual "M" xpub_1_m (xpub _m) + H.assertEqual "m" xprv_1_m (xprv _m) + let Just _m_0' = derive_child_priv _m 0x80000000 + H.assertEqual "M/0'" xpub_1_m_0' (xpub _m_0') + H.assertEqual "m/0'" xprv_1_m_0' (xprv _m_0') + H.assertEqual "M/0', path" xpub_1_m_0' (xpub (derive_partial _m "m/0'")) + H.assertEqual "m/0', path" xprv_1_m_0' (xprv (derive_partial _m "m/0'")) + let Just _m_0'_1 = derive_child_priv _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 _m_0'_1) + H.assertEqual "M/0'/1" xpub_1_m_0'_1 (xpub (derive_partial _m "m/0'/1")) + H.assertEqual "m/0'/1" xprv_1_m_0'_1 (xprv (derive_partial _m "m/0'/1")) + let Just _m_0'_1_2' = derive_child_priv _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 _m_0'_1_2') + H.assertEqual "M/0'/1/2'" xpub_1_m_0'_1_2' (xpub (derive_partial _m "m/0'/1/2'")) + H.assertEqual "m/0'/1/2'" xprv_1_m_0'_1_2' (xprv (derive_partial _m "m/0'/1/2'")) + let Just _m_0'_1_2'_2 = derive_child_priv _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 _m_0'_1_2'_2) + H.assertEqual "M/0'/1/2'/2" xpub_1_m_0'_1_2'_2 + (xpub (derive_partial _m "m/0'/1/2'/2")) + H.assertEqual "m/0'/1/2'/2" xprv_1_m_0'_1_2'_2 + (xprv (derive_partial _m "m/0'/1/2'/2")) + let Just _m_0'_1_2'_2_1000000000 = derive_child_priv _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 _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 _m "m/0'/1/2'/2/1000000000")) + H.assertEqual "m/0'/1/2'/2/1000000000" xprv_1_m_0'_1_2'_2_1000000000 + (xprv (derive_partial _m "m/0'/1/2'/2/1000000000")) + +seed_2 :: BS.ByteString +seed_2 = case B16.decode "fffcf9f6f3f0edeae7e4e1dedbd8d5d2cfccc9c6c3c0bdbab7b4b1aeaba8a5a29f9c999693908d8a8784817e7b7875726f6c696663605d5a5754514e4b484542" of + Nothing -> error "bang" + Just b -> b + +vector_2 :: TestTree +vector_2 = H.testCase "BIP32 vector 2" $ do + let Just mas = master seed_2 + _m = derive_partial mas "m" + H.assertEqual "M" "xpub661MyMwAqRbcFW31YEwpkMuc5THy2PSt5bDMsktWQcFF8syAmRUapSCGu8ED9W6oDMSgv6Zz8idoc4a6mr8BDzTJY47LJhkJ8UB7WEGuduB" + (xpub _m) + H.assertEqual "m" "xprv9s21ZrQH143K31xYSDQpPDxsXRTUcvj2iNHm5NUtrGiGG5e2DtALGdso3pGz6ssrdK4PFmM8NSpSBHNqPqm55Qn3LqFtT2emdEXVYsCzC2U" + (xprv _m) + let _m_0 = derive_partial mas "m/0" + H.assertEqual "M/0" "xpub69H7F5d8KSRgmmdJg2KhpAK8SR3DjMwAdkxj3ZuxV27CprR9LgpeyGmXUbC6wb7ERfvrnKZjXoUmmDznezpbZb7ap6r1D3tgFxHmwMkQTPH" + (xpub _m_0) + H.assertEqual "m/0" "xprv9vHkqa6EV4sPZHYqZznhT2NPtPCjKuDKGY38FBWLvgaDx45zo9WQRUT3dKYnjwih2yJD9mkrocEZXo1ex8G81dwSM1fwqWpWkeS3v86pgKt" + (xprv _m_0) + let _m_0_2147483647' = derive_partial mas "m/0/2147483647'" + H.assertEqual "M/0/2147483647'" "xpub6ASAVgeehLbnwdqV6UKMHVzgqAG8Gr6riv3Fxxpj8ksbH9ebxaEyBLZ85ySDhKiLDBrQSARLq1uNRts8RuJiHjaDMBU4Zn9h8LZNnBC5y4a" + (xpub _m_0_2147483647') + H.assertEqual "m/0/2147483647'" "xprv9wSp6B7kry3Vj9m1zSnLvN3xH8RdsPP1Mh7fAaR7aRLcQMKTR2vidYEeEg2mUCTAwCd6vnxVrcjfy2kRgVsFawNzmjuHc2YmYRmagcEPdU9" + (xprv _m_0_2147483647') + let _m_0_2147483647'_1 = derive_partial 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 _m_0_2147483647'_1) + let _m_0_2147483647'_1_2147483646' = + derive_partial 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 _m_0_2147483647'_1_2147483646') + let _m_0_2147483647'_1_2147483646'_2 = + derive_partial 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 _m_0_2147483647'_1_2147483646'_2) + +seed_3 :: BS.ByteString +seed_3 = case B16.decode "4b381541583be4423346c643850da4b320e46a87ae3d2a4e6da11eba819cd4acba45d239319ac14f863b8d5ab5a0d0c64d2e8a1e7d1457df2e5a3c51c73235be" of + Nothing -> error "bang" + Just b -> b + +vector_3 :: TestTree +vector_3 = H.testCase "BIP32 vector 3" $ do + let Just mas = master seed_3 + _m = derive_partial mas "m" + H.assertEqual "M" "xpub661MyMwAqRbcEZVB4dScxMAdx6d4nFc9nvyvH3v4gJL378CSRZiYmhRoP7mBy6gSPSCYk6SzXPTf3ND1cZAceL7SfJ1Z3GC8vBgp2epUt13" + (xpub _m) + H.assertEqual "m" "xprv9s21ZrQH143K25QhxbucbDDuQ4naNntJRi4KUfWT7xo4EKsHt2QJDu7KXp1A3u7Bi1j8ph3EGsZ9Xvz9dGuVrtHHs7pXeTzjuxBrCmmhgC6" + (xprv _m) + let _m_0' = derive_partial mas "m/0'" + H.assertEqual "M/0'" "xpub68NZiKmJWnxxS6aaHmn81bvJeTESw724CRDs6HbuccFQN9Ku14VQrADWgqbhhTHBaohPX4CjNLf9fq9MYo6oDaPPLPxSb7gwQN3ih19Zm4Y" + (xpub _m_0') + H.assertEqual "m/0'" "xprv9uPDJpEQgRQfDcW7BkF7eTya6RPxXeJCqCJGHuCJ4GiRVLzkTXBAJMu2qaMWPrS7AANYqdq6vcBcBUdJCVVFceUvJFjaPdGZ2y9WACViL4L" + (xprv _m_0') + +seed_4 :: BS.ByteString +seed_4 = case B16.decode "3ddd5602285899a946114506157c7997e5444528f3003f6134712147db19b678" of + Nothing -> error "bang" + Just b -> b + +vector_4 :: TestTree +vector_4 = H.testCase "BIP32 vector 4" $ do + let Just mas = master seed_4 + _m = derive_partial mas "m" + H.assertEqual "M" "xpub661MyMwAqRbcGczjuMoRm6dXaLDEhW1u34gKenbeYqAix21mdUKJyuyu5F1rzYGVxyL6tmgBUAEPrEz92mBXjByMRiJdba9wpnN37RLLAXa" + (xpub _m) + H.assertEqual "m" "xprv9s21ZrQH143K48vGoLGRPxgo2JNkJ3J3fqkirQC2zVdk5Dgd5w14S7fRDyHH4dWNHUgkvsvNDCkvAwcSHNAQwhwgNMgZhLtQC63zxwhQmRv" + (xprv _m) + let _m_0' = derive_partial mas "m/0'" + H.assertEqual "M/0'" "xpub69AUMk3qDBi3uW1sXgjCmVjJ2G6WQoYSnNHyzkmdCHEhSZ4tBok37xfFEqHd2AddP56Tqp4o56AePAgCjYdvpW2PU2jbUPFKsav5ut6Ch1m" + (xpub _m_0') + H.assertEqual "m/0'" "xprv9vB7xEWwNp9kh1wQRfCCQMnZUEG21LpbR9NPCNN1dwhiZkjjeGRnaALmPXCX7SgjFTiCTT6bXes17boXtjq3xLpcDjzEuGLQBM5ohqkao9G" + (xprv _m_0') + let _m_0'_1' = derive_partial mas "m/0'/1'" + H.assertEqual "M/0'/1'" "xpub6BJA1jSqiukeaesWfxe6sNK9CCGaujFFSJLomWHprUL9DePQ4JDkM5d88n49sMGJxrhpjazuXYWdMf17C9T5XnxkopaeS7jGk1GyyVziaMt" + (xpub _m_0'_1') + H.assertEqual "m/0'/1'" "xprv9xJocDuwtYCMNAo3Zw76WENQeAS6WGXQ55RCy7tDJ8oALr4FWkuVoHJeHVAcAqiZLE7Je3vZJHxspZdFHfnBEjHqU5hG1Jaj32dVoS6XLT1" + (xprv _m_0'_1') + +vector_5 :: TestTree +vector_5 = H.testCase "BIP32 vector 5" $ do + H.assertEqual "k0" Nothing (parse "xpub661MyMwAqRbcEYS8w7XLSVeEsBXy79zSzH1J8vCdxAZningWLdN3zgtU6LBpB85b3D2yc8sfvZU521AAwdZafEz7mnzBBsz4wKY5fTtTQBm") + H.assertEqual "k1" Nothing (parse "xprv9s21ZrQH143K24Mfq5zL5MhWK9hUhhGbd45hLXo2Pq2oqzMMo63oStZzFGTQQD3dC4H2D5GBj7vWvSQaaBv5cxi9gafk7NF3pnBju6dwKvH") + H.assertEqual "k2" Nothing (parse "xpub661MyMwAqRbcEYS8w7XLSVeEsBXy79zSzH1J8vCdxAZningWLdN3zgtU6Txnt3siSujt9RCVYsx4qHZGc62TG4McvMGcAUjeuwZdduYEvFn") + H.assertEqual "k3" Nothing (parse "xprv9s21ZrQH143K24Mfq5zL5MhWK9hUhhGbd45hLXo2Pq2oqzMMo63oStZzFGpWnsj83BHtEy5Zt8CcDr1UiRXuWCmTQLxEK9vbz5gPstX92JQ") + H.assertEqual "k4" Nothing (parse "xpub661MyMwAqRbcEYS8w7XLSVeEsBXy79zSzH1J8vCdxAZningWLdN3zgtU6N8ZMMXctdiCjxTNq964yKkwrkBJJwpzZS4HS2fxvyYUA4q2Xe4") + H.assertEqual "k5" Nothing (parse "xprv9s21ZrQH143K24Mfq5zL5MhWK9hUhhGbd45hLXo2Pq2oqzMMo63oStZzFAzHGBP2UuGCqWLTAPLcMtD9y5gkZ6Eq3Rjuahrv17fEQ3Qen6J") + H.assertEqual "k6" Nothing (parse "xprv9s2SPatNQ9Vc6GTbVMFPFo7jsaZySyzk7L8n2uqKXJen3KUmvQNTuLh3fhZMBoG3G4ZW1N2kZuHEPY53qmbZzCHshoQnNf4GvELZfqTUrcv") + H.assertEqual "k7" Nothing (parse "xpub661no6RGEX3uJkY4bNnPcw4URcQTrSibUZ4NqJEw5eBkv7ovTwgiT91XX27VbEXGENhYRCf7hyEbWrR3FewATdCEebj6znwMfQkhRYHRLpJ") + H.assertEqual "k8" Nothing (parse "xprv9s21ZrQH4r4TsiLvyLXqM9P7k1K3EYhA1kkD6xuquB5i39AU8KF42acDyL3qsDbU9NmZn6MsGSUYZEsuoePmjzsB3eFKSUEh3Gu1N3cqVUN") + H.assertEqual "k9" Nothing (parse "xpub661MyMwAuDcm6CRQ5N4qiHKrJ39Xe1R1NyfouMKTTWcguwVcfrZJaNvhpebzGerh7gucBvzEQWRugZDuDXjNDRmXzSZe4c7mnTK97pTvGS8") + H.assertEqual "k10" Nothing (parse "DMwo58pR1QLEFihHiXPVykYB6fJmsTeHvyTp7hRThAtCX8CvYzgPcn8XnmdfHGMQzT7ayAmfo4z3gY5KfbrZWZ6St24UVf2Qgo6oujFktLHdHY4") + H.assertEqual "k11" Nothing (parse "DMwo58pR1QLEFihHiXPVykYB6fJmsTeHvyTp7hRThAtCX8CvYzgPcn8XnmdfHPmHJiEDXkTiJTVV9rHEBUem2mwVbbNfvT2MTcAqj3nesx8uBf9") + H.assertEqual "k12" Nothing (parse "xprv9s21ZrQH143K24Mfq5zL5MhWK9hUhhGbd45hLXo2Pq2oqzMMo63oStZzF93Y5wvzdUayhgkkFoicQZcP3y52uPPxFnfoLZB21Teqt1VvEHx") + H.assertEqual "k13" Nothing (parse "xprv9s21ZrQH143K24Mfq5zL5MhWK9hUhhGbd45hLXo2Pq2oqzMMo63oStZzFAzHGBP2UuGCqWLTAPLcMtD5SDKr24z3aiUvKr9bJpdrcLg1y3G") + H.assertEqual "k14" Nothing (parse "xpub661MyMwAqRbcEYS8w7XLSVeEsBXy79zSzH1J8vCdxAZningWLdN3zgtU6Q5JXayek4PRsn35jii4veMimro1xefsM58PgBMrvdYre8QyULY") + H.assertEqual "k15" Nothing (parse "xprv9s21ZrQH143K3QTDL4LXw2F7HEK3wJUD2nW2nRk4stbPy6cq3jPPqjiChkVvvNKmPGJxWUtg6LnF5kejMRNNU3TGtRBeJgk33yuGBxrMPHL") + +