bip32 (empty) → 0.1
raw patch · 7 files changed
+1196/−0 lines, 7 filesdep +basedep +base16-bytestringdep +base58-bytestring
Dependencies added: base, base16-bytestring, base58-bytestring, binary, bip32, bytestring, cryptonite, hedgehog, memory, secp256k1-haskell, tasty, tasty-hedgehog, tasty-hunit
Files
- CHANGELOG.md +3/−0
- LICENSE +219/−0
- README.md +7/−0
- bip32.cabal +48/−0
- lib/BIP32.hs +468/−0
- lib/BIP32/GHC.hs +132/−0
- test/Main.hs +319/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+# Version 0.1++* Initial version.
+ LICENSE view
@@ -0,0 +1,219 @@+Copyright 2020, Renzo Carbonara.++Except where otherwise explicitly mentioned, all of contents of the+"bip32" project are licensed under the Apache License,+Version 2.0 (the "License"); you may not use this file except in+compliance with the License. You may obtain a copy of the License at the+end of this file or at http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+++-------------------------------------------------------------------------------+++ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright [yyyy] [name of copyright owner]++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.
+ README.md view
@@ -0,0 +1,7 @@+# bip32++Haskell implementation of the BIP-0032 standard: Hierarchical Deterministic+Wallets, for Bitcoin and other cryptocurrencies.++Based on the specification+at [BIP-0032](https://github.com/bitcoin/bips/blob/master/bip-0032.mediawiki).
+ bip32.cabal view
@@ -0,0 +1,48 @@+cabal-version: 2.4+name: bip32+version: 0.1+license: Apache-2.0+license-file: LICENSE+extra-source-files: README.md CHANGELOG.md+author: Renzo Carbonara+maintainer: renλren.zone+copyright: Copyright (c) Renzo Carbonara 2020+category: Cryptography+build-type: Simple+synopsis: BIP-0032: Hierarchical Deterministic Wallets for Bitcoin and other cryptocurrencies+description: BIP-0032: Hierarchical Deterministic Wallets for Bitcoin and other cryptocurrencies+homepage: https://gitlab.com/k0001/hs-bip32+bug-reports: https://gitlab.com/k0001/hs-bip32/issues+tested-with: GHC == 8.8.3, GHC == 8.6.5, GHCJS == 8.6.0++common basic+ default-language: Haskell2010+ ghc-options: -O2 -Wall -Werror=incomplete-patterns+ ghcjs-options: -O3 -Wall -Werror=incomplete-patterns+ build-depends: base == 4.*, bytestring, base58-bytestring, binary++library+ import: basic+ hs-source-dirs: lib+ exposed-modules: BIP32+ if impl(ghcjs)+ -- TODO+ buildable: False+ -- other-modules: BIP32.GHCJS+ -- build-depends: ghcjs-base+ else+ other-modules: BIP32.GHC+ build-depends: cryptonite, memory, secp256k1-haskell++test-suite test+ import: basic+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ build-depends:+ base16-bytestring,+ hedgehog,+ bip32,+ tasty,+ tasty-hedgehog,+ tasty-hunit,
+ lib/BIP32.hs view
@@ -0,0 +1,468 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}++-- | [BIP-0032](https://github.com/bitcoin/bips/blob/master/bip-0032.mediawiki)+-- Hierarchical Deterministic Wallets, for bitcoin and other cryptocurrencies.+module BIP32+ ( -- * Base58 serialization+ encodeXPrv+ , encodeXPub+ , decodeXPrv+ , decodeXPub+ , decode++ -- * Raw serialization+ , encodeXPrvRaw+ , encodeXPubRaw+ , decodeXPrvRaw+ , decodeXPubRaw+ , decodeRaw++ -- * Private key+ , XPrv(..)+ , xprvToXPub+ , I.Prv+ , I.prv+ , I.unPrv+ , I.prvToPub++ -- * Public key+ , XPub(..)+ , I.Pub+ , I.pub+ , I.unPub++ -- * Chain code+ , Chain+ , chain+ , unChain++ -- * Derivation path+ , Index(..)+ , indexIsHardened++ -- * Subkeys+ , subXPubXPub+ , subXPrvXPrv+ , subXPrvXPub+ -- ** Bare+ , subPubPub+ , subPrvPrv+ , subPrvPub++ -- * Depth+ , Depth(..)++ -- * Fingerprint+ , Fingerprint(..)+ , fingerprint++ -- * Version+ , Version(..)+ -- ** Example versions+ , version_xprv+ , version_xpub+ , version_tprv+ , version_tpub+ , version_Ltpv+ , version_Ltub+ , version_ttpv+ , version_ttub+ ) where++import Control.Applicative+import Control.Monad+import Data.Bits+import qualified Data.Binary.Get as Bin+import qualified Data.ByteString as B+import qualified Data.ByteString.Base58 as B58+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Lazy as BL+import Data.Word+++#ifdef ghcjs_HOST_OS+import qualified BIP32.GHCJS as I+#else+import qualified BIP32.GHC as I+#endif++--------------------------------------------------------------------------------++-- | Extended private key.+data XPrv = XPrv !Version !Depth !Fingerprint !Index !Chain !I.Prv+ deriving (Eq, Show)++-- | Obtain the 'XPub' corresponding to a particular 'XPrv', at a particular+-- 'Version'.+xprvToXPub :: Version -> XPrv -> XPub+xprvToXPub v (XPrv _ d f i c prv) = XPub v d f i c (I.prvToPub prv)++--------------------------------------------------------------------------------++-- | Extended private key.+data XPub = XPub !Version !Depth !Fingerprint !Index !Chain !I.Pub+ deriving (Eq, Show)++--------------------------------------------------------------------------------++-- | The 33-byte serialized contents of either 'I.Pub' or 'I.Prv'.+newtype Key = Key B.ByteString++keyPub :: I.Pub -> Key+{-# INLINE keyPub #-}+keyPub = Key . I.unPub++keyPrv :: I.Prv -> Key+{-# INLINE keyPrv #-}+keyPrv = Key . B.cons 0 . I.unPrv++--------------------------------------------------------------------------------++-- | Version bytes.+newtype Version = Version { unVersion :: Word32 }+ deriving (Eq, Show)++-- | @0x0488ade4@, “xprv”, Bitcoin mainnet private.+version_xprv :: Version+version_xprv = Version 0x0488ade4+{-# INLINE version_xprv #-}++-- | @0x0488b21e@, “xpub”, Bitcoin mainnet public.+version_xpub :: Version+version_xpub = Version 0x0488b21e+{-# INLINE version_xpub #-}++-- | @0x04358394@, “tprv”, Bitcoin testnet private.+version_tprv :: Version+version_tprv = Version 0x04358394+{-# INLINE version_tprv #-}++-- | @0x043587cf@, “tpub”, Bitcoin testnet public.+version_tpub :: Version+version_tpub = Version 0x043587cf+{-# INLINE version_tpub #-}++-- | @0x019d9cfe@, “Ltpv”, Litecoin mainnet private.+version_Ltpv :: Version+version_Ltpv = Version 0x019d9cfe+{-# INLINE version_Ltpv #-}++-- | @0x019da462@, “Ltub”, Litecoin mainnet public.+version_Ltub :: Version+version_Ltub = Version 0x019da462+{-# INLINE version_Ltub #-}++-- | @0x0436ef7d@, “ttpv”, Litecoin testnet private.+version_ttpv :: Version+version_ttpv = Version 0x0436ef7d+{-# INLINE version_ttpv #-}++-- | @0x0436f6e1@, “ttub”, Litecoin testnet public.+version_ttub :: Version+version_ttub = Version 0x0436f6e1+{-# INLINE version_ttub #-}++--------------------------------------------------------------------------------++-- | Derivation path depth.+--+-- * @0@ for master nodes — @m@+--+-- * @1@ for level-1 derived keys — @m\/0'@, or @m\/13@, or …+--+-- * @2@ for level-2 derived keys — @m\/0'\/28@, or @m\/44'/0'@, or …+--+-- * … up to @255@.+newtype Depth = Depth { unDepth :: Word8 }+ deriving (Eq, Show)++depthNext :: Depth -> Maybe Depth+{-# INLINE depthNext #-}+depthNext (Depth w) = do+ guard (w /= 0xFF)+ pure (Depth (w + 1))++--------------------------------------------------------------------------------++-- | 4-byte fingerprint of a 'I.Pub' key.+newtype Fingerprint = Fingerprint { unFingerprint :: Word32 }+ deriving (Eq, Show)++fingerprint :: I.Pub -> Fingerprint+{-# INLINE fingerprint #-}+fingerprint = fingerprint' . keyId++fingerprint' :: KeyId -> Fingerprint+{-# INLINE fingerprint' #-}+fingerprint' (KeyId x) =+ let b = B.take 4 x :: B.ByteString+ in Fingerprint $! unsafeShiftL (fromIntegral (B.index b 0)) 24 .|.+ unsafeShiftL (fromIntegral (B.index b 1)) 16 .|.+ unsafeShiftL (fromIntegral (B.index b 2)) 8 .|.+ fromIntegral (B.index b 3)++--------------------------------------------------------------------------------++-- | 20-byte key identifier.+newtype KeyId = KeyId B.ByteString++keyId :: I.Pub -> KeyId+{-# INLINE keyId #-}+keyId = KeyId . I.ripemd160 . I.sha256 . I.unPub++--------------------------------------------------------------------------------++-- | Chain code.+--+-- Construct with 'chain'.+newtype Chain = Chain B.ByteString+ deriving (Eq)++instance Show Chain where+ showsPrec n (Chain b) = showParen (n > 10) $+ showString "Chain " .+ showsPrec 0 (BB.toLazyByteString (BB.byteStringHex b))++-- | Construct a 'Chain' code.+--+-- See Bitcoin's [BIP-0032](https://github.com/bitcoin/bips/blob/master/bip-0032.mediawiki)+-- for details.+--+-- 'Nothing' if the 'B.ByteString' length is not 32.+chain :: B.ByteString -> Maybe Chain+{-# INLINE chain #-}+chain x = do+ guard (B.length x == 32)+ Just (Chain x)++-- | Obtain the 32 raw bytes inside a 'Chain'.+unChain :: Chain -> B.ByteString+{-# INLINE unChain #-}+unChain (Chain x) = x++--------------------------------------------------------------------------------++-- | A derivation path 'Index'.+newtype Index = Index Word32+ deriving (Eq, Ord, Show)++-- | Whether a derivation path 'Index' is hardened. That is, \(2^{31}\) or+-- larger.+indexIsHardened :: Index -> Bool+{-# INLINE indexIsHardened #-}+indexIsHardened (Index w) = w >= 0x80000000++--------------------------------------------------------------------------------++-- | Derive a child 'XPrv' subkey from a parent a parent 'XPrv' key.+--+-- Returns 'Nothing' if the given inputs result in an invalid key.+subXPrvXPrv :: XPrv -> Index -> Maybe XPrv+subXPrvXPrv (XPrv v d0 _ _ ch0 prv0) i1 = do+ d1 <- depthNext d0+ (ch1, prv1) <- subPrvPrv ch0 prv0 i1+ let f1 = fingerprint (I.prvToPub prv0)+ pure $ XPrv v d1 f1 i1 ch1 prv1++-- | Derive a child 'XPub' subkey from a parent a parent 'XPub' key.+--+-- The given 'Index' is expected to /not/ be hardened.+--+-- Returns 'Nothing' if the given inputs result in an invalid key.+subXPubXPub :: XPub -> Index -> Maybe XPub+subXPubXPub (XPub v d0 _ _ ch0 pub0) i1 = do+ d1 <- depthNext d0+ (ch1, pub1) <- subPubPub ch0 pub0 i1+ let f1 = fingerprint pub0+ pure $ XPub v d1 f1 i1 ch1 pub1++-- | Derive a child 'XPub' subkey from a parent a parent 'XPrv' key.+--+-- Notice that while @'subXPubXPub' ('xprvToXPub' v) xprv i@ will fail with a+-- hardened 'Index', @'subXPrvXPub' v xprv i@ may succeed.+--+-- Returns 'Nothing' if the given inputs result in an invalid key.+subXPrvXPub :: Version -> XPrv -> Index -> Maybe XPub+subXPrvXPub v xprv i1 = xprvToXPub v <$> subXPrvXPrv xprv i1++--------------------------------------------------------------------------------++-- | Derive a child 'I.Prv' subkey and 'Chain' code at a particular 'Index' from+-- a parent 'I.Prv' and 'Chain' code.+--+-- Returns 'Nothing' if the given inputs result in an invalid key.+subPrvPrv :: Chain -> I.Prv -> Index -> Maybe (Chain, I.Prv)+subPrvPrv (Chain ch0) prv0 i1@(Index i1w) = do+ let pub0 = I.prvToPub prv0+ x = I.hmacSHA512 ch0 $ mconcat $ if indexIsHardened i1+ then [B.singleton 0, I.unPrv prv0, word32BE i1w]+ else [I.unPub pub0, word32BE i1w]+ (xl, xr) = B.splitAt 32 x+ prv1 <- I.addPrvTweak prv0 =<< I.tweak xl+ ch1 <- chain xr+ pure (ch1, prv1)++-- | Derive a child 'I.Pub' subkey and 'Chain' code at a particular 'Index' from+-- a parent 'I.Pub' and 'Chain' code.+--+-- The given 'Index' is expected to /not/ be hardened.+--+-- Returns 'Nothing' if the given inputs result in an invalid key.+subPubPub :: Chain -> I.Pub -> Index -> Maybe (Chain, I.Pub)+subPubPub (Chain ch0) pub0 i1@(Index i1w) = do+ guard (not (indexIsHardened i1))+ let x = I.hmacSHA512 ch0 (I.unPub pub0 <> word32BE i1w)+ (xl, xr) = B.splitAt 32 x+ pub1 <- I.addPubTweak pub0 =<< I.tweak xl+ ch1 <- chain xr+ pure (ch1, pub1)++-- | Derive a child 'I.Pub' subkey and 'Chain' code at a particular 'Index' from+-- a parent 'I.Prv' and 'Chain' code.+--+-- Notice that while @'subPubPub' ('I.prvToPub' prv) i@ will fail with a+-- hardened 'Index', @'subPrvPub' prv i@ may succeed.+--+-- Returns 'Nothing' if the given inputs result in an invalid key.+subPrvPub :: Chain -> I.Prv -> Index -> Maybe (Chain, I.Pub)+subPrvPub ch0 prv0 i1 = fmap I.prvToPub <$> subPrvPrv ch0 prv0 i1++--------------------------------------------------------------------------------++-- | Obtain the Base58 representation for an 'XPub'.+--+-- It can be either 111 or 112 bytes in length, and when rendered as ASCII it+-- looks something like this:+--+-- @+-- xpub661MyMwAqRbcFtXgS5sYJABqqG9YLmC4Q1Rdap9gSE8NqtwybGhePY2gZ29ESFjqJoCu1Rupje8YtGqsefD265TMg7usUDFdp6W1EGMcet8+-- @+encodeXPub :: XPub -> B.ByteString+{-# INLINE encodeXPub #-}+encodeXPub a = base58EncodeWithChecksum (encodeXPubRaw a)++-- | Obtain the Base58 representation for an 'XPrv'.+--+-- It can be either 111 or 112 bytes in length, and when rendered as ASCII it+-- looks something like this:+--+-- @+-- xprv9s21ZrQH143K3QTDL4LXw2F7HEK3wJUD2nW2nRk4stbPy6cq3jPPqjiChkVvvNKmPGJxWUtg6LnF5kejMRNNU3TGtRBeJgk33yuGBxrMPHi+-- @+encodeXPrv :: XPrv -> B.ByteString+{-# INLINE encodeXPrv #-}+encodeXPrv a = base58EncodeWithChecksum (encodeXPrvRaw a)++base58EncodeWithChecksum :: B.ByteString -> B.ByteString+{-# INLINE base58EncodeWithChecksum #-}+base58EncodeWithChecksum a =+ B58.encodeBase58 B58.bitcoinAlphabet (a <> checksum32 a)++--------------------------------------------------------------------------------++-- | Encode the 78 raw 'XPub' bytes.+encodeXPubRaw :: XPub -> B.ByteString+{-# INLINE encodeXPubRaw #-}+encodeXPubRaw (XPub v d f i c p) = encodeRaw v d f i c (keyPub p)++-- | Encode the 78 raw 'XPrv' bytes.+encodeXPrvRaw :: XPrv -> B.ByteString+{-# INLINE encodeXPrvRaw #-}+encodeXPrvRaw (XPrv v d f i c p) = encodeRaw v d f i c (keyPrv p)++-- | Encode the 78 raw extended key bytes.+encodeRaw+ :: Version -> Depth -> Fingerprint -> Index -> Chain -> Key -> B.ByteString+encodeRaw (Version v) (Depth d) (Fingerprint f) (Index i) (Chain c) (Key k) =+ BL.toStrict $ BB.toLazyByteString $+ BB.word32BE v <>+ BB.word8 d <>+ BB.word32BE f <>+ BB.word32BE i <>+ BB.byteString c <>+ BB.byteString k++--------------------------------------------------------------------------------++-- | Decode the Base58-encoded 'XPub' representation. See 'encodeXPub'.+decodeXPub :: B.ByteString -> Maybe XPub+{-# INLINE decodeXPub #-}+decodeXPub = decodeXPubRaw <=< base58DecodeWithChecksum++-- | Decode the Base58-encoded 'XPrv' representation. See 'encodeXPrv'.+decodeXPrv :: B.ByteString -> Maybe XPrv+{-# INLINE decodeXPrv #-}+decodeXPrv = decodeXPrvRaw <=< base58DecodeWithChecksum++-- | Decode the Base58-encoded representation of either and 'XPub' or an 'XPub'.+decode :: B.ByteString -> Maybe (Either XPub XPrv)+{-# INLINE decode #-}+decode = decodeRaw <=< base58DecodeWithChecksum++base58DecodeWithChecksum :: B.ByteString -> Maybe B.ByteString+{-# INLINE base58DecodeWithChecksum #-}+base58DecodeWithChecksum = \a -> do+ b <- B58.decodeBase58 B58.bitcoinAlphabet a+ guard (B.length b == 78 + 4)+ let (raw, ch) = B.splitAt 78 b+ guard (ch == checksum32 raw)+ pure raw++--------------------------------------------------------------------------------++-- | Decode the 78 raw 'XPub' bytes.+decodeXPubRaw :: B.ByteString -> Maybe XPub+{-# INLINE decodeXPubRaw #-}+decodeXPubRaw = either Just (\_ -> Nothing) <=< decodeRaw++-- | Decode the 78 raw 'XPrv' bytes.+decodeXPrvRaw :: B.ByteString -> Maybe XPrv+{-# INLINE decodeXPrvRaw #-}+decodeXPrvRaw = either (\_ -> Nothing) Just <=< decodeRaw++-- | Encode the 78 raw 'XPub' or 'XPrv' bytes.+decodeRaw :: B.ByteString -> Maybe (Either XPub XPrv)+decodeRaw = \b -> do+ guard (B.length b == 78)+ case Bin.runGetOrFail getX (BL.fromStrict b) of+ Right (lo, 78, ex) | BL.null lo -> Just ex+ _ -> Nothing++getX :: Bin.Get (Either XPub XPrv)+getX = do+ v <- Version <$> Bin.getWord32be+ d <- Depth <$> Bin.getWord8+ f <- Fingerprint <$> Bin.getWord32be+ i <- Index <$> Bin.getWord32be+ c <- Chain <$> Bin.getByteString 32+ ek <- fmap Left getPub <|> fmap Right getPrv+ pure $ case ek of+ Left k -> Left (XPub v d f i c k)+ Right k -> Right (XPrv v d f i c k)++getPrv :: Bin.Get I.Prv+getPrv = do+ 0 <- Bin.getWord8+ a <- Bin.getByteString 32+ case I.prv a of+ Just b -> pure b+ Nothing -> fail "Bad private key"++getPub :: Bin.Get I.Pub+getPub = do+ a <- Bin.getByteString 33+ case I.pub a of+ Just b -> pure b+ Nothing -> fail "Bad public key"++--------------------------------------------------------------------------------++word32BE :: Word32 -> B.ByteString -- ^ 4 bytes.+{-# INLINE word32BE #-}+word32BE = BL.toStrict . BB.toLazyByteString . BB.word32BE++checksum32 :: B.ByteString -> B.ByteString -- ^ 4 bytes.+{-# INLINE checksum32 #-}+checksum32 = B.take 4 . I.sha256 . I.sha256
+ lib/BIP32/GHC.hs view
@@ -0,0 +1,132 @@+-- | Implementation to be used when compiled with GHC+module BIP32.GHC+ ( Prv+ , prv+ , unPrv+ , prvToPub+ , addPrvTweak++ , Pub+ , pub+ , unPub+ , addPubTweak++ , Tweak+ , tweak++ , hmacSHA512+ , ripemd160+ , sha256+ ) where++import Control.Monad+import qualified Crypto.Hash as Hash+import qualified Crypto.MAC.HMAC as HMAC+import qualified Crypto.Secp256k1 as K+import qualified Data.ByteArray as BA+import qualified Data.ByteString as B++--------------------------------------------------------------------------------++-- | Private key.+--+-- Construct with 'prv'.+newtype Prv = Prv K.SecKey+ deriving (Eq, Show)++-- | Obtain the 32 raw bytes inside a 'Prv'. See 'prv'.+unPrv :: Prv -> B.ByteString+{-# INLINE unPrv #-}+unPrv (Prv x) = K.getSecKey x++-- | Construct a 'Prv' key from its raw bytes.+--+-- * 32 bytes containing \(ser_{256}(k)\).+--+-- See Bitcoin's [BIP-0032](https://github.com/bitcoin/bips/blob/master/bip-0032.mediawiki)+-- for details.+--+-- 'Nothing' if something is not satisfied.+prv :: B.ByteString -> Maybe Prv+{-# INLINE prv #-}+prv x = Prv <$> K.secKey x++-- | Obtain the 'Pub' key for 'Prv'.+prvToPub :: Prv -> Pub+{-# INLINE prvToPub #-}+prvToPub (Prv x) = Pub (K.derivePubKey x)++-- | Tweak a 'Prv'ate key by adding 'Tweak' times the generator to it.+addPrvTweak :: Prv -> Tweak -> Maybe Prv+{-# INLINE addPrvTweak #-}+addPrvTweak (Prv p) (Tweak t) = Prv <$> K.tweakAddSecKey p t++--------------------------------------------------------------------------------++-- | Public key.+--+-- Construct with 'pub'.+newtype Pub = Pub K.PubKey+ deriving (Eq, Show)++-- | Obtain the 33 raw bytes inside a 'Pub'. See 'pub'.+--+-- Corresponds to BIP-0032's \(ser_{P}(P)\).+unPub :: Pub -> B.ByteString+{-# INLINE unPub #-}+unPub (Pub x) = K.exportPubKey True x++-- | Construct a 'Pub' key from its raw bytes.+--+-- * 33 bytes in total, containing \(ser_{P}(P)\).+--+-- * The leftmost byte is either @0x02@ or @0x03@, depending on the parity+-- of the omitted @y@ coordinate.+--+-- * The remaining 32 bytes are \(ser_{256}(x)\).+--+-- See Bitcoin's [BIP-0032](https://github.com/bitcoin/bips/blob/master/bip-0032.mediawiki)+-- for details.+--+-- 'Nothing' if something is not satisfied.+pub :: B.ByteString -> Maybe Pub+{-# INLINE pub #-}+pub x = do+ guard (B.length x == 33)+ Pub <$> K.importPubKey x++-- | Tweak a 'Pub'lic key by adding 'Tweak' times the generator to it.+addPubTweak :: Pub -> Tweak -> Maybe Pub+{-# INLINE addPubTweak #-}+addPubTweak (Pub p) (Tweak t) = Pub <$> K.tweakAddPubKey p t++--------------------------------------------------------------------------------++newtype Tweak = Tweak K.Tweak++-- | Convert a 32-Byte 'B.ByteString' to a 'Tweak'.+tweak :: B.ByteString -> Maybe Tweak+{-# INLINE tweak #-}+tweak x = Tweak <$> K.tweak x++--------------------------------------------------------------------------------++hmacSHA512+ :: B.ByteString -- ^ Key.+ -> B.ByteString -- ^ Data to hash.+ -> B.ByteString -- ^ 64-byte long digest.+{-# INLINE hmacSHA512 #-}+hmacSHA512 k d = BA.convert (HMAC.hmac k d :: HMAC.HMAC Hash.SHA512)++ripemd160+ :: B.ByteString -- ^ Data to hash.+ -> B.ByteString -- ^ 20-byte long digest.+{-# INLINE ripemd160 #-}+ripemd160 d = BA.convert (Hash.hash d :: Hash.Digest Hash.RIPEMD160)++sha256+ :: B.ByteString -- ^ Data to hash.+ -> B.ByteString -- ^ 32-byte long digest.+{-# INLINE sha256 #-}+sha256 d = BA.convert (Hash.hash d :: Hash.Digest Hash.SHA256)+
+ test/Main.hs view
@@ -0,0 +1,319 @@+{-# 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 10000))+ $ 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+ True === isJust (S.subXPubXPub xpub' i1n)++ , testProperty "subPubPub with hardended index" $ property $ do+ xpub :: S.XPub <- forAll genXPub+ ih :: S.Index <- forAll genIndexHardened+ Nothing === S.subXPubXPub xpub ih+{-+ , testCase "subPubPub invalid" $ do+ xpub = S.XPub (S.Version 0+ 97 ┃ xpub :: S.XPub <- forAll genXPub+ ┃ │ XPub+ ┃ │ Version { unVersion = 0 }+ ┃ │ Depth { unDepth = 255 }+ ┃ │ Fingerprint { unFingerprint = 0 }+ ┃ │ (Index 0)+ ┃ │ (Chain+ ┃ │ "6161616161616161616161616161616161616161616161616161616161616161")+ ┃ │ (Pub+ ┃ │ "02616161616161616161616161616161616161616161687762686f616973786477")+ 98 ┃ ih :: S.Index <- forAll genIndexNormal+ ┃ │ Index 894862002+-}+ , 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 = 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 -> genPub++--------------------------------------------------------------------------------++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)++