diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/lib/SLIP32.hs b/lib/SLIP32.hs --- a/lib/SLIP32.hs +++ b/lib/SLIP32.hs @@ -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 ] + -------------------------------------------------------------------------------- diff --git a/slip32.cabal b/slip32.cabal --- a/slip32.cabal +++ b/slip32.cabal @@ -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 diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -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) --------------------------------------------------------------------------------