slip32 (empty) → 0.1
raw patch · 6 files changed
+814/−0 lines, 6 filesdep +basedep +base16-bytestringdep +bech32
Dependencies added: base, base16-bytestring, bech32, binary, bytestring, hedgehog, slip32, tasty, tasty-hedgehog, tasty-hunit, text
Files
- CHANGELOG.md +3/−0
- LICENSE +219/−0
- README.md +6/−0
- lib/SLIP32.hs +295/−0
- slip32.cabal +41/−0
- test/Main.hs +250/−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+"slip32" 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,6 @@+# slip32++Haskell implementation of the SLIP-0032 standard: Extended serialization format for BIP-32 wallets.++Based on the [draft SLIP-0032 spec](https://github.com/satoshilabs/slips/blob/71a3549388022820e77aa1f44c80d0f412e5529f/slip-0032.md).+
+ lib/SLIP32.hs view
@@ -0,0 +1,295 @@+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}++-- | SLIP-0032 is an extended serialization format+-- for [BIP-0032](https://github.com/bitcoin/bips/blob/master/bip-0032.mediawiki)+-- wallets+--+-- Implementation based on+-- the [draft SLIP-0032 spec](https://github.com/satoshilabs/slips/blob/71a3549388022820e77aa1f44c80d0f412e5529f/slip-0032.md).+module SLIP32+ ( -- * Parsing+ parse+ , parseXPub+ , parseXPrv+ -- ** Text+ , parseText+ , parseXPubText+ , parseXPrvText++ -- * Rendering+ , renderXPub+ , renderXPrv+ -- ** Text+ , renderXPubText+ , renderXPrvText++ -- * Public key+ , XPub(..)+ , Pub+ , pub+ , unPub++ -- * Private key+ , XPrv(..)+ , Prv+ , prv+ , unPrv++ -- * Path+ , Path+ , path+ , unPath++ -- * Chain+ , Chain+ , chain+ , unChain+ ) where++import Control.Monad+import qualified Codec.Binary.Bech32 as Bech32+import qualified Data.Binary.Get as Bin+import qualified Data.ByteString as B+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Data.Word++--------------------------------------------------------------------------------++-- | Extended public key.+data XPub = XPub !Path !Chain !Pub+ deriving (Eq, Show)++-- | Extended private key.+data XPrv = XPrv !Path !Chain !Prv+ deriving (Eq, Show)++-- | Derivation path.+--+-- Construct with 'path'.+data Path = Path !Word8 ![Word32]+ deriving (Eq, Show)++-- | Obtains the derivation path as a list of up to 255 elements.+unPath :: Path -> [Word32]+unPath (Path _ x) = x++-- | Construct a derivation 'Path'.+--+-- Hardened keys start from \(2^{31}\).+--+-- @+-- m = 'path' []+-- m\/0 = 'path' [0]+-- m\/0' = 'path' [0 + 2^31]+-- m\/1 = 'path' [1]+-- m\/1' = 'path' [1 + 2^31]+-- m\/0'/1/2'/2 = 'path' [0 + 2^31, 1, 2 + 2^31, 2]+-- @+--+-- See Bitcoin's [BIP-0032](https://github.com/bitcoin/bips/blob/master/bip-0032.mediawiki)+-- for details.+--+-- Returns 'Nothing' if the list length is more than 255.+path :: [Word32] -> Maybe Path+{-# INLINE path #-}+path x | l < 256 = Just (Path (fromIntegral l) x)+ | otherwise = Nothing+ where l = length x++-- | Chain code.+--+-- Construct with 'chain'.+newtype Chain = Chain B.ByteString+ deriving (Eq, Show)++-- | Obtain the 32 raw bytes inside a 'Chain'.+unChain :: Chain -> B.ByteString+{-# INLINE unChain #-}+unChain (Chain x) = x++-- | 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 | B.length x == 32 = Just (Chain x)+ | otherwise = Nothing++-- | Private key.+--+-- Construct with 'prv'.+newtype Prv = Prv B.ByteString+ deriving (Eq, Show)++-- | Obtain the 33 raw bytes inside a 'Prv'. See 'prv'.+unPrv :: Prv -> B.ByteString+{-# INLINE unPrv #-}+unPrv (Prv x) = x++-- | Construct a 'Prv' key from its raw bytes.+--+-- * 33 bytes in total.+--+-- * The leftmost byte is @0x00@.+--+-- * The remaining 32 bytes are \(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 | B.length x == 33 && B.head x == 0 = Just (Prv x)+ | otherwise = Nothing++-- | Public key.+--+-- Construct with 'pub'.+newtype Pub = Pub B.ByteString+ deriving (Eq, Show)++-- | Obtain the 33 raw bytes inside a 'Pub'. See 'pub'.+unPub :: Pub -> B.ByteString+{-# INLINE unPub #-}+unPub (Pub x) = 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 | B.length x == 33 && (h == 2 || h == 3) = Just (Pub x)+ | otherwise = Nothing+ where h = B.head x++--------------------------------------------------------------------------------++-- | Parse an 'XPub' from its SLIP-0032 representation.+parseXPub :: B.ByteString -> Maybe XPub+{-# INLINE parseXPub #-}+parseXPub = parseXPubText <=< hush . T.decodeUtf8'++-- | Parse an 'XPrv' from its SLIP-0032 representation.+parseXPrv :: B.ByteString -> Maybe XPrv+{-# INLINE parseXPrv #-}+parseXPrv = parseXPrvText <=< hush . T.decodeUtf8'++-- | Parse either an 'XPub' or an 'XPrv' from its SLIP-0032 representation.+parse :: B.ByteString -> Maybe (Either XPub XPrv)+{-# INLINE parse #-}+parse = parseText <=< hush . T.decodeUtf8'++--------------------------------------------------------------------------------++-- | Parse an 'XPub' from its SLIP-0032 representation.+--+-- Like 'parseXPub', but takes 'T.Text'.+parseXPubText :: T.Text -> Maybe XPub+{-# INLINE parseXPubText #-}+parseXPubText = either Just (\_ -> Nothing) <=< parseText++-- | Parse an 'XPrv' from its SLIP-0032 representation.+--+-- Like 'parseXPrv', but takes 'T.Text'.+parseXPrvText :: T.Text -> Maybe XPrv+{-# INLINE parseXPrvText #-}+parseXPrvText = either (\_ -> Nothing) Just <=< parseText++-- | Parse either an 'XPub' or an 'XPrv' from its SLIP-0032 representation.+--+-- Like 'parse', but takes 'T.Text'.+parseText :: T.Text -> Maybe (Either XPub XPrv)+parseText = \t0 -> do+ (hrp, dp) <- hush $ Bech32.decodeLenient t0+ raw <- Bech32.dataPartToBytes dp+ case Bin.runGetOrFail getRawSLIP32 (BL.fromStrict raw) of+ Right (lo, _, out@(Left _)) | BL.null lo && hrp == hrpXPub -> Just out+ Right (lo, _, out@(Right _)) | BL.null lo && hrp == hrpXPrv -> Just out+ _ -> Nothing++getRawSLIP32 :: Bin.Get (Either XPub XPrv)+getRawSLIP32 = do+ depth <- Bin.getWord8+ pa <- Path depth <$> replicateM (fromIntegral depth) Bin.getWord32be+ cc <- Chain <$> Bin.getByteString 32+ kd <- Bin.getByteString 33+ case pub kd of+ Just k -> pure (Left (XPub pa cc k))+ Nothing -> case prv kd of+ Just k -> pure (Right (XPrv pa cc k))+ Nothing -> fail "Bad key prefix"++--------------------------------------------------------------------------------++-- | Render an 'XPub' using the SLIP-0032 encoding.+renderXPub :: XPub -> B.ByteString+{-# INLINE renderXPub #-}+renderXPub = T.encodeUtf8 . renderXPubText++-- | Render an 'XPub' using the SLIP-0032 encoding.+renderXPrv :: XPrv -> B.ByteString+{-# INLINE renderXPrv #-}+renderXPrv = T.encodeUtf8 . renderXPrvText++--------------------------------------------------------------------------------++-- | Render an 'XPub' using the SLIP-0032 encoding.+--+-- The rendered 'T.Text' is ASCII compatible.+renderXPubText :: XPub -> T.Text+{-# INLINE renderXPubText #-}+renderXPubText = \(XPub p c (Pub k)) -> renderText hrpXPub p c (Key k)++-- | Render an 'XPub' using the SLIP-0032 encoding.+--+-- The rendered 'T.Text' is ASCII compatible.+renderXPrvText :: XPrv -> T.Text+{-# INLINE renderXPrvText #-}+renderXPrvText = \(XPrv p c (Prv k)) -> renderText hrpXPrv p c (Key k)++-- | The contents of either 'XPub' or 'XPrv'.+newtype Key = Key B.ByteString++-- | Render either an 'XPub' or an 'XPrv' using the SLIP-0032 encoding.+--+-- The rendered 'T.Text' is ASCII compatible.+renderText :: Bech32.HumanReadablePart -> Path -> Chain -> Key -> T.Text+renderText hrp (Path pl p) (Chain c) (Key k)+ = Bech32.encodeLenient hrp $ Bech32.dataPartFromBytes+ $ BL.toStrict $ BB.toLazyByteString+ $ BB.word8 pl <>+ foldMap BB.word32BE p <>+ BB.byteString c <>+ BB.byteString k++--------------------------------------------------------------------------------++hrpXPub :: Bech32.HumanReadablePart+Right hrpXPub = Bech32.humanReadablePartFromText "xpub"++hrpXPrv :: Bech32.HumanReadablePart+Right hrpXPrv = Bech32.humanReadablePartFromText "xprv"++--------------------------------------------------------------------------------++hush :: Either a b -> Maybe b+{-# INLINE hush #-}+hush = either (\_ -> Nothing) Just
+ slip32.cabal view
@@ -0,0 +1,41 @@+cabal-version: 2.4+name: slip32+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: SLIP-0032: Extended serialization format for BIP-32 wallets+description: SLIP-0032: Extended serialization format for BIP-32 wallets+homepage: https://gitlab.com/k0001/hs-slip32+bug-reports: https://gitlab.com/k0001/hs-slip32/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, text,++library+ import: basic+ hs-source-dirs: lib+ exposed-modules: SLIP32+ build-depends: bech32, binary,++test-suite test+ import: basic+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ build-depends:+ base16-bytestring,+ hedgehog,+ slip32,+ tasty,+ tasty-hedgehog,+ tasty-hunit,
+ test/Main.hs view
@@ -0,0 +1,250 @@+{-# LANGUAGE OverloadedStrings #-}+{-# 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.Text.Encoding as T+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, Range, property, forAll, (===))+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++import qualified SLIP32 as S++--------------------------------------------------------------------------------++main :: IO ()+main = Tasty.defaultMainWithIngredients+ [ Tasty.consoleTestReporter+ , Tasty.listingTests+ ] $ Tasty.localOption (HedgehogTestLimit (Just 1000))+ $ tt++tt :: TestTree+tt = testGroup "SLIP32"+ [ tt_vectors++ , testProperty "roundtrip" $ property $ do+ path <- forAll $ genPath Range.constantBounded+ chain <- forAll genChain++ prv <- forAll genPrv+ let xprv = S.XPrv path chain prv+ xprvB = S.renderXPrv xprv+ xprvT = S.renderXPrvText xprv+ xprvB === T.encodeUtf8 xprvT+ xprvT === T.decodeUtf8 xprvB+ Just xprv === S.parseXPrv xprvB+ Just xprv === S.parseXPrvText xprvT+ Just (Right xprv) === S.parse xprvB+ Just (Right xprv) === S.parseText xprvT++ pub <- forAll genPub+ let xpub = S.XPub path chain pub+ xpubB = S.renderXPub xpub+ xpubT = S.renderXPubText xpub+ xpubB === T.encodeUtf8 xpubT+ xpubT === T.decodeUtf8 xpubB+ Just xpub === S.parseXPub xpubB+ Just xpub === S.parseXPubText xpubT+ Just (Left xpub) === S.parse xpubB+ Just (Left xpub) === S.parseText xpubT+ ]++tt_vectors :: TestTree+tt_vectors = testGroup "Test vectors"+ [ tv $ TV { tv_pathD = "m"+ , tv_path = []+ , tv_pathR = ""+ , tv_chain = "7923408dadd3c7b56eed15567707ae5e5dca089de972e07f3b860450e2a3b70e"+ , tv_xprv = "xprv1qpujxsyd4hfu0dtwa524vac84e09mjsgnh5h9crl8wrqg58z5wmsuqqcxlqmar3fjhkprndzkpnp2xlze76g4hu7g7c4r4r2m2e6y8xlvu566tn6"+ , tv_prv = "001837c1be8e2995ec11cda2b066151be2cfb48adf9e47b151d46adab3a21cdf67"+ , tv_xpub = "xpub1qpujxsyd4hfu0dtwa524vac84e09mjsgnh5h9crl8wrqg58z5wmsuq7eqte474swq3cvvvcncumfz6xe6l0j6jdl990an7mukyyuemsyjszuwypl"+ , tv_pub = "03d902f35f560e0470c63313c7369168d9d7df2d49bf295fd9fb7cb109ccee0494"+ }+ , tv $ TV { tv_pathD = "m/0"+ , tv_path = [0]+ , tv_pathR = ""+ , tv_chain = "e0e6503ac057cf5dc76e0735e56dd44d193b2e9e271cc2d46bc759c99b021e3c"+ , tv_xprv = "xprv1qyqqqqqqurn9qwkq2l84m3mwqu672mw5f5vnkt57yuwv94rtcavunxczrc7qpw4gn29a6cw9ug4e7yrqrkrerj0cl39jlfkln45dxdhsavpmqm4krfqykk"+ , tv_prv = "00baa89a8bdd61c5e22b9f10601d8791c9f8fc4b2fa6df9d68d336f0eb03b06eb6"+ , tv_xpub = "xpub1qyqqqqqqurn9qwkq2l84m3mwqu672mw5f5vnkt57yuwv94rtcavunxczrc7qxa4l2v75k923p75lgyjtdeyxzmc8m6709mcvlvv9ehz22aj9pdr4m6lwmk"+ , tv_pub = "0376bf533d4b15510fa9f4124b6e48616f07debcf2ef0cfb185cdc4a576450b475"+ }++ , tv $ TV { tv_pathD = "m/1"+ , tv_path = [1]+ , tv_pathR = "00000001"+ , tv_chain = "5c48917d6838b666aeb11eac7c4f98f807779b57c7522e38509719eeb1e7a592"+ , tv_prv = "00c1beaff0c4db984670a40c69c2947b9d33cd7f6e749c67e1fcb5c6118dda1282"+ , tv_pub = "02ea2649b3512b9a859ab658a85e2989a7ae39b2518877b2dc0f2b44b785d5788d"+ , tv_xprv = "xprv1qyqqqqqpt3yfzltg8zmxdt43r6k8cnuclqrh0x6hcafzuwzsjuv7av085kfqpsd74lcvfkucgec2grrfc228h8fne4lkuayuvlsledwxzxxa5y5zefalyg"+ , tv_xpub = "xpub1qyqqqqqpt3yfzltg8zmxdt43r6k8cnuclqrh0x6hcafzuwzsjuv7av085kfq963xfxe4z2u6skdtvk9gtc5cnfaw8xe9rzrhktwq726yk7za27ydw88adn"+ }+ , tv $ TV { tv_pathD = "m/0'"+ , tv_path = [0 + 2^31]+ , tv_pathR = "80000000"+ , tv_chain = "f1c03f5ff97108912fd56761d3fada8879e4173aba45f10da4bbd94b1c497160"+ , tv_prv = "00c08cf331996482c06db3d259ff99be4bf7083824d53185e33191ee7ceb2bf96f"+ , tv_pub = "027f1d87730e460e921b382242911565bf93daf2081ed685b2edd1d01176b2c13c"+ , tv_xprv = "xprv1qxqqqqqq78qr7hlewyyfzt74vasa87k63pu7g9e6hfzlzrdyh0v5k8zfw9sqpsyv7vcejeyzcpkm85jel7vmujlhpquzf4f3sh3nry0w0n4jh7t0jhc039"+ , tv_xpub = "xpub1qxqqqqqq78qr7hlewyyfzt74vasa87k63pu7g9e6hfzlzrdyh0v5k8zfw9sqylcasaesu3swjgdnsgjzjy2kt0unmteqs8kkskewm5wsz9mt9sfuvlxj6p"+ }+ , tv $ TV { tv_pathD = "m/1'"+ , tv_path = [1 + 2^31]+ , tv_pathR = "80000001"+ , tv_chain = "43cc4bca59c666a5f79265148125802ed2cec46df1c5ca8e6a058dab525a73f1"+ , tv_prv = "003ef02fc53000742891fc90458ba9edc8363d8f1f267e326b1078710c7db34de5"+ , tv_pub = "03b5184a526dac6abda3d8d54a541471ce83e8c2260d56706053e2780922319f5e"+ , tv_xprv = "xprv1qxqqqqqpg0xyhjjecen2taujv52gzfvq9mfva3rd78zu4rn2qkx6k5j6w0csq0hs9lznqqr59zgleyz93w57mjpk8k837fn7xf43q7r3p37mxn095hysnx"+ , tv_xpub = "xpub1qxqqqqqpg0xyhjjecen2taujv52gzfvq9mfva3rd78zu4rn2qkx6k5j6w0cs8dgcfffxmtr2hk3a34222s28rn5rarpzvr2kwps98cncpy3rr867k5u83k"+ }+ , tv $ TV { tv_pathD = "m/44'/0'/0'"+ , tv_path = [44 + 2^31, 0 + 2^31, 0 + 2^31]+ , tv_pathR = "8000002c8000000080000000"+ , tv_chain = "3da4bc190a2680111d31fadfdc905f2a7f6ce77c6f109919116f253d43445219"+ , tv_prv = "00fe64af825b5b78554c33a28b23085fc082f691b3c712cc1d4e66e133297da87a"+ , tv_pub = "03774c910fcf07fa96886ea794f0d5caed9afe30b44b83f7e213bb92930e7df4bd"+ , tv_xprv = "xprv1qwqqqqpvsqqqqqyqqqqqq0dyhsvs5f5qzywnr7klmjg972nldnnhcmcsnyv3zme984p5g5seqrlxftuztddhs42vxw3gkgcgtlqg9a53k0r39nqafenwzvef0k585enml6g"+ , tv_xpub = "xpub1qwqqqqpvsqqqqqyqqqqqq0dyhsvs5f5qzywnr7klmjg972nldnnhcmcsnyv3zme984p5g5seqdm5eyg0eurl495gd6nefux4etke4l3sk39c8alzzwae9ycw0h6t6ltmssr"+ }+ , tv $ TV { tv_pathD = "m/44'/0'/1'"+ , tv_path = [44 + 2^31, 0 + 2^31, 1 + 2^31]+ , tv_pathR = "8000002c8000000080000001"+ , tv_chain = "2971fa2db0ff5d69e166a406813aa3d9ed09c4adac2e0ce33523da8c5609f4f4"+ , tv_prv = "008855dfda37fe663bffc0136618504e3cbd7d992134609cef6191c729339d5c65"+ , tv_pub = "025d0261853d4c3a379160fb51d2f262ac64e65219139982c4e2180bcef1a233d9"+ , tv_xprv = "xprv1qwqqqqpvsqqqqqyqqqqqz2t3lgkmpl6ad8skdfqxsya28k0dp8z2mtpwpn3n2g7633tqna85qzy9th76xllxvwllcqfkvxzsfc7t6lveyy6xp880vxguw2fnn4wx2mhtjy8"+ , tv_xpub = "xpub1qwqqqqpvsqqqqqyqqqqqz2t3lgkmpl6ad8skdfqxsya28k0dp8z2mtpwpn3n2g7633tqna85qfwsycv984xr5du3vra4r5hjv2kxfejjryfenqkyugvqhnh35geajlgxhp0"+ }+ , tv $ TV { tv_pathD = "m/44'/2'/0'"+ , tv_path = [44 + 2^31, 2 + 2^31, 0 + 2^31]+ , tv_pathR = "8000002c8000000280000000"+ , tv_chain = "869c5045e5fc789646babcd1961b101bc31e75fe50df8a585c79b05dca0ac758"+ , tv_prv = "00983cd10d8d14160b10b9a4bb63207e9585054a3133619d57b78ea9d5aa3046d2"+ , tv_pub = "0340fe3b8e89165258bac0cb711613c618d1af63dc321a90b751d0697301441bcc"+ , tv_xprv = "xprv1qwqqqqpvsqqqqq5qqqqqpp5u2pz7tlrcjert40x3jcd3qx7rre6lu5xl3fv9c7dsth9q436cqzvre5gd352pvzcshxjtkceq062c2p22xyekr82hk782n4d2xprdysp4gxc"+ , tv_xpub = "xpub1qwqqqqpvsqqqqq5qqqqqpp5u2pz7tlrcjert40x3jcd3qx7rre6lu5xl3fv9c7dsth9q436cqdq0uwuw3yt9yk96cr9hz9snccvdrtmrmsep4y9h28gxjucpgsducuj4f9r"+ }+ , tv $ TV { tv_pathD = "m/49'/0'/0'"+ , tv_path = [49 + 2^31, 0 + 2^31, 0 + 2^31]+ , tv_pathR = "800000318000000080000000"+ , tv_chain = "6eaae365ae0e0a0aab84325cfe7cd76c3b909035f889e7d3f1b847a9a0797ecb"+ , tv_prv = "00880d51752bda4190607e079588d3f644d96bfa03446bce93cddfda3c4a99c7e6"+ , tv_pub = "02f1f347891b20f7568eae3ec9869fbfb67bcab6f358326f10ecc42356bd55939d"+ , tv_xprv = "xprv1qwqqqqp3sqqqqqyqqqqqqm42udj6urs2p24cgvjule7dwmpmjzgrt7yfulflrwz84xs8jlktqzyq65t490dyryrq0cretzxn7ezdj6l6qdzxhn5neh0a50z2n8r7vumvllf"+ , tv_xpub = "xpub1qwqqqqp3sqqqqqyqqqqqqm42udj6urs2p24cgvjule7dwmpmjzgrt7yfulflrwz84xs8jlktqtclx3ufrvs0w45w4clvnp5lh7m8hj4k7dvrymcsanzzx44a2kfe6xynfgh"+ }+ , tv $ TV { tv_pathD = "m/49'/2'/0'"+ , tv_path = [49 + 2^31, 2 + 2^31, 0 + 2^31]+ , tv_pathR = "800000318000000280000000"+ , tv_chain = "67b7e1dc5c70a93504218ccf40c47ad46d4a9c858196376ce0e853aca7be0498"+ , tv_prv = "00cf222cc2e097049fe2ca76626c19c7e7a3ef971b1f64195758ab3c832463fcf4"+ , tv_pub = "02b07388bd2edaba3c0a2c0856716fd7c9965d212fb2736f7b925f57d922b10ace"+ , tv_xprv = "xprv1qwqqqqp3sqqqqq5qqqqqqeahu8w9cu9fx5zzrrx0grz844rdf2wgtqvkxakwp6zn4jnmupycqr8jytxzuztsf8lzefmxymqecln68muhrv0kgx2htz4neqeyv070gg6dcn7"+ , tv_xpub = "xpub1qwqqqqp3sqqqqq5qqqqqqeahu8w9cu9fx5zzrrx0grz844rdf2wgtqvkxakwp6zn4jnmupycq2c88z9a9mdt50q29sy9vut06lyevhfp97e8xmmmjf040kfzky9vu2pu92u"+ }+ , tv $ TV { tv_pathD = "m/84'/0'/0'"+ , tv_path = [84 + 2^31, 0 + 2^31, 0 + 2^31]+ , tv_pathR = "800000548000000080000000"+ , tv_chain = "4a53a0ab21b9dc95869c4e92a161194e03c0ef3ff5014ac692f433c4765490fc"+ , tv_prv = "00e14f274d16ca0d91031b98b162618061d03930fa381af6d4caf44b01819ab6d4"+ , tv_pub = "02707a62fdacc26ea9b63b1c197906f56ee0180d0bcf1966e1a2da34f5f3a09a9b"+ , tv_xprv = "xprv1qwqqqqz5sqqqqqyqqqqqqjjn5z4jrwwujkrfcn5j59s3jnsrcrhnlagpftrf9apnc3m9fy8uqrs57f6dzm9qmygrrwvtzcnpspsaqwfslgup4ak5et6ykqvpn2mdggeaxrp"+ , tv_xpub = "xpub1qwqqqqz5sqqqqqyqqqqqqjjn5z4jrwwujkrfcn5j59s3jnsrcrhnlagpftrf9apnc3m9fy8uqfc85cha4npxa2dk8vwpj7gx74hwqxqdp083jehp5tdrfa0n5zdfkg3lp00"+ }+ ]++data TV = TV+ { tv_pathD :: String+ , tv_path :: [Word32] -- ^ Derivation path.+ , tv_pathR :: B.ByteString -- ^ Derivation path in lower-case hexadecimal.+ , tv_chain :: B.ByteString -- ^ Expected chain code in lower-case hexadecimal.+ , tv_xprv :: B.ByteString -- ^ Raw SLIP-0032 extended private key.+ , tv_prv :: B.ByteString -- ^ Expected private key in lower-case hexadecimal.+ , tv_xpub :: B.ByteString -- ^ Raw SLIP-0032 extended public key.+ , tv_pub :: B.ByteString -- ^ Expected public key in lower-case hexadecimal.+ }++tv :: TV -> TestTree+tv x = testGroup (tv_pathD x)+ [ testCase "path" $ do+ fmap S.unPath (S.path (tv_path x)) @?= Just (tv_path 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 "xprv" $ do+ Just xprv@(S.XPrv p c k) <- pure $ S.parseXPrv (tv_xprv x)+ S.parse (tv_xprv x) @?= Just (Right xprv)+ S.unPath p @?= tv_path x+ toBase16 (S.unChain c) @?= tv_chain x+ toBase16 (S.unPrv k) @?= tv_prv x+ S.renderXPrv xprv @?= tv_xprv x++ , testCase "xpub" $ do+ Just xpub@(S.XPub p c k) <- pure $ S.parseXPub (tv_xpub x)+ S.parse (tv_xpub x) @?= Just (Left xpub)+ S.unPath p @?= tv_path x+ toBase16 (S.unChain c) @?= tv_chain x+ toBase16 (S.unPub k) @?= tv_pub x+ S.renderXPub xpub @?= tv_xpub x+ ]++--------------------------------------------------------------------------------++genPath :: MonadGen m => Range Word8 -> m S.Path+genPath r = do+ ws <- Gen.list (fmap fromIntegral r) (Gen.word32 (Range.constantBounded))+ let Just p = S.path ws+ pure p++genChain :: MonadGen m => m S.Chain+genChain = do+ b <- Gen.bytes (Range.singleton 32)+ let Just c = S.chain b+ pure c++genPub :: MonadGen m => m S.Pub+genPub = do+ h <- Gen.element [2, 3 :: Word8]+ b <- Gen.bytes (Range.singleton 32)+ let Just k = S.pub (B.cons h b)+ pure k++genPrv :: MonadGen m => m S.Prv+genPrv = do+ b <- Gen.bytes (Range.singleton 32)+ let Just k = S.prv (B.cons 0 b)+ pure k++--------------------------------------------------------------------------------++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"++