bip32-0.1.1: test/Main.hs
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-type-defaults #-}
module Main (main) where
import qualified Data.ByteString as B
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Base58 as B58
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Lazy as BL
import Data.Foldable
import Data.Maybe (isJust)
import Data.Word
import qualified Test.Tasty as Tasty
import qualified Test.Tasty.Runners as Tasty
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase, (@?=), (@=?))
import Test.Tasty.Hedgehog (testProperty, HedgehogTestLimit(..))
import Hedgehog (MonadGen, property, forAll, (===), diff)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import qualified BIP32 as S
--------------------------------------------------------------------------------
main :: IO ()
main = Tasty.defaultMainWithIngredients
[ Tasty.consoleTestReporter
, Tasty.listingTests
] $ Tasty.localOption (HedgehogTestLimit (Just 1000))
$ tt
tt :: TestTree
tt = testGroup "BIP32"
[ testCase "versions" $ do
-- https://bitcoin.stackexchange.com/questions/38878/how-does-the-bip32-version-bytes-convert-to-base58
let sv = B.take 4 . B58.encodeBase58 B58.bitcoinAlphabet
. flip mappend (B.replicate 78 0x00)
. BL.toStrict . BB.toLazyByteString . BB.word32BE . S.unVersion
sv S.version_xprv @?= "xprv"
sv S.version_xpub @?= "xpub"
sv S.version_tprv @?= "tprv"
sv S.version_tpub @?= "tpub"
sv S.version_Ltpv @?= "Ltpv"
sv S.version_Ltub @?= "Ltub"
sv S.version_ttpv @?= "ttpv"
sv S.version_ttub @?= "ttub"
, testProperty "encodeXPubRaw length" $ property $ do
xpub <- forAll genXPub
B.length (S.encodeXPubRaw xpub) === 78
, testProperty "encodeXPrvRaw length" $ property $ do
xprv <- forAll genXPrv
B.length (S.encodeXPrvRaw xprv) === 78
, testProperty "encodeXPub length" $ property $ do
xpub <- forAll genXPub
let xpubB = S.encodeXPub xpub
diff (B.length xpubB) (>=) 111
diff (B.length xpubB) (<=) 112
, testProperty "encodeXPrv length" $ property $ do
xprv <- forAll genXPrv
let xprvB = S.encodeXPrv xprv
diff (B.length xprvB) (>=) 111
diff (B.length xprvB) (<=) 112
, testProperty "XPub raw roundtrip" $ property $ do
xpub :: S.XPub <- forAll genXPub
let xpubB = S.encodeXPubRaw xpub
Just xpub === S.decodeXPubRaw xpubB
, testProperty "XPrv raw roundtrip" $ property $ do
xprv :: S.XPrv <- forAll genXPrv
let xprvB = S.encodeXPrvRaw xprv
Just xprv === S.decodeXPrvRaw xprvB
, testProperty "XPub Base58 roundtrip" $ property $ do
xpub :: S.XPub <- forAll genXPub
let xpubB = S.encodeXPub xpub
Just xpub === S.decodeXPub xpubB
, testProperty "XPrv Base58 roundtrip" $ property $ do
xprv :: S.XPrv <- forAll genXPrv
let xprvB = S.encodeXPrv xprv
Just xprv === S.decodeXPrv xprvB
, testCase "Pub invalid" $ do
Nothing @=? S.pub "\x03hxxqhlivzpapqhxguwpftplfduateosa"
, testProperty "subPubPub with normal index" $ property $ do
S.XPub v d f i c p <- forAll genXPub
let d' = S.Depth $ case S.unDepth d of { 255 -> 254; w -> w }
xpub' = S.XPub v d' f i c p
i1n :: S.Index <- forAll genIndexNormal
case S.subXPubXPub xpub' i1n of
Just _ -> pure ()
Nothing -> do -- This has chance of happening of 1 in 2^127
i2n :: S.Index <- forAll genIndexNormal
True === isJust (S.subXPubXPub xpub' i2n)
, testProperty "subPubPub with hardended index" $ property $ do
xpub :: S.XPub <- forAll genXPub
ih :: S.Index <- forAll genIndexHardened
Nothing === S.subXPubXPub xpub ih
, tt_vectors
]
tt_vectors :: TestTree
tt_vectors = testGroup "Test vectors"
[ tv $ TV { tv_name = "m"
, tv_depth = 0
, tv_fingerp = 0x00000000
, tv_index = 0
, tv_chain = "873dff81c02f525623fd1fe5167eac3a55a049de3d314bb42ee227ffed37d508"
, tv_xpub = "xpub661MyMwAqRbcFtXgS5sYJABqqG9YLmC4Q1Rdap9gSE8NqtwybGhePY2gZ29ESFjqJoCu1Rupje8YtGqsefD265TMg7usUDFdp6W1EGMcet8"
, tv_pub = "0339a36013301597daef41fbe593a02cc513d0b55527ec2df1050e2e8ff49c85c2"
, tv_xprv = "xprv9s21ZrQH143K3QTDL4LXw2F7HEK3wJUD2nW2nRk4stbPy6cq3jPPqjiChkVvvNKmPGJxWUtg6LnF5kejMRNNU3TGtRBeJgk33yuGBxrMPHi"
, tv_prv = "e8f32e723decf4051aefac8e2c93c9c5b214313817cdb01a1494b917c8436b35"
, tv_subPubPubs = [ (0, "xpub68Gmy5EVb2BdFbj2LpWrk1M7obNuaPTpT5oh9QCCo5sRfqSHVYWex97WpDZzszdzHzxXDAzPLVSwybe4uPYkSk4G3gnrPqqkV9RyNzAcNJ1")
, (1, "xpub68Gmy5EVb2BdHTYHpekwGdcbBWax19w9HwA2DaADYvuCSSgt4YAErxxSN1KWSnmyqkwRNbnTj3XiUBKmHeC8rTjLRPjSULcDKQQgfgJDppq") ]
, tv_subPrvPrvs = [ (0, "xprv9uHRZZhbkedL37eZEnyrNsQPFZYRAvjy5rt6M1nbEkLSo378x1CQQLo2xxBvREwiK6kqf7GRNvsNEchwibzXaV6i5GcsgyjBeRguXhKsi4R")
, (1, "xprv9uHRZZhbkedL4yTpidDvuVfrdUkTbhDHviERRBkbzbNDZeMjWzqzKAdxWhzftGDSxDmBdakjqHiZJbkwiaTEXJdjZAaAjMZEE3PMbMrPJih")
, (0 + 0x80000000, "xprv9uHRZZhk6KAJC1avXpDAp4MDc3sQKNxDiPvvkX8Br5ngLNv1TxvUxt4cV1rGL5hj6KCesnDYUhd7oWgT11eZG7XnxHrnYeSvkzY7d2bhkJ7")
, (1 + 0x80000000, "xprv9uHRZZhk6KAJFszJGW6LoUFq92uL7FvkBhmYiMurCWPHLJZkX2aGvNdRUBNnJu7nv36WnwCN59uNy6sxLDZvvNSgFz3TCCcKo7iutQzpg78") ]
}
, tv $ TV { tv_name = "m/0"
, tv_depth = 1
, tv_fingerp = 0x3442193e
, tv_index = 0
, tv_chain = "d323f1be5af39a2d2f08f5e8f664633849653dbe329802e9847cfc85f8d7b52a"
, tv_xpub = "xpub68Gmy5EVb2BdFbj2LpWrk1M7obNuaPTpT5oh9QCCo5sRfqSHVYWex97WpDZzszdzHzxXDAzPLVSwybe4uPYkSk4G3gnrPqqkV9RyNzAcNJ1"
, tv_pub = "027c4b09ffb985c298afe7e5813266cbfcb7780b480ac294b0b43dc21f2be3d13c"
, tv_xprv = "xprv9uHRZZhbkedL37eZEnyrNsQPFZYRAvjy5rt6M1nbEkLSo378x1CQQLo2xxBvREwiK6kqf7GRNvsNEchwibzXaV6i5GcsgyjBeRguXhKsi4R"
, tv_prv = "4e2cdcf2f14e802810e878cf9e6411fc4e712edf19a06bcfcc5d5572e489a3b7"
, tv_subPubPubs = [ (0, "xpub6AvUGrnEpfvJ8L7GLRkBTByQ9uBvUHp9o5VxHrFxhvzV4dSWkySpNaBoLR9FpbnwRmTa69yLHF3QfcaxbWT7gWdwws5k4dpmJvqpEuMWwnj") ]
, tv_subPrvPrvs = [ (0, "xprv9ww7sMFLzJMzur2oEQDB642fbsMS4q6JRraMVTrM9bTWBq7NDS8ZpmsKVB4YF3mZecqax1fjnsPF19xnsJNfRp4RSyexacULXMKowSACTRc") ]
}
, tv $ TV { tv_name = "m/0'"
, tv_depth = 1
, tv_fingerp = 0x3442193e
, tv_index = 0 + 0x80000000
, tv_chain = "47fdacbd0f1097043b78c63c20c34ef4ed9a111d980047ad16282c7ae6236141"
, tv_xpub = "xpub68Gmy5EdvgibQVfPdqkBBCHxA5htiqg55crXYuXoQRKfDBFA1WEjWgP6LHhwBZeNK1VTsfTFUHCdrfp1bgwQ9xv5ski8PX9rL2dZXvgGDnw"
, tv_pub = "035a784662a4a20a65bf6aab9ae98a6c068a81c52e4b032c0fb5400c706cfccc56"
, tv_xprv = "xprv9uHRZZhk6KAJC1avXpDAp4MDc3sQKNxDiPvvkX8Br5ngLNv1TxvUxt4cV1rGL5hj6KCesnDYUhd7oWgT11eZG7XnxHrnYeSvkzY7d2bhkJ7"
, tv_prv = "edb2e14f9ee77d26dd93b4ecede8d16ed408ce149b6cd80b0715a2d911a0afea"
, tv_subPubPubs = [ (0, "xpub6ASuArnXKPbfEVRpCesNx4P939HDXENHkksgxsVG1yNp9958A33qYoPiTN9QrJmWFa2jNLdK84bWmyqTSPGtApP8P7nHUYwxHPhqmzUyeFG") ]
, tv_subPrvPrvs = [ (0, "xprv9wTYmMFdV23N21MM6dLNavSQV7Sj7meSPXx6AV5eTdqqGLjycVjb115Ec5LgRAXscPZgy5G4jQ9csyyZLN3PZLxoM1h3BoPuEJzsgeypdKj")
, (0 + 0x80000000, "xprv9wTYmMFmpgaLB5Hge4YtaGqCKpsYPTD9vXWSsmdZrNU3Y2i4WoBykm6ZteeCLCCZpGxdHQuqEhM6Gdo2X6CVrQiTw6AAneF9WSkA9ewaxtS") ]
}
, tv $ TV { tv_name = "m/44'/0'/0'/0"
, tv_depth = 4
, tv_fingerp = 0x31bf9083
, tv_index = 0
, tv_chain = "6dd51cfd6f41ad9d1edf007727a683a2cd317524e43bf30b5cd1a2035c1041cf"
, tv_xpub = "xpub6Du7UxgPt9xyZsijCkstyy1MEuR6SZbAh3MaaE1yvKesdKSygQKqfYLzVxdhoPeRwwTLwpEnjzMqVMb5NYvazx56sxNCRoExGNY1VNMqsSD"
, tv_pub = "03073cdc669834931577d21319e4414523ce32a638b4ae42eb4ace8ed3dac683b5"
, tv_xprv = "xprv9zum5T9W3nQgMPeG6jLtcq4cgsac36sKKpRymqcNMz7tkX7q8s1b7k2WegNtWCo91gRjnSZANnsMGLhjsofsQfVtuSLQdfeH48gDNosBAHk"
, tv_prv = "65e96c73a30bcb815fc0f0a5694a0ead061034eba030d1b82991dff1f9b68519"
, tv_subPubPubs = [ (0, "xpub6FqQEmsqnmQYh8vkY8NsHUygAjSbfXCCXFzWYe2GHG3mL4ng9Ned6kEKHN4LpNQW3CwZAsnfgoj7VcqrbXoXiAUXz1bZdsam9QzP9RWjR2u") ]
, tv_subPrvPrvs = [ (0, "xprvA2r3qGLwxPrFUerHS6qrvM2wchc7G4UMA34ukFceivWnTGTXbqLNYwuqS8nkbm7SjvgNSiHumkYLur27kjdnGZexAtiC6Ha4SNr7Wpeoz2V") ]
}
]
data TV = TV
{ tv_name :: String
, tv_depth :: Word8
, tv_fingerp :: Word32
, tv_index :: Word32
, tv_chain :: B.ByteString -- ^ Expected chain code in lower-case hexadecimal
, tv_xpub :: B.ByteString -- ^ Base58-serialized XPub
, tv_pub :: B.ByteString -- ^ Expected public key in lower-case hexadecimal
, tv_xprv :: B.ByteString -- ^ Base58-serialized XPrv
, tv_prv :: B.ByteString -- ^ Expected private key in lower-case hexadecimal
, tv_subPubPubs :: [(Word32, B.ByteString)] -- ^ Pub->Pub Base58 subkeys with index
, tv_subPrvPrvs :: [(Word32, B.ByteString)] -- ^ Prv->Prv Base58 subkeys with index
}
tv :: TV -> TestTree
tv x = testGroup (tv_name x)
[ testCase "chain" $ do
Just (tv_chain x) @=? fmap (toBase16 . S.unChain)
(S.chain (fromBase16 (tv_chain x)))
, testCase "prv" $ do
Just (tv_prv x) @=? fmap (toBase16 . S.unPrv)
(S.prv (fromBase16 (tv_prv x)))
, testCase "pub" $ do
Just (tv_pub x) @=? fmap (toBase16 . S.unPub)
(S.pub (fromBase16 (tv_pub x)))
, testCase "xprvToXPub" $ do
let Just xprv = S.decodeXPrv (tv_xprv x)
Just xpub = S.decodeXPub (tv_xpub x)
xpub @=? S.xprvToXPub S.version_xpub xprv
, testCase "xprv" $ do
Just xprv@(S.XPrv v d f i c k) <- pure $ S.decodeXPrv (tv_xprv x)
S.encodeXPrv xprv @?= tv_xprv x
v @?= S.version_xprv
d @?= S.Depth (tv_depth x)
f @?= S.Fingerprint (tv_fingerp x)
i @?= S.Index (tv_index x)
Just c @?= S.chain (fromBase16 ((tv_chain x)))
Just k @?= S.prv (fromBase16 (tv_prv x))
, testCase "xpub" $ do
Just xpub@(S.XPub v d f i c k) <- pure $ S.decodeXPub (tv_xpub x)
S.encodeXPub xpub @?= tv_xpub x
v @?= S.version_xpub
d @?= S.Depth (tv_depth x)
f @?= S.Fingerprint (tv_fingerp x)
i @?= S.Index (tv_index x)
Just c @?= S.chain (fromBase16 ((tv_chain x)))
Just k @?= S.pub (fromBase16 (tv_pub x))
, testCase "subPubPub" $ do
let Just xpub0@(S.XPub v0 d0 _ _ _ _) = S.decodeXPub (tv_xpub x)
for_ (tv_subPubPubs x) $ \(i1w, xpub1B) -> do
let i1 = S.Index i1w
Just xpub1@(S.XPub v1 d1 _ i1' _ _) = S.subXPubXPub xpub0 i1
v1 @?= v0
d1 @?= S.Depth (1 + S.unDepth d0)
i1' @?= i1
S.encodeXPub xpub1 @?= xpub1B
, testCase "subPrvPrv" $ do
let Just xprv0@(S.XPrv v0 d0 _ _ _ _) = S.decodeXPrv (tv_xprv x)
for_ (tv_subPrvPrvs x) $ \(i1w, xprv1B) -> do
let i1 = S.Index i1w
Just xprv1@(S.XPrv v1 d1 _ i1' _ _) = S.subXPrvXPrv xprv0 i1
v1 @?= v0
d1 @?= S.Depth (1 + S.unDepth d0)
i1' @?= i1
S.encodeXPrv xprv1 @?= xprv1B
]
--------------------------------------------------------------------------------
genIndex :: MonadGen m => m S.Index
genIndex = S.Index <$> Gen.word32 Range.constantBounded
genIndexNormal :: MonadGen m => m S.Index
genIndexNormal = S.Index <$> Gen.word32 (Range.constant 0 (0x80000000 - 1))
genIndexHardened :: MonadGen m => m S.Index
genIndexHardened = S.Index <$> Gen.word32 (Range.constant 0x80000000 maxBound)
genXPub :: MonadGen m => m S.XPub
genXPub = S.XPub <$> genVersion
<*> genDepth <*> genFingerprint
<*> genIndex <*> genChain <*> genPub
genXPrv :: MonadGen m => m S.XPrv
genXPrv = S.XPrv <$> genVersion
<*> genDepth <*> genFingerprint
<*> genIndex <*> genChain <*> genPrv
genVersion :: MonadGen m => m S.Version
genVersion = S.Version <$> Gen.word32 Range.constantBounded
genFingerprint :: MonadGen m => m S.Fingerprint
genFingerprint = S.Fingerprint <$> Gen.word32 Range.constantBounded
genDepth :: MonadGen m => m S.Depth
genDepth = S.Depth <$> Gen.word8 Range.constantBounded
genChain :: MonadGen m => m S.Chain
genChain = do
b <- Gen.bytes (Range.singleton 32)
let Just c = S.chain b
pure c
genPrv :: MonadGen m => m S.Prv
genPrv = do
b <- Gen.bytes (Range.singleton 32)
let Just k = S.prv b
pure k
genPub :: MonadGen m => m S.Pub
genPub = go 10000 where
go 0 = error "genPub: too many attempts"
go n = do
h <- Gen.element [2, 3 :: Word8]
b <- Gen.bytes (Range.singleton 32)
case S.pub (B.cons h b) of
Just k -> pure k
Nothing -> go (n - 1)
--------------------------------------------------------------------------------
toBase16 :: B.ByteString -> B.ByteString
toBase16 = B16.encode
fromBase16 :: B.ByteString -> B.ByteString
fromBase16 a = case B16.decode a of
(b, "") -> b
_ -> error ("Invalid base16 string: " <> show a)