slip32 0.1 → 0.2
raw patch · 4 files changed
+147/−156 lines, 4 filesdep +bip32
Dependencies added: bip32
Files
- CHANGELOG.md +18/−0
- lib/SLIP32.hs +79/−117
- slip32.cabal +3/−3
- test/Main.hs +47/−36
CHANGELOG.md view
@@ -1,3 +1,21 @@+# Version 0.2++* COMPILER ASSISTED BREAKING CHANGE — Not exported anymore: `Pub`, `pub`,+ `unPub`, `Prv`, `prv`, `unPrv`, `Chain`, `chain`, `unChain`. These types are+ now available in the `bip32` library.++* BREAKING CHANGE POSSIBLY REQUIRING HUMAN INTERVENTION — `prv` and `unPrv` from+ the `bip32` library deal with `32`-byte long `ByteString`s now, rather than+ `33` bytes as before. The leading `0x00` byte has now been dropped.++* BREAKING CHANGE: `Path` now deals with values of type `Index` from the `bip32`+ library, rather than `Word32`.++* Depend on the `bip32` library.++* Builds on GHCJS.++ # Version 0.1 * Initial version.
lib/SLIP32.hs view
@@ -3,15 +3,20 @@ -- | SLIP-0032 is an extended serialization format -- for [BIP-0032](https://github.com/bitcoin/bips/blob/master/bip-0032.mediawiki)--- wallets+-- wallets. ----- Implementation based on+-- This implementation is based on -- the [draft SLIP-0032 spec](https://github.com/satoshilabs/slips/blob/71a3549388022820e77aa1f44c80d0f412e5529f/slip-0032.md).+--+-- Please refer to the "BIP32" module from+-- the [bip32 library](https://hackage.haskell.org/package/bip32) to+-- find more about 'A.Pub', 'A.Prv', 'A.Index', 'A.Chain', etc. module SLIP32 ( -- * Parsing parse , parseXPub , parseXPrv+ -- ** Text , parseText , parseXPubText@@ -26,27 +31,18 @@ -- * Public key , XPub(..)- , Pub- , pub- , unPub -- * Private key , XPrv(..)- , Prv- , prv- , unPrv -- * Path , Path , path , unPath-- -- * Chain- , Chain- , chain- , unChain ) where +import qualified BIP32 as A+import Control.Applicative import Control.Monad import qualified Codec.Binary.Bech32 as Bech32 import qualified Data.Binary.Get as Bin@@ -60,21 +56,21 @@ -------------------------------------------------------------------------------- -- | Extended public key.-data XPub = XPub !Path !Chain !Pub+data XPub = XPub !Path !A.Chain !A.Pub deriving (Eq, Show) -- | Extended private key.-data XPrv = XPrv !Path !Chain !Prv+data XPrv = XPrv !Path !A.Chain !A.Prv deriving (Eq, Show) -- | Derivation path. -- -- Construct with 'path'.-data Path = Path !Word8 ![Word32]+data Path = Path !Word8 ![A.Index] deriving (Eq, Show) -- | Obtains the derivation path as a list of up to 255 elements.-unPath :: Path -> [Word32]+unPath :: Path -> [A.Index] unPath (Path _ x) = x -- | Construct a derivation 'Path'.@@ -94,92 +90,12 @@ -- for details. -- -- Returns 'Nothing' if the list length is more than 255.-path :: [Word32] -> Maybe Path+path :: [A.Index] -> 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.@@ -225,18 +141,49 @@ Right (lo, _, out@(Right _)) | BL.null lo && hrp == hrpXPrv -> Just out _ -> Nothing +--------------------------------------------------------------------------------+ getRawSLIP32 :: Bin.Get (Either XPub XPrv) getRawSLIP32 = do+ pa <- getPath+ cc <- getChain+ fmap (Left . XPub pa cc) getPub <|> fmap (Right . XPrv pa cc) getPrv++getPath :: Bin.Get Path+{-# INLINE getPath #-}+getPath = 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"+ Path depth <$> replicateM (fromIntegral depth) getIndex +getIndex :: Bin.Get A.Index+{-# INLINE getIndex #-}+getIndex = A.Index <$> Bin.getWord32be++getChain :: Bin.Get A.Chain+{-# INLINE getChain #-}+getChain = do+ a <- Bin.getByteString 32+ case A.chain a of+ Just b -> pure b+ Nothing -> fail "Bad chain code"++getPrv :: Bin.Get A.Prv+{-# INLINE getPrv #-}+getPrv = do+ 0 <- Bin.getWord8+ a <- Bin.getByteString 32+ case A.prv a of+ Just b -> pure b+ Nothing -> fail "Bad private key"++getPub :: Bin.Get A.Pub+{-# INLINE getPub #-}+getPub = do+ a <- Bin.getByteString 33+ case A.pub a of+ Just b -> pure b+ Nothing -> fail "Bad public key"+ -------------------------------------------------------------------------------- -- | Render an 'XPub' using the SLIP-0032 encoding.@@ -256,29 +203,44 @@ -- 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)+renderXPubText = \(XPub p c k) -> renderText hrpXPub p c (keyPub 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)+renderXPrvText = \(XPrv p c k) -> renderText hrpXPrv p c (keyPrv k) --- | The contents of either 'XPub' or 'XPrv'.+--------------------------------------------------------------------------------++-- | The 33-byte serialized contents of either 'A.Pub' or 'A.Prv'. newtype Key = Key B.ByteString +keyPub :: A.Pub -> Key+{-# INLINE keyPub #-}+keyPub = Key . A.unPub++keyPrv :: A.Prv -> Key+{-# INLINE keyPrv #-}+keyPrv = Key . B.cons 0 . A.unPrv++--------------------------------------------------------------------------------+ -- | 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+renderText :: Bech32.HumanReadablePart -> Path -> A.Chain -> Key -> T.Text+renderText hrp (Path pl p) c (Key k)+ = Bech32.encodeLenient hrp+ $ Bech32.dataPartFromBytes+ $ BL.toStrict+ $ BB.toLazyByteString+ $ mconcat [ BB.word8 pl+ , foldMap BB.word32BE (fmap (\(A.Index w) -> w) p)+ , BB.byteString (A.unChain c)+ , BB.byteString k ]+ --------------------------------------------------------------------------------
slip32.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: slip32-version: 0.1+version: 0.2 license: Apache-2.0 license-file: LICENSE extra-source-files: README.md CHANGELOG.md@@ -19,13 +19,13 @@ default-language: Haskell2010 ghc-options: -O2 -Wall -Werror=incomplete-patterns ghcjs-options: -O3 -Wall -Werror=incomplete-patterns- build-depends: base == 4.*, bytestring, text,+ build-depends: base == 4.*, bip32, bytestring, text library import: basic hs-source-dirs: lib exposed-modules: SLIP32- build-depends: bech32, binary,+ build-depends: bech32, binary test-suite test import: basic
test/Main.hs view
@@ -16,6 +16,7 @@ import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range +import qualified BIP32 as A import qualified SLIP32 as S --------------------------------------------------------------------------------@@ -65,7 +66,7 @@ , tv_pathR = "" , tv_chain = "7923408dadd3c7b56eed15567707ae5e5dca089de972e07f3b860450e2a3b70e" , tv_xprv = "xprv1qpujxsyd4hfu0dtwa524vac84e09mjsgnh5h9crl8wrqg58z5wmsuqqcxlqmar3fjhkprndzkpnp2xlze76g4hu7g7c4r4r2m2e6y8xlvu566tn6"- , tv_prv = "001837c1be8e2995ec11cda2b066151be2cfb48adf9e47b151d46adab3a21cdf67"+ , tv_prv = "1837c1be8e2995ec11cda2b066151be2cfb48adf9e47b151d46adab3a21cdf67" , tv_xpub = "xpub1qpujxsyd4hfu0dtwa524vac84e09mjsgnh5h9crl8wrqg58z5wmsuq7eqte474swq3cvvvcncumfz6xe6l0j6jdl990an7mukyyuemsyjszuwypl" , tv_pub = "03d902f35f560e0470c63313c7369168d9d7df2d49bf295fd9fb7cb109ccee0494" }@@ -74,7 +75,7 @@ , tv_pathR = "" , tv_chain = "e0e6503ac057cf5dc76e0735e56dd44d193b2e9e271cc2d46bc759c99b021e3c" , tv_xprv = "xprv1qyqqqqqqurn9qwkq2l84m3mwqu672mw5f5vnkt57yuwv94rtcavunxczrc7qpw4gn29a6cw9ug4e7yrqrkrerj0cl39jlfkln45dxdhsavpmqm4krfqykk"- , tv_prv = "00baa89a8bdd61c5e22b9f10601d8791c9f8fc4b2fa6df9d68d336f0eb03b06eb6"+ , tv_prv = "baa89a8bdd61c5e22b9f10601d8791c9f8fc4b2fa6df9d68d336f0eb03b06eb6" , tv_xpub = "xpub1qyqqqqqqurn9qwkq2l84m3mwqu672mw5f5vnkt57yuwv94rtcavunxczrc7qxa4l2v75k923p75lgyjtdeyxzmc8m6709mcvlvv9ehz22aj9pdr4m6lwmk" , tv_pub = "0376bf533d4b15510fa9f4124b6e48616f07debcf2ef0cfb185cdc4a576450b475" }@@ -83,7 +84,7 @@ , tv_path = [1] , tv_pathR = "00000001" , tv_chain = "5c48917d6838b666aeb11eac7c4f98f807779b57c7522e38509719eeb1e7a592"- , tv_prv = "00c1beaff0c4db984670a40c69c2947b9d33cd7f6e749c67e1fcb5c6118dda1282"+ , tv_prv = "c1beaff0c4db984670a40c69c2947b9d33cd7f6e749c67e1fcb5c6118dda1282" , tv_pub = "02ea2649b3512b9a859ab658a85e2989a7ae39b2518877b2dc0f2b44b785d5788d" , tv_xprv = "xprv1qyqqqqqpt3yfzltg8zmxdt43r6k8cnuclqrh0x6hcafzuwzsjuv7av085kfqpsd74lcvfkucgec2grrfc228h8fne4lkuayuvlsledwxzxxa5y5zefalyg" , tv_xpub = "xpub1qyqqqqqpt3yfzltg8zmxdt43r6k8cnuclqrh0x6hcafzuwzsjuv7av085kfq963xfxe4z2u6skdtvk9gtc5cnfaw8xe9rzrhktwq726yk7za27ydw88adn"@@ -92,7 +93,7 @@ , tv_path = [0 + 2^31] , tv_pathR = "80000000" , tv_chain = "f1c03f5ff97108912fd56761d3fada8879e4173aba45f10da4bbd94b1c497160"- , tv_prv = "00c08cf331996482c06db3d259ff99be4bf7083824d53185e33191ee7ceb2bf96f"+ , tv_prv = "c08cf331996482c06db3d259ff99be4bf7083824d53185e33191ee7ceb2bf96f" , tv_pub = "027f1d87730e460e921b382242911565bf93daf2081ed685b2edd1d01176b2c13c" , tv_xprv = "xprv1qxqqqqqq78qr7hlewyyfzt74vasa87k63pu7g9e6hfzlzrdyh0v5k8zfw9sqpsyv7vcejeyzcpkm85jel7vmujlhpquzf4f3sh3nry0w0n4jh7t0jhc039" , tv_xpub = "xpub1qxqqqqqq78qr7hlewyyfzt74vasa87k63pu7g9e6hfzlzrdyh0v5k8zfw9sqylcasaesu3swjgdnsgjzjy2kt0unmteqs8kkskewm5wsz9mt9sfuvlxj6p"@@ -101,7 +102,7 @@ , tv_path = [1 + 2^31] , tv_pathR = "80000001" , tv_chain = "43cc4bca59c666a5f79265148125802ed2cec46df1c5ca8e6a058dab525a73f1"- , tv_prv = "003ef02fc53000742891fc90458ba9edc8363d8f1f267e326b1078710c7db34de5"+ , tv_prv = "3ef02fc53000742891fc90458ba9edc8363d8f1f267e326b1078710c7db34de5" , tv_pub = "03b5184a526dac6abda3d8d54a541471ce83e8c2260d56706053e2780922319f5e" , tv_xprv = "xprv1qxqqqqqpg0xyhjjecen2taujv52gzfvq9mfva3rd78zu4rn2qkx6k5j6w0csq0hs9lznqqr59zgleyz93w57mjpk8k837fn7xf43q7r3p37mxn095hysnx" , tv_xpub = "xpub1qxqqqqqpg0xyhjjecen2taujv52gzfvq9mfva3rd78zu4rn2qkx6k5j6w0cs8dgcfffxmtr2hk3a34222s28rn5rarpzvr2kwps98cncpy3rr867k5u83k"@@ -110,7 +111,7 @@ , tv_path = [44 + 2^31, 0 + 2^31, 0 + 2^31] , tv_pathR = "8000002c8000000080000000" , tv_chain = "3da4bc190a2680111d31fadfdc905f2a7f6ce77c6f109919116f253d43445219"- , tv_prv = "00fe64af825b5b78554c33a28b23085fc082f691b3c712cc1d4e66e133297da87a"+ , tv_prv = "fe64af825b5b78554c33a28b23085fc082f691b3c712cc1d4e66e133297da87a" , tv_pub = "03774c910fcf07fa96886ea794f0d5caed9afe30b44b83f7e213bb92930e7df4bd" , tv_xprv = "xprv1qwqqqqpvsqqqqqyqqqqqq0dyhsvs5f5qzywnr7klmjg972nldnnhcmcsnyv3zme984p5g5seqrlxftuztddhs42vxw3gkgcgtlqg9a53k0r39nqafenwzvef0k585enml6g" , tv_xpub = "xpub1qwqqqqpvsqqqqqyqqqqqq0dyhsvs5f5qzywnr7klmjg972nldnnhcmcsnyv3zme984p5g5seqdm5eyg0eurl495gd6nefux4etke4l3sk39c8alzzwae9ycw0h6t6ltmssr"@@ -119,7 +120,7 @@ , tv_path = [44 + 2^31, 0 + 2^31, 1 + 2^31] , tv_pathR = "8000002c8000000080000001" , tv_chain = "2971fa2db0ff5d69e166a406813aa3d9ed09c4adac2e0ce33523da8c5609f4f4"- , tv_prv = "008855dfda37fe663bffc0136618504e3cbd7d992134609cef6191c729339d5c65"+ , tv_prv = "8855dfda37fe663bffc0136618504e3cbd7d992134609cef6191c729339d5c65" , tv_pub = "025d0261853d4c3a379160fb51d2f262ac64e65219139982c4e2180bcef1a233d9" , tv_xprv = "xprv1qwqqqqpvsqqqqqyqqqqqz2t3lgkmpl6ad8skdfqxsya28k0dp8z2mtpwpn3n2g7633tqna85qzy9th76xllxvwllcqfkvxzsfc7t6lveyy6xp880vxguw2fnn4wx2mhtjy8" , tv_xpub = "xpub1qwqqqqpvsqqqqqyqqqqqz2t3lgkmpl6ad8skdfqxsya28k0dp8z2mtpwpn3n2g7633tqna85qfwsycv984xr5du3vra4r5hjv2kxfejjryfenqkyugvqhnh35geajlgxhp0"@@ -128,7 +129,7 @@ , tv_path = [44 + 2^31, 2 + 2^31, 0 + 2^31] , tv_pathR = "8000002c8000000280000000" , tv_chain = "869c5045e5fc789646babcd1961b101bc31e75fe50df8a585c79b05dca0ac758"- , tv_prv = "00983cd10d8d14160b10b9a4bb63207e9585054a3133619d57b78ea9d5aa3046d2"+ , tv_prv = "983cd10d8d14160b10b9a4bb63207e9585054a3133619d57b78ea9d5aa3046d2" , tv_pub = "0340fe3b8e89165258bac0cb711613c618d1af63dc321a90b751d0697301441bcc" , tv_xprv = "xprv1qwqqqqpvsqqqqq5qqqqqpp5u2pz7tlrcjert40x3jcd3qx7rre6lu5xl3fv9c7dsth9q436cqzvre5gd352pvzcshxjtkceq062c2p22xyekr82hk782n4d2xprdysp4gxc" , tv_xpub = "xpub1qwqqqqpvsqqqqq5qqqqqpp5u2pz7tlrcjert40x3jcd3qx7rre6lu5xl3fv9c7dsth9q436cqdq0uwuw3yt9yk96cr9hz9snccvdrtmrmsep4y9h28gxjucpgsducuj4f9r"@@ -137,7 +138,7 @@ , tv_path = [49 + 2^31, 0 + 2^31, 0 + 2^31] , tv_pathR = "800000318000000080000000" , tv_chain = "6eaae365ae0e0a0aab84325cfe7cd76c3b909035f889e7d3f1b847a9a0797ecb"- , tv_prv = "00880d51752bda4190607e079588d3f644d96bfa03446bce93cddfda3c4a99c7e6"+ , tv_prv = "880d51752bda4190607e079588d3f644d96bfa03446bce93cddfda3c4a99c7e6" , tv_pub = "02f1f347891b20f7568eae3ec9869fbfb67bcab6f358326f10ecc42356bd55939d" , tv_xprv = "xprv1qwqqqqp3sqqqqqyqqqqqqm42udj6urs2p24cgvjule7dwmpmjzgrt7yfulflrwz84xs8jlktqzyq65t490dyryrq0cretzxn7ezdj6l6qdzxhn5neh0a50z2n8r7vumvllf" , tv_xpub = "xpub1qwqqqqp3sqqqqqyqqqqqqm42udj6urs2p24cgvjule7dwmpmjzgrt7yfulflrwz84xs8jlktqtclx3ufrvs0w45w4clvnp5lh7m8hj4k7dvrymcsanzzx44a2kfe6xynfgh"@@ -146,7 +147,7 @@ , tv_path = [49 + 2^31, 2 + 2^31, 0 + 2^31] , tv_pathR = "800000318000000280000000" , tv_chain = "67b7e1dc5c70a93504218ccf40c47ad46d4a9c858196376ce0e853aca7be0498"- , tv_prv = "00cf222cc2e097049fe2ca76626c19c7e7a3ef971b1f64195758ab3c832463fcf4"+ , tv_prv = "cf222cc2e097049fe2ca76626c19c7e7a3ef971b1f64195758ab3c832463fcf4" , tv_pub = "02b07388bd2edaba3c0a2c0856716fd7c9965d212fb2736f7b925f57d922b10ace" , tv_xprv = "xprv1qwqqqqp3sqqqqq5qqqqqqeahu8w9cu9fx5zzrrx0grz844rdf2wgtqvkxakwp6zn4jnmupycqr8jytxzuztsf8lzefmxymqecln68muhrv0kgx2htz4neqeyv070gg6dcn7" , tv_xpub = "xpub1qwqqqqp3sqqqqq5qqqqqqeahu8w9cu9fx5zzrrx0grz844rdf2wgtqvkxakwp6zn4jnmupycq2c88z9a9mdt50q29sy9vut06lyevhfp97e8xmmmjf040kfzky9vu2pu92u"@@ -155,7 +156,7 @@ , tv_path = [84 + 2^31, 0 + 2^31, 0 + 2^31] , tv_pathR = "800000548000000080000000" , tv_chain = "4a53a0ab21b9dc95869c4e92a161194e03c0ef3ff5014ac692f433c4765490fc"- , tv_prv = "00e14f274d16ca0d91031b98b162618061d03930fa381af6d4caf44b01819ab6d4"+ , tv_prv = "e14f274d16ca0d91031b98b162618061d03930fa381af6d4caf44b01819ab6d4" , tv_pub = "02707a62fdacc26ea9b63b1c197906f56ee0180d0bcf1966e1a2da34f5f3a09a9b" , tv_xprv = "xprv1qwqqqqz5sqqqqqyqqqqqqjjn5z4jrwwujkrfcn5j59s3jnsrcrhnlagpftrf9apnc3m9fy8uqrs57f6dzm9qmygrrwvtzcnpspsaqwfslgup4ak5et6ykqvpn2mdggeaxrp" , tv_xpub = "xpub1qwqqqqz5sqqqqqyqqqqqqjjn5z4jrwwujkrfcn5j59s3jnsrcrhnlagpftrf9apnc3m9fy8uqfc85cha4npxa2dk8vwpj7gx74hwqxqdp083jehp5tdrfa0n5zdfkg3lp00"@@ -173,69 +174,79 @@ , tv_pub :: B.ByteString -- ^ Expected public key in lower-case hexadecimal. } +tv_pathI :: TV -> [A.Index]+tv_pathI = fmap A.Index . tv_path+ tv :: TV -> TestTree tv x = testGroup (tv_pathD x) [ testCase "path" $ do- fmap S.unPath (S.path (tv_path x)) @?= Just (tv_path x)+ fmap S.unPath (S.path (tv_pathI x)) @?= Just (tv_pathI x) , testCase "chain" $ do Just (tv_chain x)- @=? fmap (toBase16 . S.unChain)- (S.chain (fromBase16 (tv_chain x)))+ @=? fmap (toBase16 . A.unChain)+ (A.chain (fromBase16 (tv_chain x))) , testCase "prv" $ do Just (tv_prv x)- @=? fmap (toBase16 . S.unPrv)- (S.prv (fromBase16 (tv_prv x)))+ @=? fmap (toBase16 . A.unPrv)+ (A.prv (fromBase16 (tv_prv x))) , testCase "pub" $ do Just (tv_pub x)- @=? fmap (toBase16 . S.unPub)- (S.pub (fromBase16 (tv_pub x)))+ @=? fmap (toBase16 . A.unPub)+ (A.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.unPath p @?= tv_pathI x+ toBase16 (A.unChain c) @?= tv_chain x+ toBase16 (A.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.unPath p @?= tv_pathI x+ toBase16 (A.unChain c) @?= tv_chain x+ toBase16 (A.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))+ ws <- Gen.list (fmap fromIntegral r) genIndex let Just p = S.path ws pure p -genChain :: MonadGen m => m S.Chain+genIndex :: MonadGen m => m A.Index+genIndex = A.Index <$> Gen.word32 Range.constantBounded++genChain :: MonadGen m => m A.Chain genChain = do b <- Gen.bytes (Range.singleton 32)- let Just c = S.chain b+ let Just c = A.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 :: MonadGen m => m A.Prv genPrv = do b <- Gen.bytes (Range.singleton 32)- let Just k = S.prv (B.cons 0 b)+ let Just k = A.prv b pure k++genPub :: MonadGen m => m A.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 A.pub (B.cons h b) of+ Just k -> pure k+ Nothing -> go (n - 1) --------------------------------------------------------------------------------