diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,24 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html). +## 0.21.0 +### Added +- BCH Testnet4 support. + +### Changed +- Use a newtype for Fingerprint, which uses an 8 digit hex string for various + instances. This fixes inconsistent (de)serialization across the package. + +### Fixed +- Makes `finalScriptWitness` field encoding conform to bitcoin core. +- Fixes bug in `finalizeTransaction` + +### Added +- Signing support for PSBTs +- Helper function for merging PSBTs +- More PSBT tests +- Partial support for taproot + ## 0.20.5 ### Added - Support Bech32m address format for Taproot. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -14,3 +14,7 @@ - Parsing and manipulation of all Bitcoin and Bitcoin Cash protocol messages - Bloom filters and partial merkle trees (used in SPV wallets) - Comprehensive test suite + +## Contributing + +Please use `ormolu` (or `fourmolu`) to format code prior to submission. See `scripts/pre-commit.sh` for an example pre-commit hook. diff --git a/data/bip341.json b/data/bip341.json new file mode 100644 --- /dev/null +++ b/data/bip341.json @@ -0,0 +1,452 @@ +{ + "version": 1, + "scriptPubKey": [ + { + "given": { + "internalPubkey": "d6889cb081036e0faefa3a35157ad71086b123b2b144b649798b494c300a961d", + "scriptTree": null + }, + "intermediary": { + "merkleRoot": null, + "tweak": "b86e7be8f39bab32a6f2c0443abbc210f0edac0e2c53d501b36b64437d9c6c70", + "tweakedPubkey": "53a1f6e454df1aa2776a2814a721372d6258050de330b3c6d10ee8f4e0dda343" + }, + "expected": { + "scriptPubKey": "512053a1f6e454df1aa2776a2814a721372d6258050de330b3c6d10ee8f4e0dda343", + "bip350Address": "bc1p2wsldez5mud2yam29q22wgfh9439spgduvct83k3pm50fcxa5dps59h4z5" + } + }, + { + "given": { + "internalPubkey": "187791b6f712a8ea41c8ecdd0ee77fab3e85263b37e1ec18a3651926b3a6cf27", + "scriptTree": { + "id": 0, + "script": "20d85a959b0290bf19bb89ed43c916be835475d013da4b362117393e25a48229b8ac", + "leafVersion": 192 + } + }, + "intermediary": { + "leafHashes": [ + "5b75adecf53548f3ec6ad7d78383bf84cc57b55a3127c72b9a2481752dd88b21" + ], + "merkleRoot": "5b75adecf53548f3ec6ad7d78383bf84cc57b55a3127c72b9a2481752dd88b21", + "tweak": "cbd8679ba636c1110ea247542cfbd964131a6be84f873f7f3b62a777528ed001", + "tweakedPubkey": "147c9c57132f6e7ecddba9800bb0c4449251c92a1e60371ee77557b6620f3ea3" + }, + "expected": { + "scriptPubKey": "5120147c9c57132f6e7ecddba9800bb0c4449251c92a1e60371ee77557b6620f3ea3", + "bip350Address": "bc1pz37fc4cn9ah8anwm4xqqhvxygjf9rjf2resrw8h8w4tmvcs0863sa2e586", + "scriptPathControlBlocks": [ + "c1187791b6f712a8ea41c8ecdd0ee77fab3e85263b37e1ec18a3651926b3a6cf27" + ] + } + }, + { + "given": { + "internalPubkey": "93478e9488f956df2396be2ce6c5cced75f900dfa18e7dabd2428aae78451820", + "scriptTree": { + "id": 0, + "script": "20b617298552a72ade070667e86ca63b8f5789a9fe8731ef91202a91c9f3459007ac", + "leafVersion": 192 + } + }, + "intermediary": { + "leafHashes": [ + "c525714a7f49c28aedbbba78c005931a81c234b2f6c99a73e4d06082adc8bf2b" + ], + "merkleRoot": "c525714a7f49c28aedbbba78c005931a81c234b2f6c99a73e4d06082adc8bf2b", + "tweak": "6af9e28dbf9d6aaf027696e2598a5b3d056f5fd2355a7fd5a37a0e5008132d30", + "tweakedPubkey": "e4d810fd50586274face62b8a807eb9719cef49c04177cc6b76a9a4251d5450e" + }, + "expected": { + "scriptPubKey": "5120e4d810fd50586274face62b8a807eb9719cef49c04177cc6b76a9a4251d5450e", + "bip350Address": "bc1punvppl2stp38f7kwv2u2spltjuvuaayuqsthe34hd2dyy5w4g58qqfuag5", + "scriptPathControlBlocks": [ + "c093478e9488f956df2396be2ce6c5cced75f900dfa18e7dabd2428aae78451820" + ] + } + }, + { + "given": { + "internalPubkey": "ee4fe085983462a184015d1f782d6a5f8b9c2b60130aff050ce221ecf3786592", + "scriptTree": [ + { + "id": 0, + "script": "20387671353e273264c495656e27e39ba899ea8fee3bb69fb2a680e22093447d48ac", + "leafVersion": 192 + }, + { + "id": 1, + "script": "06424950333431", + "leafVersion": 250 + } + ] + }, + "intermediary": { + "leafHashes": [ + "8ad69ec7cf41c2a4001fd1f738bf1e505ce2277acdcaa63fe4765192497f47a7", + "f224a923cd0021ab202ab139cc56802ddb92dcfc172b9212261a539df79a112a" + ], + "merkleRoot": "6c2dc106ab816b73f9d07e3cd1ef2c8c1256f519748e0813e4edd2405d277bef", + "tweak": "9e0517edc8259bb3359255400b23ca9507f2a91cd1e4250ba068b4eafceba4a9", + "tweakedPubkey": "712447206d7a5238acc7ff53fbe94a3b64539ad291c7cdbc490b7577e4b17df5" + }, + "expected": { + "scriptPubKey": "5120712447206d7a5238acc7ff53fbe94a3b64539ad291c7cdbc490b7577e4b17df5", + "bip350Address": "bc1pwyjywgrd0ffr3tx8laflh6228dj98xkjj8rum0zfpd6h0e930h6saqxrrm", + "scriptPathControlBlocks": [ + "c0ee4fe085983462a184015d1f782d6a5f8b9c2b60130aff050ce221ecf3786592f224a923cd0021ab202ab139cc56802ddb92dcfc172b9212261a539df79a112a", + "faee4fe085983462a184015d1f782d6a5f8b9c2b60130aff050ce221ecf37865928ad69ec7cf41c2a4001fd1f738bf1e505ce2277acdcaa63fe4765192497f47a7" + ] + } + }, + { + "given": { + "internalPubkey": "f9f400803e683727b14f463836e1e78e1c64417638aa066919291a225f0e8dd8", + "scriptTree": [ + { + "id": 0, + "script": "2044b178d64c32c4a05cc4f4d1407268f764c940d20ce97abfd44db5c3592b72fdac", + "leafVersion": 192 + }, + { + "id": 1, + "script": "07546170726f6f74", + "leafVersion": 192 + } + ] + }, + "intermediary": { + "leafHashes": [ + "64512fecdb5afa04f98839b50e6f0cb7b1e539bf6f205f67934083cdcc3c8d89", + "2cb2b90daa543b544161530c925f285b06196940d6085ca9474d41dc3822c5cb" + ], + "merkleRoot": "ab179431c28d3b68fb798957faf5497d69c883c6fb1e1cd9f81483d87bac90cc", + "tweak": "639f0281b7ac49e742cd25b7f188657626da1ad169209078e2761cefd91fd65e", + "tweakedPubkey": "77e30a5522dd9f894c3f8b8bd4c4b2cf82ca7da8a3ea6a239655c39c050ab220" + }, + "expected": { + "scriptPubKey": "512077e30a5522dd9f894c3f8b8bd4c4b2cf82ca7da8a3ea6a239655c39c050ab220", + "bip350Address": "bc1pwl3s54fzmk0cjnpl3w9af39je7pv5ldg504x5guk2hpecpg2kgsqaqstjq", + "scriptPathControlBlocks": [ + "c1f9f400803e683727b14f463836e1e78e1c64417638aa066919291a225f0e8dd82cb2b90daa543b544161530c925f285b06196940d6085ca9474d41dc3822c5cb", + "c1f9f400803e683727b14f463836e1e78e1c64417638aa066919291a225f0e8dd864512fecdb5afa04f98839b50e6f0cb7b1e539bf6f205f67934083cdcc3c8d89" + ] + } + }, + { + "given": { + "internalPubkey": "e0dfe2300b0dd746a3f8674dfd4525623639042569d829c7f0eed9602d263e6f", + "scriptTree": [ + { + "id": 0, + "script": "2072ea6adcf1d371dea8fba1035a09f3d24ed5a059799bae114084130ee5898e69ac", + "leafVersion": 192 + }, + [ + { + "id": 1, + "script": "202352d137f2f3ab38d1eaa976758873377fa5ebb817372c71e2c542313d4abda8ac", + "leafVersion": 192 + }, + { + "id": 2, + "script": "207337c0dd4253cb86f2c43a2351aadd82cccb12a172cd120452b9bb8324f2186aac", + "leafVersion": 192 + } + ] + ] + }, + "intermediary": { + "leafHashes": [ + "2645a02e0aac1fe69d69755733a9b7621b694bb5b5cde2bbfc94066ed62b9817", + "ba982a91d4fc552163cb1c0da03676102d5b7a014304c01f0c77b2b8e888de1c", + "9e31407bffa15fefbf5090b149d53959ecdf3f62b1246780238c24501d5ceaf6" + ], + "merkleRoot": "ccbd66c6f7e8fdab47b3a486f59d28262be857f30d4773f2d5ea47f7761ce0e2", + "tweak": "b57bfa183d28eeb6ad688ddaabb265b4a41fbf68e5fed2c72c74de70d5a786f4", + "tweakedPubkey": "91b64d5324723a985170e4dc5a0f84c041804f2cd12660fa5dec09fc21783605" + }, + "expected": { + "scriptPubKey": "512091b64d5324723a985170e4dc5a0f84c041804f2cd12660fa5dec09fc21783605", + "bip350Address": "bc1pjxmy65eywgafs5tsunw95ruycpqcqnev6ynxp7jaasylcgtcxczs6n332e", + "scriptPathControlBlocks": [ + "c0e0dfe2300b0dd746a3f8674dfd4525623639042569d829c7f0eed9602d263e6fffe578e9ea769027e4f5a3de40732f75a88a6353a09d767ddeb66accef85e553", + "c0e0dfe2300b0dd746a3f8674dfd4525623639042569d829c7f0eed9602d263e6f9e31407bffa15fefbf5090b149d53959ecdf3f62b1246780238c24501d5ceaf62645a02e0aac1fe69d69755733a9b7621b694bb5b5cde2bbfc94066ed62b9817", + "c0e0dfe2300b0dd746a3f8674dfd4525623639042569d829c7f0eed9602d263e6fba982a91d4fc552163cb1c0da03676102d5b7a014304c01f0c77b2b8e888de1c2645a02e0aac1fe69d69755733a9b7621b694bb5b5cde2bbfc94066ed62b9817" + ] + } + }, + { + "given": { + "internalPubkey": "55adf4e8967fbd2e29f20ac896e60c3b0f1d5b0efa9d34941b5958c7b0a0312d", + "scriptTree": [ + { + "id": 0, + "script": "2071981521ad9fc9036687364118fb6ccd2035b96a423c59c5430e98310a11abe2ac", + "leafVersion": 192 + }, + [ + { + "id": 1, + "script": "20d5094d2dbe9b76e2c245a2b89b6006888952e2faa6a149ae318d69e520617748ac", + "leafVersion": 192 + }, + { + "id": 2, + "script": "20c440b462ad48c7a77f94cd4532d8f2119dcebbd7c9764557e62726419b08ad4cac", + "leafVersion": 192 + } + ] + ] + }, + "intermediary": { + "leafHashes": [ + "f154e8e8e17c31d3462d7132589ed29353c6fafdb884c5a6e04ea938834f0d9d", + "737ed1fe30bc42b8022d717b44f0d93516617af64a64753b7a06bf16b26cd711", + "d7485025fceb78b9ed667db36ed8b8dc7b1f0b307ac167fa516fe4352b9f4ef7" + ], + "merkleRoot": "2f6b2c5397b6d68ca18e09a3f05161668ffe93a988582d55c6f07bd5b3329def", + "tweak": "6579138e7976dc13b6a92f7bfd5a2fc7684f5ea42419d43368301470f3b74ed9", + "tweakedPubkey": "75169f4001aa68f15bbed28b218df1d0a62cbbcf1188c6665110c293c907b831" + }, + "expected": { + "scriptPubKey": "512075169f4001aa68f15bbed28b218df1d0a62cbbcf1188c6665110c293c907b831", + "bip350Address": "bc1pw5tf7sqp4f50zka7629jrr036znzew70zxyvvej3zrpf8jg8hqcssyuewe", + "scriptPathControlBlocks": [ + "c155adf4e8967fbd2e29f20ac896e60c3b0f1d5b0efa9d34941b5958c7b0a0312d3cd369a528b326bc9d2133cbd2ac21451acb31681a410434672c8e34fe757e91", + "c155adf4e8967fbd2e29f20ac896e60c3b0f1d5b0efa9d34941b5958c7b0a0312dd7485025fceb78b9ed667db36ed8b8dc7b1f0b307ac167fa516fe4352b9f4ef7f154e8e8e17c31d3462d7132589ed29353c6fafdb884c5a6e04ea938834f0d9d", + "c155adf4e8967fbd2e29f20ac896e60c3b0f1d5b0efa9d34941b5958c7b0a0312d737ed1fe30bc42b8022d717b44f0d93516617af64a64753b7a06bf16b26cd711f154e8e8e17c31d3462d7132589ed29353c6fafdb884c5a6e04ea938834f0d9d" + ] + } + } + ], + "keyPathSpending": [ + { + "given": { + "rawUnsignedTx": "02000000097de20cbff686da83a54981d2b9bab3586f4ca7e48f57f5b55963115f3b334e9c010000000000000000d7b7cab57b1393ace2d064f4d4a2cb8af6def61273e127517d44759b6dafdd990000000000fffffffff8e1f583384333689228c5d28eac13366be082dc57441760d957275419a418420000000000fffffffff0689180aa63b30cb162a73c6d2a38b7eeda2a83ece74310fda0843ad604853b0100000000feffffffaa5202bdf6d8ccd2ee0f0202afbbb7461d9264a25e5bfd3c5a52ee1239e0ba6c0000000000feffffff956149bdc66faa968eb2be2d2faa29718acbfe3941215893a2a3446d32acd050000000000000000000e664b9773b88c09c32cb70a2a3e4da0ced63b7ba3b22f848531bbb1d5d5f4c94010000000000000000e9aa6b8e6c9de67619e6a3924ae25696bb7b694bb677a632a74ef7eadfd4eabf0000000000ffffffffa778eb6a263dc090464cd125c466b5a99667720b1c110468831d058aa1b82af10100000000ffffffff0200ca9a3b000000001976a91406afd46bcdfd22ef94ac122aa11f241244a37ecc88ac807840cb0000000020ac9a87f5594be208f8532db38cff670c450ed2fea8fcdefcc9a663f78bab962b0065cd1d", + "utxosSpent": [ + { + "scriptPubKey": "512053a1f6e454df1aa2776a2814a721372d6258050de330b3c6d10ee8f4e0dda343", + "amountSats": 420000000 + }, + { + "scriptPubKey": "5120147c9c57132f6e7ecddba9800bb0c4449251c92a1e60371ee77557b6620f3ea3", + "amountSats": 462000000 + }, + { + "scriptPubKey": "76a914751e76e8199196d454941c45d1b3a323f1433bd688ac", + "amountSats": 294000000 + }, + { + "scriptPubKey": "5120e4d810fd50586274face62b8a807eb9719cef49c04177cc6b76a9a4251d5450e", + "amountSats": 504000000 + }, + { + "scriptPubKey": "512091b64d5324723a985170e4dc5a0f84c041804f2cd12660fa5dec09fc21783605", + "amountSats": 630000000 + }, + { + "scriptPubKey": "00147dd65592d0ab2fe0d0257d571abf032cd9db93dc", + "amountSats": 378000000 + }, + { + "scriptPubKey": "512075169f4001aa68f15bbed28b218df1d0a62cbbcf1188c6665110c293c907b831", + "amountSats": 672000000 + }, + { + "scriptPubKey": "5120712447206d7a5238acc7ff53fbe94a3b64539ad291c7cdbc490b7577e4b17df5", + "amountSats": 546000000 + }, + { + "scriptPubKey": "512077e30a5522dd9f894c3f8b8bd4c4b2cf82ca7da8a3ea6a239655c39c050ab220", + "amountSats": 588000000 + } + ] + }, + "intermediary": { + "hashAmounts": "58a6964a4f5f8f0b642ded0a8a553be7622a719da71d1f5befcefcdee8e0fde6", + "hashOutputs": "a2e6dab7c1f0dcd297c8d61647fd17d821541ea69c3cc37dcbad7f90d4eb4bc5", + "hashPrevouts": "e3b33bb4ef3a52ad1fffb555c0d82828eb22737036eaeb02a235d82b909c4c3f", + "hashScriptPubkeys": "23ad0f61ad2bca5ba6a7693f50fce988e17c3780bf2b1e720cfbb38fbdd52e21", + "hashSequences": "18959c7221ab5ce9e26c3cd67b22c24f8baa54bac281d8e6b05e400e6c3a957e" + }, + "inputSpending": [ + { + "given": { + "txinIndex": 0, + "internalPrivkey": "6b973d88838f27366ed61c9ad6367663045cb456e28335c109e30717ae0c6baa", + "merkleRoot": null, + "hashType": 3 + }, + "intermediary": { + "internalPubkey": "d6889cb081036e0faefa3a35157ad71086b123b2b144b649798b494c300a961d", + "tweak": "b86e7be8f39bab32a6f2c0443abbc210f0edac0e2c53d501b36b64437d9c6c70", + "tweakedPrivkey": "2405b971772ad26915c8dcdf10f238753a9b837e5f8e6a86fd7c0cce5b7296d9", + "sigMsg": "0003020000000065cd1de3b33bb4ef3a52ad1fffb555c0d82828eb22737036eaeb02a235d82b909c4c3f58a6964a4f5f8f0b642ded0a8a553be7622a719da71d1f5befcefcdee8e0fde623ad0f61ad2bca5ba6a7693f50fce988e17c3780bf2b1e720cfbb38fbdd52e2118959c7221ab5ce9e26c3cd67b22c24f8baa54bac281d8e6b05e400e6c3a957e0000000000d0418f0e9a36245b9a50ec87f8bf5be5bcae434337b87139c3a5b1f56e33cba0", + "precomputedUsed": [ + "hashAmounts", + "hashPrevouts", + "hashScriptPubkeys", + "hashSequences" + ], + "sigHash": "2514a6272f85cfa0f45eb907fcb0d121b808ed37c6ea160a5a9046ed5526d555" + }, + "expected": { + "witness": [ + "ed7c1647cb97379e76892be0cacff57ec4a7102aa24296ca39af7541246d8ff14d38958d4cc1e2e478e4d4a764bbfd835b16d4e314b72937b29833060b87276c03" + ] + } + }, + { + "given": { + "txinIndex": 1, + "internalPrivkey": "1e4da49f6aaf4e5cd175fe08a32bb5cb4863d963921255f33d3bc31e1343907f", + "merkleRoot": "5b75adecf53548f3ec6ad7d78383bf84cc57b55a3127c72b9a2481752dd88b21", + "hashType": 131 + }, + "intermediary": { + "internalPubkey": "187791b6f712a8ea41c8ecdd0ee77fab3e85263b37e1ec18a3651926b3a6cf27", + "tweak": "cbd8679ba636c1110ea247542cfbd964131a6be84f873f7f3b62a777528ed001", + "tweakedPrivkey": "ea260c3b10e60f6de018455cd0278f2f5b7e454be1999572789e6a9565d26080", + "sigMsg": "0083020000000065cd1d00d7b7cab57b1393ace2d064f4d4a2cb8af6def61273e127517d44759b6dafdd9900000000808f891b00000000225120147c9c57132f6e7ecddba9800bb0c4449251c92a1e60371ee77557b6620f3ea3ffffffffffcef8fb4ca7efc5433f591ecfc57391811ce1e186a3793024def5c884cba51d", + "precomputedUsed": [], + "sigHash": "325a644af47e8a5a2591cda0ab0723978537318f10e6a63d4eed783b96a71a4d" + }, + "expected": { + "witness": [ + "052aedffc554b41f52b521071793a6b88d6dbca9dba94cf34c83696de0c1ec35ca9c5ed4ab28059bd606a4f3a657eec0bb96661d42921b5f50a95ad33675b54f83" + ] + } + }, + { + "given": { + "txinIndex": 3, + "internalPrivkey": "d3c7af07da2d54f7a7735d3d0fc4f0a73164db638b2f2f7c43f711f6d4aa7e64", + "merkleRoot": "c525714a7f49c28aedbbba78c005931a81c234b2f6c99a73e4d06082adc8bf2b", + "hashType": 1 + }, + "intermediary": { + "internalPubkey": "93478e9488f956df2396be2ce6c5cced75f900dfa18e7dabd2428aae78451820", + "tweak": "6af9e28dbf9d6aaf027696e2598a5b3d056f5fd2355a7fd5a37a0e5008132d30", + "tweakedPrivkey": "97323385e57015b75b0339a549c56a948eb961555973f0951f555ae6039ef00d", + "sigMsg": "0001020000000065cd1de3b33bb4ef3a52ad1fffb555c0d82828eb22737036eaeb02a235d82b909c4c3f58a6964a4f5f8f0b642ded0a8a553be7622a719da71d1f5befcefcdee8e0fde623ad0f61ad2bca5ba6a7693f50fce988e17c3780bf2b1e720cfbb38fbdd52e2118959c7221ab5ce9e26c3cd67b22c24f8baa54bac281d8e6b05e400e6c3a957ea2e6dab7c1f0dcd297c8d61647fd17d821541ea69c3cc37dcbad7f90d4eb4bc50003000000", + "precomputedUsed": [ + "hashAmounts", + "hashOutputs", + "hashPrevouts", + "hashScriptPubkeys", + "hashSequences" + ], + "sigHash": "bf013ea93474aa67815b1b6cc441d23b64fa310911d991e713cd34c7f5d46669" + }, + "expected": { + "witness": [ + "ff45f742a876139946a149ab4d9185574b98dc919d2eb6754f8abaa59d18b025637a3aa043b91817739554f4ed2026cf8022dbd83e351ce1fabc272841d2510a01" + ] + } + }, + { + "given": { + "txinIndex": 4, + "internalPrivkey": "f36bb07a11e469ce941d16b63b11b9b9120a84d9d87cff2c84a8d4affb438f4e", + "merkleRoot": "ccbd66c6f7e8fdab47b3a486f59d28262be857f30d4773f2d5ea47f7761ce0e2", + "hashType": 0 + }, + "intermediary": { + "internalPubkey": "e0dfe2300b0dd746a3f8674dfd4525623639042569d829c7f0eed9602d263e6f", + "tweak": "b57bfa183d28eeb6ad688ddaabb265b4a41fbf68e5fed2c72c74de70d5a786f4", + "tweakedPrivkey": "a8e7aa924f0d58854185a490e6c41f6efb7b675c0f3331b7f14b549400b4d501", + "sigMsg": "0000020000000065cd1de3b33bb4ef3a52ad1fffb555c0d82828eb22737036eaeb02a235d82b909c4c3f58a6964a4f5f8f0b642ded0a8a553be7622a719da71d1f5befcefcdee8e0fde623ad0f61ad2bca5ba6a7693f50fce988e17c3780bf2b1e720cfbb38fbdd52e2118959c7221ab5ce9e26c3cd67b22c24f8baa54bac281d8e6b05e400e6c3a957ea2e6dab7c1f0dcd297c8d61647fd17d821541ea69c3cc37dcbad7f90d4eb4bc50004000000", + "precomputedUsed": [ + "hashAmounts", + "hashOutputs", + "hashPrevouts", + "hashScriptPubkeys", + "hashSequences" + ], + "sigHash": "4f900a0bae3f1446fd48490c2958b5a023228f01661cda3496a11da502a7f7ef" + }, + "expected": { + "witness": [ + "b4010dd48a617db09926f729e79c33ae0b4e94b79f04a1ae93ede6315eb3669de185a17d2b0ac9ee09fd4c64b678a0b61a0a86fa888a273c8511be83bfd6810f" + ] + } + }, + { + "given": { + "txinIndex": 6, + "internalPrivkey": "415cfe9c15d9cea27d8104d5517c06e9de48e2f986b695e4f5ffebf230e725d8", + "merkleRoot": "2f6b2c5397b6d68ca18e09a3f05161668ffe93a988582d55c6f07bd5b3329def", + "hashType": 2 + }, + "intermediary": { + "internalPubkey": "55adf4e8967fbd2e29f20ac896e60c3b0f1d5b0efa9d34941b5958c7b0a0312d", + "tweak": "6579138e7976dc13b6a92f7bfd5a2fc7684f5ea42419d43368301470f3b74ed9", + "tweakedPrivkey": "241c14f2639d0d7139282aa6abde28dd8a067baa9d633e4e7230287ec2d02901", + "sigMsg": "0002020000000065cd1de3b33bb4ef3a52ad1fffb555c0d82828eb22737036eaeb02a235d82b909c4c3f58a6964a4f5f8f0b642ded0a8a553be7622a719da71d1f5befcefcdee8e0fde623ad0f61ad2bca5ba6a7693f50fce988e17c3780bf2b1e720cfbb38fbdd52e2118959c7221ab5ce9e26c3cd67b22c24f8baa54bac281d8e6b05e400e6c3a957e0006000000", + "precomputedUsed": [ + "hashAmounts", + "hashPrevouts", + "hashScriptPubkeys", + "hashSequences" + ], + "sigHash": "15f25c298eb5cdc7eb1d638dd2d45c97c4c59dcaec6679cfc16ad84f30876b85" + }, + "expected": { + "witness": [ + "a3785919a2ce3c4ce26f298c3d51619bc474ae24014bcdd31328cd8cfbab2eff3395fa0a16fe5f486d12f22a9cedded5ae74feb4bbe5351346508c5405bcfee002" + ] + } + }, + { + "given": { + "txinIndex": 7, + "internalPrivkey": "c7b0e81f0a9a0b0499e112279d718cca98e79a12e2f137c72ae5b213aad0d103", + "merkleRoot": "6c2dc106ab816b73f9d07e3cd1ef2c8c1256f519748e0813e4edd2405d277bef", + "hashType": 130 + }, + "intermediary": { + "internalPubkey": "ee4fe085983462a184015d1f782d6a5f8b9c2b60130aff050ce221ecf3786592", + "tweak": "9e0517edc8259bb3359255400b23ca9507f2a91cd1e4250ba068b4eafceba4a9", + "tweakedPrivkey": "65b6000cd2bfa6b7cf736767a8955760e62b6649058cbc970b7c0871d786346b", + "sigMsg": "0082020000000065cd1d00e9aa6b8e6c9de67619e6a3924ae25696bb7b694bb677a632a74ef7eadfd4eabf00000000804c8b2000000000225120712447206d7a5238acc7ff53fbe94a3b64539ad291c7cdbc490b7577e4b17df5ffffffff", + "precomputedUsed": [], + "sigHash": "cd292de50313804dabe4685e83f923d2969577191a3e1d2882220dca88cbeb10" + }, + "expected": { + "witness": [ + "ea0c6ba90763c2d3a296ad82ba45881abb4f426b3f87af162dd24d5109edc1cdd11915095ba47c3a9963dc1e6c432939872bc49212fe34c632cd3ab9fed429c482" + ] + } + }, + { + "given": { + "txinIndex": 8, + "internalPrivkey": "77863416be0d0665e517e1c375fd6f75839544eca553675ef7fdf4949518ebaa", + "merkleRoot": "ab179431c28d3b68fb798957faf5497d69c883c6fb1e1cd9f81483d87bac90cc", + "hashType": 129 + }, + "intermediary": { + "internalPubkey": "f9f400803e683727b14f463836e1e78e1c64417638aa066919291a225f0e8dd8", + "tweak": "639f0281b7ac49e742cd25b7f188657626da1ad169209078e2761cefd91fd65e", + "tweakedPrivkey": "ec18ce6af99f43815db543f47b8af5ff5df3b2cb7315c955aa4a86e8143d2bf5", + "sigMsg": "0081020000000065cd1da2e6dab7c1f0dcd297c8d61647fd17d821541ea69c3cc37dcbad7f90d4eb4bc500a778eb6a263dc090464cd125c466b5a99667720b1c110468831d058aa1b82af101000000002b0c230000000022512077e30a5522dd9f894c3f8b8bd4c4b2cf82ca7da8a3ea6a239655c39c050ab220ffffffff", + "precomputedUsed": [ + "hashOutputs" + ], + "sigHash": "cccb739eca6c13a8a89e6e5cd317ffe55669bbda23f2fd37b0f18755e008edd2" + }, + "expected": { + "witness": [ + "bbc9584a11074e83bc8c6759ec55401f0ae7b03ef290c3139814f545b58a9f8127258000874f44bc46db7646322107d4d86aec8e73b8719a61fff761d75b5dd981" + ] + } + } + ], + "auxiliary": { + "fulledSignedTx": "020000000001097de20cbff686da83a54981d2b9bab3586f4ca7e48f57f5b55963115f3b334e9c010000000000000000d7b7cab57b1393ace2d064f4d4a2cb8af6def61273e127517d44759b6dafdd990000000000fffffffff8e1f583384333689228c5d28eac13366be082dc57441760d957275419a41842000000006b4830450221008f3b8f8f0537c420654d2283673a761b7ee2ea3c130753103e08ce79201cf32a022079e7ab904a1980ef1c5890b648c8783f4d10103dd62f740d13daa79e298d50c201210279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798fffffffff0689180aa63b30cb162a73c6d2a38b7eeda2a83ece74310fda0843ad604853b0100000000feffffffaa5202bdf6d8ccd2ee0f0202afbbb7461d9264a25e5bfd3c5a52ee1239e0ba6c0000000000feffffff956149bdc66faa968eb2be2d2faa29718acbfe3941215893a2a3446d32acd050000000000000000000e664b9773b88c09c32cb70a2a3e4da0ced63b7ba3b22f848531bbb1d5d5f4c94010000000000000000e9aa6b8e6c9de67619e6a3924ae25696bb7b694bb677a632a74ef7eadfd4eabf0000000000ffffffffa778eb6a263dc090464cd125c466b5a99667720b1c110468831d058aa1b82af10100000000ffffffff0200ca9a3b000000001976a91406afd46bcdfd22ef94ac122aa11f241244a37ecc88ac807840cb0000000020ac9a87f5594be208f8532db38cff670c450ed2fea8fcdefcc9a663f78bab962b0141ed7c1647cb97379e76892be0cacff57ec4a7102aa24296ca39af7541246d8ff14d38958d4cc1e2e478e4d4a764bbfd835b16d4e314b72937b29833060b87276c030141052aedffc554b41f52b521071793a6b88d6dbca9dba94cf34c83696de0c1ec35ca9c5ed4ab28059bd606a4f3a657eec0bb96661d42921b5f50a95ad33675b54f83000141ff45f742a876139946a149ab4d9185574b98dc919d2eb6754f8abaa59d18b025637a3aa043b91817739554f4ed2026cf8022dbd83e351ce1fabc272841d2510a010140b4010dd48a617db09926f729e79c33ae0b4e94b79f04a1ae93ede6315eb3669de185a17d2b0ac9ee09fd4c64b678a0b61a0a86fa888a273c8511be83bfd6810f0247304402202b795e4de72646d76eab3f0ab27dfa30b810e856ff3a46c9a702df53bb0d8cc302203ccc4d822edab5f35caddb10af1be93583526ccfbade4b4ead350781e2f8adcd012102f9308a019258c31049344f85f89d5229b531c845836f99b08601f113bce036f90141a3785919a2ce3c4ce26f298c3d51619bc474ae24014bcdd31328cd8cfbab2eff3395fa0a16fe5f486d12f22a9cedded5ae74feb4bbe5351346508c5405bcfee0020141ea0c6ba90763c2d3a296ad82ba45881abb4f426b3f87af162dd24d5109edc1cdd11915095ba47c3a9963dc1e6c432939872bc49212fe34c632cd3ab9fed429c4820141bbc9584a11074e83bc8c6759ec55401f0ae7b03ef290c3139814f545b58a9f8127258000874f44bc46db7646322107d4d86aec8e73b8719a61fff761d75b5dd9810065cd1d" + } + } + ] +} diff --git a/data/complex_psbt.json b/data/complex_psbt.json new file mode 100644 --- /dev/null +++ b/data/complex_psbt.json @@ -0,0 +1,18 @@ +{ + "initial_psbt": "cHNidP8BAP2aAQIAAAAJ0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAAAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAEAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQAgAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFADAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAQAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQBQAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAGAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAcAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQCAAAAAD/////AcBByBcAAAAAFgAU86NkDG3go6XBS3IWTpj5bKedZfoAAAAAAAAAAAAAAAAAAAA=", + "miner_psbt": "cHNidP8BAP2aAQIAAAAJ0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAAAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAEAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQAgAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFADAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAQAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQBQAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAGAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAcAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQCAAAAAD/////AcBByBcAAAAAFgAU86NkDG3go6XBS3IWTpj5bKedZfoAAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAEBH85eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7EBCGsCRzBEAiBAf8l/MAdx8EmbfrjyzdhwXOemFfyJOh8sJekKMi/4QgIgH3xp2zAzrr9/67CAnfNqdQ0GXbVrn7Dx5EklAO58H0QBIQKOyYCO13OUw/9ulMHA+D+guq7JFe/yBWbH6LCXWPCL6wABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAAAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAEBH4Dw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppkBCGsCRzBEAiB0ZFxXOnPW6ezqx/K2Gw1BHfQfZpHvYS9fLSUgm2zEwQIgEU+rCj39WKfnvtWqgohE6M/VIUULJCgzDNJQcieyK5EBIQNpMZK4G5y+/dBTIetMRgJkoQgdZDlqdjMvPbOxIb3UMwABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAAAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAAAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAQdqRzBEAiB4Lzld0e52+DOVJz6yFL2p7iEATna+iJUbhjmCKHyFDgIgIAQ0lX9y4LriyhClDIz5f/J51R4TiAuCDY6SPNmSlq4BIQNQEPK9oqWZaq9u2sbNiemHcw+K0bdiDqwppyeV1ROmIwAiAgOpgiiaiULEEOdaD/0O9VFT7Kj/sawKXm/e/aKbEi8x6BBnnHl0AAAAgAAAAIAAAACAAA==", + "p2pkh_psbt": "cHNidP8BAP2aAQIAAAAJ0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAAAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAEAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQAgAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFADAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAQAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQBQAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAGAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAcAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQCAAAAAD/////AcBByBcAAAAAFgAU86NkDG3go6XBS3IWTpj5bKedZfoAAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAEBH85eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7EAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAABAR+A8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAAAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAABB2pHMEQCIHgvOV3R7nb4M5UnPrIUvanuIQBOdr6IlRuGOYIofIUOAiAgBDSVf3LguuLKEKUMjPl/8nnVHhOIC4INjpI82ZKWrgEhA1AQ8r2ipZlqr27axs2J6YdzD4rRt2IOrCmnJ5XVE6YjAAA=", + "p2sh_pk_psbt": "cHNidP8BAP2aAQIAAAAJ0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAAAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAEAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQAgAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFADAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAQAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQBQAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAGAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAcAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQCAAAAAD/////AcBByBcAAAAAFgAU86NkDG3go6XBS3IWTpj5bKedZfoAAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAEBH85eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7EAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAABAR+A8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAAAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAEHbEcwRAIgW6RzAN1ZD0RctWRDzmwT8LzQcSneRHZKJrg3BfZiYqYCIFu6fNSf40qhwG6D6tOB1kOC3LAQmtzZFXJQZW14GSn/ASMhAmKMixPWrTKQsQDUCuHN7K5RXvw/Gr1e+FTAdVyxh9H2rAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAAAAA==", + "p2sh_ms_1_psbt": "cHNidP8BAP2aAQIAAAAJ0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAAAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAEAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQAgAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFADAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAQAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQBQAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAGAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAcAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQCAAAAAD/////AcBByBcAAAAAFgAU86NkDG3go6XBS3IWTpj5bKedZfoAAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAEBH85eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7EAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAABAR+A8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAAAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAIgIDiZk4Rf6NS9KEJCxttsdjcLCR688XBDP3ME9uwcypSAxHMEQCIHNtMH2gxzGIqzEuVdEsMCbggEpeKhfdmaPYajq8pzdeAiBJm4a7JOGfEG74g+Wj44suYtx1VNoqRHIEzPODvtS9ZwEBBGlSIQMVRqGbYX3GqDgQ2OB/M0zjUbQYYT6vJjWqQnsVJqXH+CEDOVaBbrUNQEs9XzJ5kVoXogcopGNj3wWn8p1G1VQGJlAhA4mZOEX+jUvShCQsbbbHY3CwkevPFwQz9zBPbsHMqUgMU64iBgMVRqGbYX3GqDgQ2OB/M0zjUbQYYT6vJjWqQnsVJqXH+AQkPXW6IgYDOVaBbrUNQEs9XzJ5kVoXogcopGNj3wWn8p1G1VQGJlAEReMpVCIGA4mZOEX+jUvShCQsbbbHY3CwkevPFwQz9zBPbsHMqUgMBGrkS7MAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAAA", + "p2sh_ms_2_psbt": "cHNidP8BAP2aAQIAAAAJ0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAAAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAEAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQAgAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFADAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAQAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQBQAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAGAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAcAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQCAAAAAD/////AcBByBcAAAAAFgAU86NkDG3go6XBS3IWTpj5bKedZfoAAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAEBH85eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7EAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAABAR+A8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAAAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAIgIDOVaBbrUNQEs9XzJ5kVoXogcopGNj3wWn8p1G1VQGJlBHMEQCIHsKjlshYwBTgmIeSBDVng5ccptXSnq+Ty3sBnC+ICF3AiBoIDtKn/5nrAW8oUVpiHBQ1qNyfgu8JUqXK3ocLz+gOQEBBGlSIQMVRqGbYX3GqDgQ2OB/M0zjUbQYYT6vJjWqQnsVJqXH+CEDOVaBbrUNQEs9XzJ5kVoXogcopGNj3wWn8p1G1VQGJlAhA4mZOEX+jUvShCQsbbbHY3CwkevPFwQz9zBPbsHMqUgMU64iBgMVRqGbYX3GqDgQ2OB/M0zjUbQYYT6vJjWqQnsVJqXH+AQkPXW6IgYDOVaBbrUNQEs9XzJ5kVoXogcopGNj3wWn8p1G1VQGJlAEReMpVCIGA4mZOEX+jUvShCQsbbbHY3CwkevPFwQz9zBPbsHMqUgMBGrkS7MAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAAA", + "p2sh_wsh_pk_psbt": "cHNidP8BAP2aAQIAAAAJ0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAAAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAEAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQAgAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFADAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAQAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQBQAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAGAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAcAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQCAAAAAD/////AcBByBcAAAAAFgAU86NkDG3go6XBS3IWTpj5bKedZfoAAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAEBH85eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7EAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAQEggPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IcBByMiACCGN6sm51oxUNKq+p1dT9m6Tbg/lSrpjHMB86JXUvR55QEIbQJHMEQCIHQ0oYAIPYJeXwNCeYMlQfo6FAiUp5UBGdBO5LZDEMHjAiBiGKcTTcLhnYix+5Mc0Vd9mI8aoARpDBcZOmO81KhN1AEjIQNPIIsAkjoMbFqR1zUgawpj50bWOosjK2qpvOmDLz9NpawAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAEBH4Dw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppkAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAAAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAAA", + "p2sh_wsh_ms_1_psbt": "cHNidP8BAP2aAQIAAAAJ0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAAAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAEAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQAgAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFADAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAQAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQBQAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAGAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAcAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQCAAAAAD/////AcBByBcAAAAAFgAU86NkDG3go6XBS3IWTpj5bKedZfoAAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAEBH85eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7EAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAABAR+A8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAABASCA8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chphyICA3j8GOuIWnK8bD4+vsXq3hvODvaKSGOyt866LZblEZcvRzBEAiAmsEB3Lsapby4p9FfInpUgwi9H42iUXgrV8a8ENeqAeQIgKLTYlYUsPvtK17dhM8ze4PQlQxeB6LLwmAFK3kxzafwBAQQiACC50l4yj/cqAwKr3ZjnkAme0/Mmd1oanHsxRYufLZVfYwEFaVIhAhzyD15pnUspOXskhfMi8hrrkyZKuFMrxhEnl4QY1J7RIQLAb5THUmmR8mkB8ifjq3s5h0m8DDB7CkiR3cJayIr1HCEDePwY64hacrxsPj6+xereG84O9opIY7K3zrotluURly9TriIGAhzyD15pnUspOXskhfMi8hrrkyZKuFMrxhEnl4QY1J7RBF0EzPMiBgLAb5THUmmR8mkB8ifjq3s5h0m8DDB7CkiR3cJayIr1HASVBcNoIgYDePwY64hacrxsPj6+xereG84O9opIY7K3zrotluURly8EkECwlQABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAAAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAAA", + "p2sh_wsh_ms_2_psbt": "cHNidP8BAP2aAQIAAAAJ0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAAAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAEAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQAgAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFADAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAQAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQBQAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAGAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAcAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQCAAAAAD/////AcBByBcAAAAAFgAU86NkDG3go6XBS3IWTpj5bKedZfoAAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAEBH85eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7EAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAABAR+A8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAABASCA8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chphyICAhzyD15pnUspOXskhfMi8hrrkyZKuFMrxhEnl4QY1J7RRzBEAiAfyakpKiqS206ZCB/KK/THBicVxIsFxIe4RKSeZ34UsQIgcVNSgVbFNeFQDhmAWTujesZJ+LLB+Gk6Cke+ry3UxnoBAQQiACC50l4yj/cqAwKr3ZjnkAme0/Mmd1oanHsxRYufLZVfYwEFaVIhAhzyD15pnUspOXskhfMi8hrrkyZKuFMrxhEnl4QY1J7RIQLAb5THUmmR8mkB8ifjq3s5h0m8DDB7CkiR3cJayIr1HCEDePwY64hacrxsPj6+xereG84O9opIY7K3zrotluURly9TriIGAhzyD15pnUspOXskhfMi8hrrkyZKuFMrxhEnl4QY1J7RBF0EzPMiBgLAb5THUmmR8mkB8ifjq3s5h0m8DDB7CkiR3cJayIr1HASVBcNoIgYDePwY64hacrxsPj6+xereG84O9opIY7K3zrotluURly8EkECwlQABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAAAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAAA", + "p2wpkh_psbt": "cHNidP8BAP2aAQIAAAAJ0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAAAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAEAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQAgAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFADAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAQAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQBQAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAGAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAcAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQCAAAAAD/////AcBByBcAAAAAFgAU86NkDG3go6XBS3IWTpj5bKedZfoAAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAEBH85eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7EAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAABAR+A8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZAQhrAkcwRAIgdGRcVzpz1uns6sfythsNQR30H2aR72EvXy0lIJtsxMECIBFPqwo9/Vin577VqoKIROjP1SFFCyQoMwzSUHInsiuRASEDaTGSuBucvv3QUyHrTEYCZKEIHWQ5anYzLz2zsSG91DMAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAAAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAAA", + "p2wsh_pk_psbt": "cHNidP8BAP2aAQIAAAAJ0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAAAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAEAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQAgAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFADAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAQAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQBQAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAGAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAcAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQCAAAAAD/////AcBByBcAAAAAFgAU86NkDG3go6XBS3IWTpj5bKedZfoAAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAEBH85eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7EAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAEBK4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEkBCG0CRzBEAiAgppSlBXPyJhuvNZOvzBCsnm50+0s2qNuCc+2XYZXAowIgXjxcZO2KsZqhoZNBlcifRCSzTZn5+mLHgWVLVafFhCcBIyECCuSWz8qG5RyIxFQ4twaXreeWlCnXnO7956gk/FhdD3+sAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAEBH4Dw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppkAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAAAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAAA", + "p2wsh_ms_1_psbt": "cHNidP8BAP2aAQIAAAAJ0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAAAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAEAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQAgAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFADAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAQAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQBQAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAGAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAcAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQCAAAAAD/////AcBByBcAAAAAFgAU86NkDG3go6XBS3IWTpj5bKedZfoAAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAEBH85eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7EAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAABAR+A8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAEBK4Dw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN4iAgNGwCIF9DnFfN9EGoy1X0wzlSHI0DetgEoV7WjjOR64e0cwRAIgDBEq46N1jCUq9YxIs/91a5PkOsPno4hlHHwfgFQgnXwCIGPmeb3vK2mxTFcP1jFQluNy6oiLQUloLNuzeo0SrakPAQEFaVIhAvgxAXPwShF/o8L/llk5CNHscsPp2oSAmf2R2vEYxIrzIQNGwCIF9DnFfN9EGoy1X0wzlSHI0DetgEoV7WjjOR64eyEDTPJGkwhviQtdILDD8xUoOa4ARhrRspdx5FmhZ2xH1XJTriIGAvgxAXPwShF/o8L/llk5CNHscsPp2oSAmf2R2vEYxIrzBKWoJxoiBgNGwCIF9DnFfN9EGoy1X0wzlSHI0DetgEoV7WjjOR64ewQq46psIgYDTPJGkwhviQtdILDD8xUoOa4ARhrRspdx5FmhZ2xH1XIE9+uLBQABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAAAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAAAAA==", + "p2wsh_ms_2_psbt": "cHNidP8BAP2aAQIAAAAJ0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAAAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAEAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQAgAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFADAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAQAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQBQAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAGAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAcAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQCAAAAAD/////AcBByBcAAAAAFgAU86NkDG3go6XBS3IWTpj5bKedZfoAAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAEBH85eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7EAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAABAR+A8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAEBK4Dw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN4iAgL4MQFz8EoRf6PC/5ZZOQjR7HLD6dqEgJn9kdrxGMSK80cwRAIgPBaPAh7ivDrupTsrKJsq3RlRYvoJDThZ4fStplUdvFMCIEut9lon8iwiAj6wv0bjnxkP08eUyYiB7h+dROWhpcoUAQEFaVIhAvgxAXPwShF/o8L/llk5CNHscsPp2oSAmf2R2vEYxIrzIQNGwCIF9DnFfN9EGoy1X0wzlSHI0DetgEoV7WjjOR64eyEDTPJGkwhviQtdILDD8xUoOa4ARhrRspdx5FmhZ2xH1XJTriIGAvgxAXPwShF/o8L/llk5CNHscsPp2oSAmf2R2vEYxIrzBKWoJxoiBgNGwCIF9DnFfN9EGoy1X0wzlSHI0DetgEoV7WjjOR64ewQq46psIgYDTPJGkwhviQtdILDD8xUoOa4ARhrRspdx5FmhZ2xH1XIE9+uLBQABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAAAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAAAAA==", + "combined_psbt": "cHNidP8BAP2aAQIAAAAJ0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAAAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAEAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQAgAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFADAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAQAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQBQAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAGAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAcAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQCAAAAAD/////AcBByBcAAAAAFgAU86NkDG3go6XBS3IWTpj5bKedZfoAAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAEBH85eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7EBCGsCRzBEAiBAf8l/MAdx8EmbfrjyzdhwXOemFfyJOh8sJekKMi/4QgIgH3xp2zAzrr9/67CAnfNqdQ0GXbVrn7Dx5EklAO58H0QBIQKOyYCO13OUw/9ulMHA+D+guq7JFe/yBWbH6LCXWPCL6wABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAABASCA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8hwEHIyIAIIY3qybnWjFQ0qr6nV1P2bpNuD+VKumMcwHzoldS9HnlAQhtAkcwRAIgdDShgAg9gl5fA0J5gyVB+joUCJSnlQEZ0E7ktkMQweMCIGIYpxNNwuGdiLH7kxzRV32YjxqgBGkMFxk6Y7zUqE3UASMhA08giwCSOgxsWpHXNSBrCmPnRtY6iyMraqm86YMvP02lrAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAABASuA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJAQhtAkcwRAIgIKaUpQVz8iYbrzWTr8wQrJ5udPtLNqjbgnPtl2GVwKMCIF48XGTtirGaoaGTQZXIn0Qks02Z+fpix4FlS1WnxYQnASMhAgrkls/KhuUciMRUOLcGl63nlpQp15zu/eeoJPxYXQ9/rAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAABAR+A8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZAQhrAkcwRAIgdGRcVzpz1uns6sfythsNQR30H2aR72EvXy0lIJtsxMECIBFPqwo9/Vin577VqoKIROjP1SFFCyQoMwzSUHInsiuRASEDaTGSuBucvv3QUyHrTEYCZKEIHWQ5anYzLz2zsSG91DMAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAQErgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3iICA0bAIgX0OcV830QajLVfTDOVIcjQN62AShXtaOM5Hrh7RzBEAiAMESrjo3WMJSr1jEiz/3Vrk+Q6w+ejiGUcfB+AVCCdfAIgY+Z5ve8rabFMVw/WMVCW43LqiItBSWgs27N6jRKtqQ8BIgIC+DEBc/BKEX+jwv+WWTkI0exyw+nahICZ/ZHa8RjEivNHMEQCIDwWjwIe4rw67qU7KyibKt0ZUWL6CQ04WeH0raZVHbxTAiBLrfZaJ/IsIgI+sL9G458ZD9PHlMmIge4fnUTloaXKFAEBBWlSIQL4MQFz8EoRf6PC/5ZZOQjR7HLD6dqEgJn9kdrxGMSK8yEDRsAiBfQ5xXzfRBqMtV9MM5UhyNA3rYBKFe1o4zkeuHshA0zyRpMIb4kLXSCww/MVKDmuAEYa0bKXceRZoWdsR9VyU64iBgL4MQFz8EoRf6PC/5ZZOQjR7HLD6dqEgJn9kdrxGMSK8wSlqCcaIgYDRsAiBfQ5xXzfRBqMtV9MM5UhyNA3rYBKFe1o4zkeuHsEKuOqbCIGA0zyRpMIb4kLXSCww/MVKDmuAEYa0bKXceRZoWdsR9VyBPfriwUAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAQEggPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYciAgIc8g9eaZ1LKTl7JIXzIvIa65MmSrhTK8YRJ5eEGNSe0UcwRAIgH8mpKSoqkttOmQgfyiv0xwYnFcSLBcSHuESknmd+FLECIHFTUoFWxTXhUA4ZgFk7o3rGSfiywfhpOgpHvq8t1MZ6ASICA3j8GOuIWnK8bD4+vsXq3hvODvaKSGOyt866LZblEZcvRzBEAiAmsEB3Lsapby4p9FfInpUgwi9H42iUXgrV8a8ENeqAeQIgKLTYlYUsPvtK17dhM8ze4PQlQxeB6LLwmAFK3kxzafwBAQQiACC50l4yj/cqAwKr3ZjnkAme0/Mmd1oanHsxRYufLZVfYwEFaVIhAhzyD15pnUspOXskhfMi8hrrkyZKuFMrxhEnl4QY1J7RIQLAb5THUmmR8mkB8ifjq3s5h0m8DDB7CkiR3cJayIr1HCEDePwY64hacrxsPj6+xereG84O9opIY7K3zrotluURly9TriIGAhzyD15pnUspOXskhfMi8hrrkyZKuFMrxhEnl4QY1J7RBF0EzPMiBgLAb5THUmmR8mkB8ifjq3s5h0m8DDB7CkiR3cJayIr1HASVBcNoIgYDePwY64hacrxsPj6+xereG84O9opIY7K3zrotluURly8EkECwlQABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAAiAgM5VoFutQ1ASz1fMnmRWheiByikY2PfBafynUbVVAYmUEcwRAIgewqOWyFjAFOCYh5IENWeDlxym1dKer5PLewGcL4gIXcCIGggO0qf/mesBbyhRWmIcFDWo3J+C7wlSpcrehwvP6A5ASICA4mZOEX+jUvShCQsbbbHY3CwkevPFwQz9zBPbsHMqUgMRzBEAiBzbTB9oMcxiKsxLlXRLDAm4IBKXioX3Zmj2Go6vKc3XgIgSZuGuyThnxBu+IPlo+OLLmLcdVTaKkRyBMzzg77UvWcBAQRpUiEDFUahm2F9xqg4ENjgfzNM41G0GGE+ryY1qkJ7FSalx/ghAzlWgW61DUBLPV8yeZFaF6IHKKRjY98Fp/KdRtVUBiZQIQOJmThF/o1L0oQkLG22x2NwsJHrzxcEM/cwT27BzKlIDFOuIgYDFUahm2F9xqg4ENjgfzNM41G0GGE+ryY1qkJ7FSalx/gEJD11uiIGAzlWgW61DUBLPV8yeZFaF6IHKKRjY98Fp/KdRtVUBiZQBEXjKVQiBgOJmThF/o1L0oQkLG22x2NwsJHrzxcEM/cwT27BzKlIDARq5EuzAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAEHbEcwRAIgW6RzAN1ZD0RctWRDzmwT8LzQcSneRHZKJrg3BfZiYqYCIFu6fNSf40qhwG6D6tOB1kOC3LAQmtzZFXJQZW14GSn/ASMhAmKMixPWrTKQsQDUCuHN7K5RXvw/Gr1e+FTAdVyxh9H2rAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAABB2pHMEQCIHgvOV3R7nb4M5UnPrIUvanuIQBOdr6IlRuGOYIofIUOAiAgBDSVf3LguuLKEKUMjPl/8nnVHhOIC4INjpI82ZKWrgEhA1AQ8r2ipZlqr27axs2J6YdzD4rRt2IOrCmnJ5XVE6YjACICA6mCKJqJQsQQ51oP/Q71UVPsqP+xrApeb979opsSLzHoEGeceXQAAACAAAAAgAAAAIAA", + "complete_psbt": "cHNidP8BAP2aAQIAAAAJ0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAAAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAEAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQAgAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFADAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAQAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQBQAAAAD/////0winN9IByUg2QqbcNv1NVfiD8Uh8MhEGnB9i/Ff6SFAGAAAAAP/////TCKc30gHJSDZCptw2/U1V+IPxSHwyEQacH2L8V/pIUAcAAAAA/////9MIpzfSAclINkKm3Db9TVX4g/FIfDIRBpwfYvxX+khQCAAAAAD/////AcBByBcAAAAAFgAU86NkDG3go6XBS3IWTpj5bKedZfoAAAAAAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAEBH85eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7EBCGsCRzBEAiBAf8l/MAdx8EmbfrjyzdhwXOemFfyJOh8sJekKMi/4QgIgH3xp2zAzrr9/67CAnfNqdQ0GXbVrn7Dx5EklAO58H0QBIQKOyYCO13OUw/9ulMHA+D+guq7JFe/yBWbH6LCXWPCL6wABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAABASCA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8hwEHIyIAIIY3qybnWjFQ0qr6nV1P2bpNuD+VKumMcwHzoldS9HnlAQhtAkcwRAIgdDShgAg9gl5fA0J5gyVB+joUCJSnlQEZ0E7ktkMQweMCIGIYpxNNwuGdiLH7kxzRV32YjxqgBGkMFxk6Y7zUqE3UASMhA08giwCSOgxsWpHXNSBrCmPnRtY6iyMraqm86YMvP02lrAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAABASuA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJAQhtAkcwRAIgIKaUpQVz8iYbrzWTr8wQrJ5udPtLNqjbgnPtl2GVwKMCIF48XGTtirGaoaGTQZXIn0Qks02Z+fpix4FlS1WnxYQnASMhAgrkls/KhuUciMRUOLcGl63nlpQp15zu/eeoJPxYXQ9/rAABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAABAR+A8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZAQhrAkcwRAIgdGRcVzpz1uns6sfythsNQR30H2aR72EvXy0lIJtsxMECIBFPqwo9/Vin577VqoKIROjP1SFFCyQoMwzSUHInsiuRASEDaTGSuBucvv3QUyHrTEYCZKEIHWQ5anYzLz2zsSG91DMAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAQErgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3gEI/AQARzBEAiA8Fo8CHuK8Ou6lOysomyrdGVFi+gkNOFnh9K2mVR28UwIgS632WifyLCICPrC/RuOfGQ/Tx5TJiIHuH51E5aGlyhQBRzBEAiAMESrjo3WMJSr1jEiz/3Vrk+Q6w+ejiGUcfB+AVCCdfAIgY+Z5ve8rabFMVw/WMVCW43LqiItBSWgs27N6jRKtqQ8BaVIhAvgxAXPwShF/o8L/llk5CNHscsPp2oSAmf2R2vEYxIrzIQNGwCIF9DnFfN9EGoy1X0wzlSHI0DetgEoV7WjjOR64eyEDTPJGkwhviQtdILDD8xUoOa4ARhrRspdx5FmhZ2xH1XJTrgABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAABASCA8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chphwEHIyIAILnSXjKP9yoDAqvdmOeQCZ7T8yZ3WhqcezFFi58tlV9jAQj8BABHMEQCIB/JqSkqKpLbTpkIH8or9McGJxXEiwXEh7hEpJ5nfhSxAiBxU1KBVsU14VAOGYBZO6N6xkn4ssH4aToKR76vLdTGegFHMEQCICawQHcuxqlvLin0V8ielSDCL0fjaJReCtXxrwQ16oB5AiAotNiVhSw++0rXt2EzzN7g9CVDF4HosvCYAUreTHNp/AFpUiECHPIPXmmdSyk5eySF8yLyGuuTJkq4UyvGESeXhBjUntEhAsBvlMdSaZHyaQHyJ+OrezmHSbwMMHsKSJHdwlrIivUcIQN4/BjriFpyvGw+Pr7F6t4bzg72ikhjsrfOui2W5RGXL1OuAAEA/WkBAgAAAAEXUNNyuMJUiRxTf70xOP1jeqP319FEl7pG0OAxv2QmFAAAAAAA/v///wnOXi4SAQAAABYAFJ/NWVnRkyEUv9JimT6osqkmcauxgPD6AgAAAAAXqRSd5nSHjaZHXgBa1LuBJLvcf35j/IeA8PoCAAAAACIAIFTqZ4EMPhJ4ZabcILTBn62oVb4Gu1kegf/amL1qFDRJgPD6AgAAAAAWABR2WjPfBmcSViSAyRnb5DCwReSmmYDw+gIAAAAAIgAgvnOo3OeUTjP10JgLepzp4olyPr52+65XfA+h2tB4LN6A8PoCAAAAABepFAyQrTw0xTxZivkWe2bigAgT1chph4Dw+gIAAAAAF6kULdzdQIJRR4ojhfFdmfLdw6wUqpWHgPD6AgAAAAAXqRRVX4CcBGmL8gYxdD+Qj4OQ95+vAoeA8PoCAAAAABl2qRRHrrheehmBxwe2/LDeK5ALI8ti6oisZQAAAAEH/ABHMEQCIHsKjlshYwBTgmIeSBDVng5ccptXSnq+Ty3sBnC+ICF3AiBoIDtKn/5nrAW8oUVpiHBQ1qNyfgu8JUqXK3ocLz+gOQFHMEQCIHNtMH2gxzGIqzEuVdEsMCbggEpeKhfdmaPYajq8pzdeAiBJm4a7JOGfEG74g+Wj44suYtx1VNoqRHIEzPODvtS9ZwFMaVIhAxVGoZthfcaoOBDY4H8zTONRtBhhPq8mNapCexUmpcf4IQM5VoFutQ1ASz1fMnmRWheiByikY2PfBafynUbVVAYmUCEDiZk4Rf6NS9KEJCxttsdjcLCR688XBDP3ME9uwcypSAxTrgABAP1pAQIAAAABF1DTcrjCVIkcU3+9MTj9Y3qj99fRRJe6RtDgMb9kJhQAAAAAAP7///8Jzl4uEgEAAAAWABSfzVlZ0ZMhFL/SYpk+qLKpJnGrsYDw+gIAAAAAF6kUneZ0h42mR14AWtS7gSS73H9+Y/yHgPD6AgAAAAAiACBU6meBDD4SeGWm3CC0wZ+tqFW+BrtZHoH/2pi9ahQ0SYDw+gIAAAAAFgAUdloz3wZnElYkgMkZ2+QwsEXkppmA8PoCAAAAACIAIL5zqNznlE4z9dCYC3qc6eKJcj6+dvuuV3wPodrQeCzegPD6AgAAAAAXqRQMkK08NMU8WYr5Fntm4oAIE9XIaYeA8PoCAAAAABepFC3c3UCCUUeKI4XxXZny3cOsFKqVh4Dw+gIAAAAAF6kUVV+AnARpi/IGMXQ/kI+DkPefrwKHgPD6AgAAAAAZdqkUR664XnoZgccHtvyw3iuQCyPLYuqIrGUAAAABB2xHMEQCIFukcwDdWQ9EXLVkQ85sE/C80HEp3kR2Sia4NwX2YmKmAiBbunzUn+NKocBug+rTgdZDgtywEJrc2RVyUGVteBkp/wEjIQJijIsT1q0ykLEA1ArhzeyuUV78Pxq9XvhUwHVcsYfR9qwAAQD9aQECAAAAARdQ03K4wlSJHFN/vTE4/WN6o/fX0USXukbQ4DG/ZCYUAAAAAAD+////Cc5eLhIBAAAAFgAUn81ZWdGTIRS/0mKZPqiyqSZxq7GA8PoCAAAAABepFJ3mdIeNpkdeAFrUu4Eku9x/fmP8h4Dw+gIAAAAAIgAgVOpngQw+EnhlptwgtMGfrahVvga7WR6B/9qYvWoUNEmA8PoCAAAAABYAFHZaM98GZxJWJIDJGdvkMLBF5KaZgPD6AgAAAAAiACC+c6jc55ROM/XQmAt6nOniiXI+vnb7rld8D6Ha0Hgs3oDw+gIAAAAAF6kUDJCtPDTFPFmK+RZ7ZuKACBPVyGmHgPD6AgAAAAAXqRQt3N1AglFHiiOF8V2Z8t3DrBSqlYeA8PoCAAAAABepFFVfgJwEaYvyBjF0P5CPg5D3n68Ch4Dw+gIAAAAAGXapFEeuuF56GYHHB7b8sN4rkAsjy2LqiKxlAAAAAQdqRzBEAiB4Lzld0e52+DOVJz6yFL2p7iEATna+iJUbhjmCKHyFDgIgIAQ0lX9y4LriyhClDIz5f/J51R4TiAuCDY6SPNmSlq4BIQNQEPK9oqWZaq9u2sbNiemHcw+K0bdiDqwppyeV1ROmIwAiAgOpgiiaiULEEOdaD/0O9VFT7Kj/sawKXm/e/aKbEi8x6BBnnHl0AAAAgAAAAIAAAACAAA==", + "final_tx": "02000000000109d308a737d201c9483642a6dc36fd4d55f883f1487c3211069c1f62fc57fa48500000000000ffffffffd308a737d201c9483642a6dc36fd4d55f883f1487c3211069c1f62fc57fa485001000000232200208637ab26e75a3150d2aafa9d5d4fd9ba4db83f952ae98c7301f3a25752f479e5ffffffffd308a737d201c9483642a6dc36fd4d55f883f1487c3211069c1f62fc57fa48500200000000ffffffffd308a737d201c9483642a6dc36fd4d55f883f1487c3211069c1f62fc57fa48500300000000ffffffffd308a737d201c9483642a6dc36fd4d55f883f1487c3211069c1f62fc57fa48500400000000ffffffffd308a737d201c9483642a6dc36fd4d55f883f1487c3211069c1f62fc57fa48500500000023220020b9d25e328ff72a0302abdd98e790099ed3f326775a1a9c7b31458b9f2d955f63ffffffffd308a737d201c9483642a6dc36fd4d55f883f1487c3211069c1f62fc57fa485006000000fc0047304402207b0a8e5b2163005382621e4810d59e0e5c729b574a7abe4f2dec0670be202177022068203b4a9ffe67ac05bca14569887050d6a3727e0bbc254a972b7a1c2f3fa039014730440220736d307da0c73188ab312e55d12c3026e0804a5e2a17dd99a3d86a3abca7375e0220499b86bb24e19f106ef883e5a3e38b2e62dc7554da2a447204ccf383bed4bd67014c695221031546a19b617dc6a83810d8e07f334ce351b418613eaf2635aa427b1526a5c7f821033956816eb50d404b3d5f3279915a17a20728a46363df05a7f29d46d554062650210389993845fe8d4bd284242c6db6c76370b091ebcf170433f7304f6ec1cca9480c53aeffffffffd308a737d201c9483642a6dc36fd4d55f883f1487c3211069c1f62fc57fa4850070000006c47304402205ba47300dd590f445cb56443ce6c13f0bcd07129de44764a26b83705f66262a602205bba7cd49fe34aa1c06e83ead381d64382dcb0109adcd9157250656d781929ff01232102628c8b13d6ad3290b100d40ae1cdecae515efc3f1abd5ef854c0755cb187d1f6acffffffffd308a737d201c9483642a6dc36fd4d55f883f1487c3211069c1f62fc57fa4850080000006a4730440220782f395dd1ee76f83395273eb214bda9ee21004e76be88951b863982287c850e0220200434957f72e0bae2ca10a50c8cf97ff279d51e13880b820d8e923cd99296ae0121035010f2bda2a5996aaf6edac6cd89e987730f8ad1b7620eac29a72795d513a623ffffffff01c041c81700000000160014f3a3640c6de0a3a5c14b72164e98f96ca79d65fa024730440220407fc97f300771f0499b7eb8f2cdd8705ce7a615fc893a1f2c25e90a322ff84202201f7c69db3033aebf7febb0809df36a750d065db56b9fb0f1e4492500ee7c1f440121028ec9808ed77394c3ff6e94c1c0f83fa0baaec915eff20566c7e8b09758f08beb0247304402207434a180083d825e5f034279832541fa3a140894a7950119d04ee4b64310c1e302206218a7134dc2e19d88b1fb931cd1577d988f1aa004690c17193a63bcd4a84dd4012321034f208b00923a0c6c5a91d735206b0a63e746d63a8b232b6aa9bce9832f3f4da5ac02473044022020a694a50573f2261baf3593afcc10ac9e6e74fb4b36a8db8273ed976195c0a302205e3c5c64ed8ab19aa1a1934195c89f4424b34d99f9fa62c781654b55a7c58427012321020ae496cfca86e51c88c45438b70697ade7969429d79ceefde7a824fc585d0f7fac02473044022074645c573a73d6e9eceac7f2b61b0d411df41f6691ef612f5f2d25209b6cc4c10220114fab0a3dfd58a7e7bed5aa828844e8cfd521450b2428330cd2507227b22b91012103693192b81b9cbefdd05321eb4c460264a1081d64396a76332f3db3b121bdd433040047304402203c168f021ee2bc3aeea53b2b289b2add195162fa090d3859e1f4ada6551dbc5302204badf65a27f22c22023eb0bf46e39f190fd3c794c98881ee1f9d44e5a1a5ca140147304402200c112ae3a3758c252af58c48b3ff756b93e43ac3e7a388651c7c1f8054209d7c022063e679bdef2b69b14c570fd6315096e372ea888b4149682cdbb37a8d12ada90f0169522102f8310173f04a117fa3c2ff96593908d1ec72c3e9da848099fd91daf118c48af3210346c02205f439c57cdf441a8cb55f4c339521c8d037ad804a15ed68e3391eb87b21034cf24693086f890b5d20b0c3f3152839ae00461ad1b29771e459a1676c47d57253ae040047304402201fc9a9292a2a92db4e99081fca2bf4c7062715c48b05c487b844a49e677e14b102207153528156c535e1500e1980593ba37ac649f8b2c1f8693a0a47beaf2dd4c67a01473044022026b040772ec6a96f2e29f457c89e9520c22f47e368945e0ad5f1af0435ea8079022028b4d895852c3efb4ad7b76133ccdee0f425431781e8b2f098014ade4c7369fc01695221021cf20f5e699d4b29397b2485f322f21aeb93264ab8532bc61127978418d49ed12102c06f94c7526991f26901f227e3ab7b398749bc0c307b0a4891ddc25ac88af51c210378fc18eb885a72bc6c3e3ebec5eade1bce0ef68a4863b2b7ceba2d96e511972f53ae00000000000000" +} diff --git a/haskoin-core.cabal b/haskoin-core.cabal --- a/haskoin-core.cabal +++ b/haskoin-core.cabal @@ -3,11 +3,9 @@ -- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack --- --- hash: 83e95434961483bbb306908fbc61269ebec705003a8994ca0a8a04d1e3f7de50 name: haskoin-core -version: 0.20.5 +version: 0.21.0 synopsis: Bitcoin & Bitcoin Cash library for Haskell description: Please see the README on GitHub at category: Bitcoin, Finance, Network @@ -21,6 +19,8 @@ license-file: LICENSE build-type: Simple extra-source-files: + data/bip341.json + data/complex_psbt.json data/forkid_script_tests.json data/forkid_sighash.json data/key_io_invalid.json @@ -55,6 +55,7 @@ Haskoin.Crypto Haskoin.Crypto.Hash Haskoin.Crypto.Signature + Haskoin.Data Haskoin.Keys Haskoin.Keys.Common Haskoin.Keys.Extended @@ -74,6 +75,7 @@ Haskoin.Transaction.Genesis Haskoin.Transaction.Partial Haskoin.Transaction.Segwit + Haskoin.Transaction.Taproot Haskoin.Util Haskoin.Util.Arbitrary Haskoin.Util.Arbitrary.Address @@ -86,7 +88,7 @@ Haskoin.Util.Arbitrary.Transaction Haskoin.Util.Arbitrary.Util other-modules: - Paths_haskoin_core + Haskoin.Keys.Extended.Internal hs-source-dirs: src build-depends: @@ -138,6 +140,7 @@ Haskoin.NetworkSpec Haskoin.ScriptSpec Haskoin.Transaction.PartialSpec + Haskoin.Transaction.TaprootSpec Haskoin.TransactionSpec Haskoin.UtilSpec Paths_haskoin_core @@ -150,6 +153,7 @@ , array >=0.5.4.0 , base >=4.9 && <5 , base16 >=0.3.0.1 + , base64 ==0.4.* , binary >=0.8.8 , bytes >=0.17 , bytestring >=0.10.10.0 diff --git a/src/Haskoin.hs b/src/Haskoin.hs --- a/src/Haskoin.hs +++ b/src/Haskoin.hs @@ -1,4 +1,4 @@ -{-| +{- | Module : Haskoin Description : Bitcoin (BTC/BCH) Libraries for Haskell Copyright : No rights reserved @@ -10,24 +10,26 @@ This module exports almost all of Haskoin Core, excluding only a few highly specialized address and block-related functions. -} -module Haskoin - ( module Address - , module Network - , module Constants - , module Block - , module Transaction - , module Script - , module Keys - , module Crypto - , module Util - ) where +module Haskoin ( + module Data, + module Constants, + module Address, + module Block, + module Transaction, + module Script, + module Keys, + module Crypto, + module Network, + module Util, +) where -import Haskoin.Address as Address -import Haskoin.Block as Block -import Haskoin.Constants as Constants -import Haskoin.Crypto as Crypto -import Haskoin.Keys as Keys -import Haskoin.Network as Network -import Haskoin.Script as Script -import Haskoin.Transaction as Transaction -import Haskoin.Util as Util +import Haskoin.Address as Address +import Haskoin.Block as Block +import Haskoin.Constants as Constants +import Haskoin.Crypto as Crypto +import Haskoin.Data as Data +import Haskoin.Keys as Keys +import Haskoin.Network as Network +import Haskoin.Script as Script +import Haskoin.Transaction as Transaction +import Haskoin.Util as Util diff --git a/src/Haskoin/Address.hs b/src/Haskoin/Address.hs --- a/src/Haskoin/Address.hs +++ b/src/Haskoin/Address.hs @@ -1,10 +1,11 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-| + +{- | Module : Haskoin.Address Copyright : No rights reserved License : MIT @@ -14,100 +15,100 @@ Base58, CashAddr, Bech32 address and WIF private key serialization support. -} -module Haskoin.Address - ( -- * Addresses - Address(..) - , isPubKeyAddress - , isScriptAddress - , isWitnessAddress - , isWitnessPubKeyAddress - , isWitnessScriptAddress - , addrToText - , textToAddr - , bech32ToAddr - , cashToAddr - , base58ToAddr - , addrToJSON - , addrToEncoding - , addrFromJSON - , pubKeyAddr - , pubKeyWitnessAddr - , pubKeyCompatWitnessAddr - , p2pkhAddr - , p2wpkhAddr - , p2shAddr - , p2wshAddr - , inputAddress - , outputAddress - , addressToScript - , addressToScriptBS - , addressToOutput - , payToScriptAddress - , payToWitnessScriptAddress - , payToNestedScriptAddress - , scriptToAddress - , scriptToAddressBS - , module Haskoin.Address.Base58 - , module Haskoin.Address.Bech32 - , module Haskoin.Address.CashAddr - ) where +module Haskoin.Address ( + -- * Addresses + Address (..), + isPubKeyAddress, + isScriptAddress, + isWitnessAddress, + isWitnessPubKeyAddress, + isWitnessScriptAddress, + addrToText, + textToAddr, + bech32ToAddr, + cashToAddr, + base58ToAddr, + addrToJSON, + addrToEncoding, + addrFromJSON, + pubKeyAddr, + pubKeyWitnessAddr, + pubKeyCompatWitnessAddr, + p2pkhAddr, + p2wpkhAddr, + p2shAddr, + p2wshAddr, + inputAddress, + outputAddress, + addressToScript, + addressToScriptBS, + addressToOutput, + payToScriptAddress, + payToWitnessScriptAddress, + payToNestedScriptAddress, + scriptToAddress, + scriptToAddressBS, + module Haskoin.Address.Base58, + module Haskoin.Address.Bech32, + module Haskoin.Address.CashAddr, +) where -import Control.Applicative -import Control.Arrow (second) -import Control.DeepSeq -import Control.Monad -import Data.Aeson as A -import Data.Aeson.Encoding as A -import Data.Aeson.Types -import Data.Binary (Binary (..)) -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import Data.Hashable -import Data.Maybe -import Data.Serialize (Serialize (..)) -import Data.Text (Text) -import qualified Data.Text as T -import Data.Word (Word8) -import GHC.Generics (Generic) -import Haskoin.Address.Base58 -import Haskoin.Address.Bech32 -import Haskoin.Address.CashAddr -import Haskoin.Constants -import Haskoin.Crypto -import Haskoin.Keys.Common -import Haskoin.Script -import Haskoin.Util +import Control.Applicative +import Control.Arrow (second) +import Control.DeepSeq +import Control.Monad +import Data.Aeson as A +import Data.Aeson.Encoding as A +import Data.Aeson.Types +import Data.Binary (Binary (..)) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.Hashable +import Data.Maybe +import Data.Serialize (Serialize (..)) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Word (Word8) +import GHC.Generics (Generic) +import Haskoin.Address.Base58 +import Haskoin.Address.Bech32 +import Haskoin.Address.CashAddr +import Haskoin.Crypto +import Haskoin.Data +import Haskoin.Keys.Common +import Haskoin.Script +import Haskoin.Util -- | Address format for Bitcoin and Bitcoin Cash. data Address - -- | pay to public key hash (regular) - = PubKeyAddress - { getAddrHash160 :: !Hash160 - -- ^ RIPEMD160 hash of public key's SHA256 hash - } - -- | pay to script hash - | ScriptAddress - { getAddrHash160 :: !Hash160 - -- ^ RIPEMD160 hash of script's SHA256 hash - } - -- | pay to witness public key hash - | WitnessPubKeyAddress - { getAddrHash160 :: !Hash160 - -- ^ RIPEMD160 hash of public key's SHA256 hash - } - -- | pay to witness script hash - | WitnessScriptAddress - { getAddrHash256 :: !Hash256 - -- ^ HASH256 hash of script - } - -- | other witness address - | WitnessAddress - { getAddrVersion :: !Word8 - , getAddrData :: !ByteString - } + = -- | pay to public key hash (regular) + PubKeyAddress + { -- | RIPEMD160 hash of public key's SHA256 hash + getAddrHash160 :: !Hash160 + } + | -- | pay to script hash + ScriptAddress + { -- | RIPEMD160 hash of script's SHA256 hash + getAddrHash160 :: !Hash160 + } + | -- | pay to witness public key hash + WitnessPubKeyAddress + { -- | RIPEMD160 hash of public key's SHA256 hash + getAddrHash160 :: !Hash160 + } + | -- | pay to witness script hash + WitnessScriptAddress + { -- | HASH256 hash of script + getAddrHash256 :: !Hash256 + } + | -- | other witness address + WitnessAddress + { getAddrVersion :: !Word8 + , getAddrData :: !ByteString + } deriving (Eq, Ord, Generic, Show, Read, Hashable, NFData) @@ -132,15 +133,17 @@ deserialize = getWord8 >>= \case - 0x00 -> PubKeyAddress <$> deserialize - 0x01 -> ScriptAddress <$> deserialize - 0x02 -> WitnessPubKeyAddress <$> deserialize - 0x03 -> WitnessScriptAddress <$> deserialize - 0x04 -> WitnessAddress <$> getWord8 <*> - (getByteString . fromIntegral =<< getWord64be) - b -> fail . T.unpack $ - "Could not decode address type byte: " <> - encodeHex (B.singleton b) + 0x00 -> PubKeyAddress <$> deserialize + 0x01 -> ScriptAddress <$> deserialize + 0x02 -> WitnessPubKeyAddress <$> deserialize + 0x03 -> WitnessScriptAddress <$> deserialize + 0x04 -> + WitnessAddress <$> getWord8 + <*> (getByteString . fromIntegral =<< getWord64be) + b -> + fail . T.unpack $ + "Could not decode address type byte: " + <> encodeHex (B.singleton b) instance Serialize Address where put = serialize @@ -152,27 +155,28 @@ -- | 'Address' pays to a public key hash. isPubKeyAddress :: Address -> Bool -isPubKeyAddress PubKeyAddress {} = True -isPubKeyAddress _ = False +isPubKeyAddress PubKeyAddress{} = True +isPubKeyAddress _ = False -- | 'Address' pays to a script hash. isScriptAddress :: Address -> Bool -isScriptAddress ScriptAddress {} = True -isScriptAddress _ = False +isScriptAddress ScriptAddress{} = True +isScriptAddress _ = False --- | 'Address' pays to a witness public key hash. Only valid for SegWit --- networks. +{- | 'Address' pays to a witness public key hash. Only valid for SegWit + networks. +-} isWitnessPubKeyAddress :: Address -> Bool -isWitnessPubKeyAddress WitnessPubKeyAddress {} = True -isWitnessPubKeyAddress _ = False +isWitnessPubKeyAddress WitnessPubKeyAddress{} = True +isWitnessPubKeyAddress _ = False isWitnessScriptAddress :: Address -> Bool -isWitnessScriptAddress WitnessScriptAddress {} = True -isWitnessScriptAddress _ = False +isWitnessScriptAddress WitnessScriptAddress{} = True +isWitnessScriptAddress _ = False isWitnessAddress :: Address -> Bool -isWitnessAddress WitnessAddress {} = True -isWitnessAddress _ = False +isWitnessAddress WitnessAddress{} = True +isWitnessAddress _ = False addrToJSON :: Network -> Address -> Value addrToJSON net a = toJSON (addrToText net a) @@ -180,34 +184,36 @@ addrToEncoding :: Network -> Address -> Encoding addrToEncoding net = maybe null_ text . addrToText net --- | JSON parsing for Bitcoin addresses. Works with 'Base58', 'CashAddr' and --- 'Bech32'. +{- | JSON parsing for Bitcoin addresses. Works with 'Base58', 'CashAddr' and + 'Bech32'. +-} addrFromJSON :: Network -> Value -> Parser Address addrFromJSON net = withText "address" $ \t -> case textToAddr net t of Nothing -> fail "could not decode address" - Just x -> return x + Just x -> return x --- | Convert address to human-readable string. Uses 'Base58', 'Bech32', or --- 'CashAddr' depending on network. +{- | Convert address to human-readable string. Uses 'Base58', 'Bech32', or + 'CashAddr' depending on network. +-} addrToText :: Network -> Address -> Maybe Text -addrToText net a@PubKeyAddress {getAddrHash160 = h} +addrToText net a@PubKeyAddress{getAddrHash160 = h} | isNothing (getCashAddrPrefix net) = Just . encodeBase58Check . runPutS $ base58put net a | otherwise = cashAddrEncode net 0 (runPutS $ serialize h) -addrToText net a@ScriptAddress {getAddrHash160 = h} +addrToText net a@ScriptAddress{getAddrHash160 = h} | isNothing (getCashAddrPrefix net) = Just . encodeBase58Check . runPutS $ base58put net a | otherwise = cashAddrEncode net 1 (runPutS $ serialize h) -addrToText net WitnessPubKeyAddress {getAddrHash160 = h} = do +addrToText net WitnessPubKeyAddress{getAddrHash160 = h} = do hrp <- getBech32Prefix net segwitEncode hrp 0 (B.unpack (runPutS $ serialize h)) -addrToText net WitnessScriptAddress {getAddrHash256 = h} = do +addrToText net WitnessScriptAddress{getAddrHash256 = h} = do hrp <- getBech32Prefix net segwitEncode hrp 0 (B.unpack (runPutS $ serialize h)) -addrToText net WitnessAddress {getAddrVersion = v, getAddrData = d} = do +addrToText net WitnessAddress{getAddrVersion = v, getAddrData = d} = do hrp <- getBech32Prefix net segwitEncode hrp v (B.unpack d) @@ -232,7 +238,7 @@ 0 -> case B.length bs of 20 -> WitnessPubKeyAddress <$> eitherToMaybe (runGetS deserialize bs) 32 -> WitnessScriptAddress <$> eitherToMaybe (runGetS deserialize bs) - _ -> Nothing + _ -> Nothing _ -> Just $ WitnessAddress ver bs base58ToAddr :: Network -> Text -> Maybe Address @@ -252,11 +258,11 @@ base58put :: MonadPut m => Network -> Address -> m () base58put net (PubKeyAddress h) = do - putWord8 (getAddrPrefix net) - serialize h + putWord8 (getAddrPrefix net) + serialize h base58put net (ScriptAddress h) = do - putWord8 (getScriptPrefix net) - serialize h + putWord8 (getScriptPrefix net) + serialize h base58put _ _ = error "Cannot serialize this address as Base58" -- | Obtain a standard pay-to-public-key-hash address from a public key. @@ -267,24 +273,26 @@ p2pkhAddr :: Hash160 -> Address p2pkhAddr = PubKeyAddress --- | Obtain a SegWit pay-to-witness-public-key-hash (P2WPKH) address from a --- public key. +{- | Obtain a SegWit pay-to-witness-public-key-hash (P2WPKH) address from a + public key. +-} pubKeyWitnessAddr :: PubKeyI -> Address pubKeyWitnessAddr = WitnessPubKeyAddress . addressHash . runPutS . serialize -- | Obtain a backwards-compatible SegWit P2SH-P2WPKH address from a public key. pubKeyCompatWitnessAddr :: PubKeyI -> Address pubKeyCompatWitnessAddr = - p2shAddr . - addressHash . - encodeOutputBS . - PayWitnessPKHash . - addressHash . - runPutS . - serialize + p2shAddr + . addressHash + . encodeOutputBS + . PayWitnessPKHash + . addressHash + . runPutS + . serialize --- | Obtain a SegWit pay-to-witness-public-key-hash (P2WPKH) address from a --- 'Hash160'. +{- | Obtain a SegWit pay-to-witness-public-key-hash (P2WPKH) address from a + 'Hash160'. +-} p2wpkhAddr :: Hash160 -> Address p2wpkhAddr = WitnessPubKeyAddress @@ -300,8 +308,9 @@ payToScriptAddress :: ScriptOutput -> Address payToScriptAddress = p2shAddr . addressHash . encodeOutputBS --- | Compute a SegWit pay-to-witness-script-hash (P2WSH) address for an output --- script. +{- | Compute a SegWit pay-to-witness-script-hash (P2WSH) address for an output + script. +-} payToWitnessScriptAddress :: ScriptOutput -> Address payToWitnessScriptAddress = p2wshAddr . sha256 . encodeOutputBS @@ -310,16 +319,17 @@ payToNestedScriptAddress = p2shAddr . addressHash . encodeOutputBS . toP2WSH . encodeOutput --- | Encode an output script from an address. Will fail if using a --- pay-to-witness address on a non-SegWit network. +{- | Encode an output script from an address. Will fail if using a + pay-to-witness address on a non-SegWit network. +-} addressToOutput :: Address -> ScriptOutput addressToOutput = \case - PubKeyAddress h -> PayPKHash h - ScriptAddress h -> PayScriptHash h + PubKeyAddress h -> PayPKHash h + ScriptAddress h -> PayScriptHash h WitnessPubKeyAddress h -> PayWitnessPKHash h WitnessScriptAddress h -> PayWitnessScriptHash h - WitnessAddress v d -> PayWitness v d + WitnessAddress v d -> PayWitness v d -- | Get output script AST for an 'Address'. addressToScript :: Address -> Script @@ -343,18 +353,18 @@ outputAddress :: ScriptOutput -> Maybe Address outputAddress = \case - PayPKHash h -> Just $ PubKeyAddress h - PayScriptHash h -> Just $ ScriptAddress h - PayPK k -> Just $ pubKeyAddr k - PayWitnessPKHash h -> Just $ WitnessPubKeyAddress h + PayPKHash h -> Just $ PubKeyAddress h + PayScriptHash h -> Just $ ScriptAddress h + PayPK k -> Just $ pubKeyAddr k + PayWitnessPKHash h -> Just $ WitnessPubKeyAddress h PayWitnessScriptHash h -> Just $ WitnessScriptAddress h - PayWitness v d -> Just $ WitnessAddress v d - _ -> Nothing + PayWitness v d -> Just $ WitnessAddress v d + _ -> Nothing -- | Infer the 'Address' of a 'ScriptInput'. inputAddress :: ScriptInput -> Maybe Address inputAddress = \case (RegularInput (SpendPKHash _ key)) -> Just $ pubKeyAddr key - (ScriptHashInput _ rdm) -> Just $ payToScriptAddress rdm - _ -> Nothing + (ScriptHashInput _ rdm) -> Just $ payToScriptAddress rdm + _ -> Nothing diff --git a/src/Haskoin/Address/Base58.hs b/src/Haskoin/Address/Base58.hs --- a/src/Haskoin/Address/Base58.hs +++ b/src/Haskoin/Address/Base58.hs @@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -{-| + +{- | Module : Haskoin.Address.Base58 Copyright : No rights reserved License : MIT @@ -10,29 +11,29 @@ Support for legacy 'Base58' addresses. Superseded by Bech32 for Bitcoin SegWit (BTC) and CashAddr for Bitcoin Cash (BCH). -} -module Haskoin.Address.Base58 - ( -- * Base58 - Base58 - , encodeBase58 - , decodeBase58 - , encodeBase58Check - , decodeBase58Check - ) where +module Haskoin.Address.Base58 ( + -- * Base58 + Base58, + encodeBase58, + decodeBase58, + encodeBase58Check, + decodeBase58Check, +) where -import Control.Monad -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as C -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import Data.Maybe (fromMaybe, isJust, listToMaybe) -import Data.String.Conversions (cs) -import Data.Text (Text) -import qualified Data.Text as T -import Haskoin.Crypto.Hash -import Haskoin.Util -import Numeric (readInt, showIntAtBase) +import Control.Monad +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as C +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.Maybe (fromMaybe, isJust, listToMaybe) +import Data.String.Conversions (cs) +import Data.Text (Text) +import qualified Data.Text as T +import Haskoin.Crypto.Hash +import Haskoin.Util +import Numeric (readInt, showIntAtBase) -- | 'Base58' classic Bitcoin address format. type Base58 = Text @@ -41,8 +42,9 @@ b58Data :: ByteString b58Data = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz" --- | Convert a number less than or equal to provided integer into a 'Base58' --- character. +{- | Convert a number less than or equal to provided integer into a 'Base58' + character. +-} b58 :: Int -> Char b58 = C.index b58Data @@ -50,8 +52,9 @@ b58' :: Char -> Maybe Int b58' = flip C.elemIndex b58Data --- | Encode an arbitrary-length 'Integer' into a 'Base58' string. Leading zeroes --- will not be part of the resulting string. +{- | Encode an arbitrary-length 'Integer' into a 'Base58' string. Leading zeroes + will not be part of the resulting string. +-} encodeBase58I :: Integer -> Base58 encodeBase58I i = cs $ showIntAtBase 58 b58 i "" @@ -59,24 +62,26 @@ decodeBase58I :: Base58 -> Maybe Integer decodeBase58I s = case go of - Just (r,[]) -> Just r - _ -> Nothing + Just (r, []) -> Just r + _ -> Nothing where - p = isJust . b58' - f = fromMaybe e . b58' + p = isJust . b58' + f = fromMaybe e . b58' go = listToMaybe $ readInt 58 p f (cs s) - e = error "Could not decode base58" + e = error "Could not decode base58" --- | Encode an arbitrary 'ByteString' into a its 'Base58' representation, --- preserving leading zeroes. +{- | Encode an arbitrary 'ByteString' into a its 'Base58' representation, + preserving leading zeroes. +-} encodeBase58 :: ByteString -> Base58 encodeBase58 bs = l `mappend` r where (z, b) = BS.span (== 0) bs l = cs $ BS.replicate (BS.length z) (BS.index b58Data 0) -- preserve leading 0's - r | BS.null b = T.empty - | otherwise = encodeBase58I $ bsToInteger b + r + | BS.null b = T.empty + | otherwise = encodeBase58I $ bsToInteger b -- | Decode a 'Base58'-encoded 'Text' to a 'ByteString'. decodeBase58 :: Base58 -> Maybe ByteString @@ -85,18 +90,21 @@ where (z, b) = BS.span (== BS.index b58Data 0) (cs t) prefix = BS.replicate (BS.length z) 0 -- preserve leading 1's - r | BS.null b = Just BS.empty - | otherwise = integerToBS <$> decodeBase58I (cs b) + r + | BS.null b = Just BS.empty + | otherwise = integerToBS <$> decodeBase58I (cs b) --- | Computes a checksum for the input 'ByteString' and encodes the input and --- the checksum as 'Base58'. +{- | Computes a checksum for the input 'ByteString' and encodes the input and + the checksum as 'Base58'. +-} encodeBase58Check :: ByteString -> Base58 encodeBase58Check bs = encodeBase58 $ BS.append bs $ runPutS $ serialize $ checkSum32 bs --- | Decode a 'Base58'-encoded string that contains a checksum. This function --- returns 'Nothing' if the input string contains invalid 'Base58' characters or --- if the checksum fails. +{- | Decode a 'Base58'-encoded string that contains a checksum. This function + returns 'Nothing' if the input string contains invalid 'Base58' characters or + if the checksum fails. +-} decodeBase58Check :: Base58 -> Maybe ByteString decodeBase58Check bs = do rs <- decodeBase58 bs diff --git a/src/Haskoin/Address/Bech32.hs b/src/Haskoin/Address/Bech32.hs --- a/src/Haskoin/Address/Bech32.hs +++ b/src/Haskoin/Address/Bech32.hs @@ -1,6 +1,7 @@ -{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} -{-| + +{- | Module : Haskoin.Address.Base58 Copyright : No rights reserved License : MIT @@ -11,41 +12,54 @@ Support for Bitcoin SegWit (BTC) Bech32 addresses. This module is a modified version of Marko Bencun's reference implementation. -} -module Haskoin.Address.Bech32 - ( -- * Bech32 - HRP - , Bech32 - , Bech32Encoding(..) - , bech32Const - , Data - , bech32Encode - , bech32Decode - , toBase32 - , toBase256 - , segwitEncode - , segwitDecode - , Word5(..) - , word5 - , fromWord5 - ) where +module Haskoin.Address.Bech32 ( + -- * Bech32 + HRP, + Bech32, + Bech32Encoding (..), + bech32Const, + Data, + bech32Encode, + bech32Decode, + toBase32, + toBase256, + segwitEncode, + segwitDecode, + Word5 (..), + word5, + fromWord5, +) where -import Control.Monad (guard) -import Data.Array (Array, assocs, bounds, listArray, (!), - (//)) -import Data.Bits (Bits, testBit, unsafeShiftL, - unsafeShiftR, xor, (.&.), (.|.)) -import qualified Data.ByteString as B -import Data.Char (toUpper) -import Data.Foldable (foldl') -import Data.Functor.Identity (Identity, runIdentity) -import Data.Ix (Ix (..)) -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.Encoding as E -import Data.Word (Word8) +import Control.Monad (guard) +import Data.Array ( + Array, + assocs, + bounds, + listArray, + (!), + (//), + ) +import Data.Bits ( + Bits, + testBit, + unsafeShiftL, + unsafeShiftR, + xor, + (.&.), + (.|.), + ) +import qualified Data.ByteString as B +import Data.Char (toUpper) +import Data.Foldable (foldl') +import Data.Functor.Identity (Identity, runIdentity) +import Data.Ix (Ix (..)) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as E +import Data.Word (Word8) data Bech32Encoding = Bech32 | Bech32m - deriving (Eq, Show, Ord, Enum) + deriving (Eq, Show, Ord, Enum) -- | Bech32 human-readable string. type Bech32 = Text @@ -61,8 +75,8 @@ (.<<.) = unsafeShiftL -- | Five-bit word for Bech32. -newtype Word5 = - UnsafeWord5 Word8 +newtype Word5 + = UnsafeWord5 Word8 deriving (Eq, Ord) instance Ix Word5 where @@ -107,22 +121,24 @@ generator = [0x3b6a57b2, 0x26508e6d, 0x1ea119fa, 0x3d4233dd, 0x2a1462b3] chk' = chk .<<. 5 `xor` fromWord5 value --- | Convert human-readable part of 'Bech32' string into a list of five-bit --- words. +{- | Convert human-readable part of 'Bech32' string into a list of five-bit + words. +-} bech32HRPExpand :: HRP -> [Word5] bech32HRPExpand hrp = - map (UnsafeWord5 . (.>>. 5)) hrpBytes ++ - [UnsafeWord5 0] ++ map word5 hrpBytes + map (UnsafeWord5 . (.>>. 5)) hrpBytes + ++ [UnsafeWord5 0] + ++ map word5 hrpBytes where hrpBytes = B.unpack $ E.encodeUtf8 hrp bech32Const :: Bech32Encoding -> Word -bech32Const Bech32 = 0x00000001 +bech32Const Bech32 = 0x00000001 bech32Const Bech32m = 0x2bc830a3 -- | Calculate Bech32 checksum for a string of five-bit words. bech32CreateChecksum :: Bech32Encoding -> HRP -> [Word5] -> [Word5] -bech32CreateChecksum enc hrp dat = [word5 (polymod .>>. i) | i <- [25,20 .. 0]] +bech32CreateChecksum enc hrp dat = [word5 (polymod .>>. i) | i <- [25, 20 .. 0]] where values = bech32HRPExpand hrp ++ dat w5 = values ++ map UnsafeWord5 [0, 0, 0, 0, 0, 0] @@ -131,18 +147,20 @@ -- | Verify Bech32 checksum for a human-readable part and string of five-bit words. bech32VerifyChecksum :: HRP -> [Word5] -> Maybe Bech32Encoding bech32VerifyChecksum hrp dat = - let poly = bech32Polymod (bech32HRPExpand hrp ++ dat) - in if | poly == bech32Const Bech32 -> Just Bech32 - | poly == bech32Const Bech32m -> Just Bech32m - | otherwise -> Nothing + let poly = bech32Polymod (bech32HRPExpand hrp ++ dat) + in if + | poly == bech32Const Bech32 -> Just Bech32 + | poly == bech32Const Bech32m -> Just Bech32m + | otherwise -> Nothing -- | Maximum length of a Bech32 result. maxBech32Length :: Int maxBech32Length = 90 --- | Encode string of five-bit words into 'Bech32' using a provided --- human-readable part. Can fail if 'HRP' is invalid or result would be longer --- than 90 characters. +{- | Encode string of five-bit words into 'Bech32' using a provided + human-readable part. Can fail if 'HRP' is invalid or result would be longer + than 90 characters. +-} bech32Encode :: Bech32Encoding -> HRP -> [Word5] -> Maybe Bech32 bech32Encode enc hrp dat = do guard $ checkHRP hrp @@ -154,11 +172,13 @@ -- | Check that human-readable part is valid for a 'Bech32' string. checkHRP :: HRP -> Bool -checkHRP hrp = not (T.null hrp) && - T.all (\char -> char >= '\x21' && char <= '\x7e') hrp +checkHRP hrp = + not (T.null hrp) + && T.all (\char -> char >= '\x21' && char <= '\x7e') hrp --- | Decode human-readable 'Bech32' string into a human-readable part and a --- string of five-bit words. +{- | Decode human-readable 'Bech32' string into a human-readable part and a + string of five-bit words. +-} bech32Decode :: Bech32 -> Maybe (Bech32Encoding, HRP, [Word5]) bech32Decode bech32 = do guard $ T.length bech32 <= maxBech32Length @@ -176,7 +196,7 @@ type Pad f = Int -> Int -> Word -> [[Word]] -> f [[Word]] yesPadding :: Pad Identity -yesPadding _ 0 _ result = return result +yesPadding _ 0 _ result = return result yesPadding _ _ padValue result = return $ [padValue] : result {-# INLINE yesPadding #-} @@ -186,24 +206,25 @@ return result {-# INLINE noPadding #-} --- | Big endian conversion of a bytestring from base \(2^{frombits}\) to base --- \(2^{tobits}\). {frombits} and {twobits} must be positive and --- \(2^{frombits}\) and \(2^{tobits}\) must be smaller than the size of Word. --- Every value in 'dat' must be strictly smaller than \(2^{frombits}\). +{- | Big endian conversion of a bytestring from base \(2^{frombits}\) to base + \(2^{tobits}\). {frombits} and {twobits} must be positive and + \(2^{frombits}\) and \(2^{tobits}\) must be smaller than the size of Word. + Every value in 'dat' must be strictly smaller than \(2^{frombits}\). +-} convertBits :: Functor f => [Word] -> Int -> Int -> Pad f -> f [Word] convertBits dat frombits tobits pad = concat . reverse <$> go dat 0 0 [] where go [] acc bits result = let padValue = (acc .<<. (tobits - bits)) .&. maxv - in pad frombits bits padValue result - go (value:dat') acc bits result = + in pad frombits bits padValue result + go (value : dat') acc bits result = go dat' acc' (bits' `rem` tobits) (result' : result) where acc' = (acc .<<. frombits) .|. fromIntegral value bits' = bits + frombits result' = [ (acc' .>>. b) .&. maxv - | b <- [bits' - tobits,bits' - 2 * tobits .. 0] + | b <- [bits' - tobits, bits' - 2 * tobits .. 0] ] maxv = (1 .<<. tobits) - 1 {-# INLINE convertBits #-} @@ -221,23 +242,24 @@ -- | Check if witness version and program are valid. segwitCheck :: Bech32Encoding -> Word8 -> Data -> Bool segwitCheck enc witver witprog = - witver <= 16 && - if witver == 0 - then enc == Bech32 && (length witprog == 20 || length witprog == 32) - else enc == Bech32m && (length witprog >= 2 && length witprog <= 40) + witver <= 16 + && if witver == 0 + then enc == Bech32 && (length witprog == 20 || length witprog == 32) + else enc == Bech32m && (length witprog >= 2 && length witprog <= 40) -- | Decode SegWit 'Bech32' address from a string and expected human-readable part. segwitDecode :: HRP -> Bech32 -> Maybe (Word8, Data) segwitDecode hrp addr = do (enc, hrp', dat) <- bech32Decode addr guard $ (hrp == hrp') && not (null dat) - let (UnsafeWord5 witver:datBase32) = dat + let (UnsafeWord5 witver : datBase32) = dat decoded <- toBase256 datBase32 guard $ segwitCheck enc witver decoded return (witver, decoded) --- | Encode 'Data' as a SegWit 'Bech32' address. Needs human-readable part and --- witness program version. +{- | Encode 'Data' as a SegWit 'Bech32' address. Needs human-readable part and + witness program version. +-} segwitEncode :: HRP -> Word8 -> Data -> Maybe Text segwitEncode hrp witver witprog = do guard $ segwitCheck enc witver witprog diff --git a/src/Haskoin/Address/CashAddr.hs b/src/Haskoin/Address/CashAddr.hs --- a/src/Haskoin/Address/CashAddr.hs +++ b/src/Haskoin/Address/CashAddr.hs @@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -{-| + +{- | Module : Haskoin.Address.CashAddr Copyright : No rights reserved License : MIT @@ -9,37 +10,38 @@ Support for Bitcoin Cash (BCH) CashAddr format. -} -module Haskoin.Address.CashAddr - ( -- * CashAddr - CashPrefix - , CashVersion - , CashAddr - , Cash32 - , cashAddrDecode - , cashAddrEncode - , cash32decodeType - , cash32encodeType - , cash32decode - , cash32encode - ) where +module Haskoin.Address.CashAddr ( + -- * CashAddr + CashPrefix, + CashVersion, + CashAddr, + Cash32, + cashAddrDecode, + cashAddrEncode, + cash32decodeType, + cash32encodeType, + cash32decode, + cash32encode, +) where -import Control.Monad -import Data.Bits -import Data.ByteString (ByteString) -import qualified Data.ByteString as B +import Control.Monad +import Data.Bits +import Data.ByteString (ByteString) +import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as C -import Data.Char -import Data.List -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.Encoding as E -import Data.Word -import Haskoin.Constants -import Haskoin.Util +import Data.Char +import Data.List +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as E +import Data.Word +import Haskoin.Data +import Haskoin.Util --- | 'CashAddr' prefix, usually shown before the colon in addresses, but sometimes --- omitted. It is used in the checksum calculation to avoid parsing an address --- from the wrong network. +{- | 'CashAddr' prefix, usually shown before the colon in addresses, but sometimes + omitted. It is used in the checksum calculation to avoid parsing an address + from the wrong network. +-} type CashPrefix = Text -- | 'CashAddr' version, until new address schemes appear it will be zero. @@ -48,8 +50,9 @@ -- | High level 'CashAddr' human-reabale string, with explicit or implicit prefix. type CashAddr = Text --- | Low level 'Cash32' is the human-readable low-level encoding used by 'CashAddr'. It --- need not encode a valid address but any binary data. +{- | Low level 'Cash32' is the human-readable low-level encoding used by 'CashAddr'. It + need not encode a valid address but any binary data. +-} type Cash32 = Text -- | Symbols for encoding 'Cash32' data in human-readable strings. @@ -60,8 +63,9 @@ base32char :: Char -> Maybe Word8 base32char = fmap fromIntegral . (`elemIndex` charset) --- | High-Level: decode 'CashAddr' string if it is valid for the --- provided 'Network'. Prefix may be omitted from the string. +{- | High-Level: decode 'CashAddr' string if it is valid for the + provided 'Network'. Prefix may be omitted from the string. +-} cashAddrDecode :: Network -> CashAddr -> Maybe (CashVersion, ByteString) cashAddrDecode net ca = do epfx <- getCashAddrPrefix net @@ -71,15 +75,17 @@ guard (dpfx == epfx) return (ver, bs) --- | High-Level: encode 'CashAddr' string for the provided network and hash. --- Fails if the 'CashVersion' or length of hash 'ByteString' is invalid. +{- | High-Level: encode 'CashAddr' string for the provided network and hash. + Fails if the 'CashVersion' or length of hash 'ByteString' is invalid. +-} cashAddrEncode :: Network -> CashVersion -> ByteString -> Maybe CashAddr cashAddrEncode net cv bs = do pfx <- getCashAddrPrefix net cash32encodeType pfx cv bs --- | Mid-Level: decode 'CashAddr' string containing arbitrary prefix, plus a --- version byte before the 'ByteString' that encodes type and length. +{- | Mid-Level: decode 'CashAddr' string containing arbitrary prefix, plus a + version byte before the 'ByteString' that encodes type and length. +-} cash32decodeType :: Cash32 -> Maybe (CashPrefix, CashVersion, ByteString) cash32decodeType ca' = do guard (T.toUpper ca' == ca' || ca == ca') @@ -93,8 +99,9 @@ where ca = T.toLower ca' --- | Mid-Level: encode 'CashAddr' string containing arbitrary prefix and --- 'CashVersion'. Length must be among those allowed by the standard. +{- | Mid-Level: encode 'CashAddr' string containing arbitrary prefix and + 'CashVersion'. Length must be among those allowed by the standard. +-} cash32encodeType :: CashPrefix -> CashVersion -> ByteString -> Maybe Cash32 cash32encodeType pfx cv bs = do let len = B.length bs @@ -102,8 +109,9 @@ let pl = vb `B.cons` bs return (cash32encode pfx pl) --- | Low-Level: decode 'Cash32' string. 'CashPrefix' must be part of the string. --- No version or hash length validation is performed. +{- | Low-Level: decode 'Cash32' string. 'CashPrefix' must be part of the string. + No version or hash length validation is performed. +-} cash32decode :: Cash32 -> Maybe (CashPrefix, ByteString) cash32decode text = do let bs = C.map toLower bs' @@ -124,8 +132,9 @@ where bs' = E.encodeUtf8 text --- | Low-Level: encode 'Cash32' string for 'CashPrefix' provided. Can encode --- arbitrary data. No prefix or length validation is performed. +{- | Low-Level: encode 'Cash32' string for 'CashPrefix' provided. Can encode + arbitrary data. No prefix or length validation is performed. +-} cash32encode :: CashPrefix -> ByteString -> Cash32 cash32encode pfx bs = let b32 = toBase32 bs @@ -134,21 +143,31 @@ cs = cash32Polymod pd c32 = B.map f (b32 <> cs) f = fromIntegral . ord . (charset !!) . fromIntegral - in pfx <> ":" <> E.decodeUtf8 c32 + in pfx <> ":" <> E.decodeUtf8 c32 --- | Convert base of 'ByteString' from eight bits per byte to five bits per --- byte, adding padding as necessary. +{- | Convert base of 'ByteString' from eight bits per byte to five bits per + byte, adding padding as necessary. +-} toBase32 :: ByteString -> ByteString toBase32 = - B.pack . - map fromIntegral . fst . convertBits True 8 5 . map fromIntegral . B.unpack + B.pack + . map fromIntegral + . fst + . convertBits True 8 5 + . map fromIntegral + . B.unpack --- | Convert base of 'ByteString' from five to eight bits per byte. Ignore --- padding to be symmetric with respect to 'toBase32' function. +{- | Convert base of 'ByteString' from five to eight bits per byte. Ignore + padding to be symmetric with respect to 'toBase32' function. +-} toBase256 :: ByteString -> ByteString toBase256 = - B.pack . - map fromIntegral . fst . convertBits False 5 8 . map fromIntegral . B.unpack + B.pack + . map fromIntegral + . fst + . convertBits False 5 8 + . map fromIntegral + . B.unpack -- | Obtain 'CashVersion' and payload length from 'CashAddr' version byte. decodeVersionByte :: Word8 -> Maybe (CashVersion, Int) @@ -160,8 +179,9 @@ len = ls !! fromIntegral (vb .&. 0x07) ls = [20, 24, 28, 32, 40, 48, 56, 64] --- | Encode 'CashVersion' and length into version byte. Fail if version is --- larger than five bits, or length incorrect, since that is invalid. +{- | Encode 'CashVersion' and length into version byte. Fail if version is + larger than five bits, or length incorrect, since that is invalid. +-} encodeVersionByte :: CashVersion -> Int -> Maybe Word8 encodeVersionByte ver len = do guard (ver == ver .&. 0x0f) @@ -174,7 +194,7 @@ 48 -> Just 5 56 -> Just 6 64 -> Just 7 - _ -> Nothing + _ -> Nothing return ((ver `shiftL` 3) .|. l) -- | Calculate or validate checksum from base32 'ByteString' (excluding prefix). @@ -187,7 +207,7 @@ outer c d = let c0 = (fromIntegral (c `shiftR` 35) :: Word8) c' = ((c .&. 0x07ffffffff) `shiftL` 5) `xor` fromIntegral d - in foldl' (inner c0) c' (zip [0 ..] generator) + in foldl' (inner c0) c' (zip [0 ..] generator) generator = [0x98f2bc8e61, 0x79b76d99e2, 0xf33e5fb3c4, 0xae2eabe2a8, 0x1e4f43e470] inner c0 c (b, g) diff --git a/src/Haskoin/Block.hs b/src/Haskoin/Block.hs --- a/src/Haskoin/Block.hs +++ b/src/Haskoin/Block.hs @@ -1,4 +1,4 @@ -{-| +{- | Module : Haskoin.Block Copyright : No rights reserved License : MIT @@ -8,12 +8,12 @@ Most functions relating to blocks are exported by this module. -} -module Haskoin.Block - ( module Haskoin.Block.Common - , module Haskoin.Block.Headers - , module Haskoin.Block.Merkle - ) where +module Haskoin.Block ( + module Haskoin.Block.Common, + module Haskoin.Block.Headers, + module Haskoin.Block.Merkle, +) where -import Haskoin.Block.Common -import Haskoin.Block.Headers -import Haskoin.Block.Merkle +import Haskoin.Block.Common +import Haskoin.Block.Headers +import Haskoin.Block.Merkle diff --git a/src/Haskoin/Block/Common.hs b/src/Haskoin/Block/Common.hs --- a/src/Haskoin/Block/Common.hs +++ b/src/Haskoin/Block/Common.hs @@ -1,7 +1,8 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} -{-| + +{- | Module : Haskoin.Block.Common Copyright : No rights reserved License : MIT @@ -11,54 +12,70 @@ Common data types and functions to handle blocks from the block chain. -} -module Haskoin.Block.Common - ( -- * Blocks - Block(..) - , BlockHeight - , Timestamp - , BlockHeader(..) - , headerHash - , BlockLocator - , GetBlocks(..) - , GetHeaders(..) - , BlockHeaderCount - , BlockHash(..) - , blockHashToHex - , hexToBlockHash - , Headers(..) - , decodeCompact - , encodeCompact - ) where +module Haskoin.Block.Common ( + -- * Blocks + Block (..), + BlockHeight, + Timestamp, + BlockHeader (..), + headerHash, + BlockLocator, + GetBlocks (..), + GetHeaders (..), + BlockHeaderCount, + BlockHash (..), + blockHashToHex, + hexToBlockHash, + Headers (..), + decodeCompact, + encodeCompact, +) where -import Control.DeepSeq -import Control.Monad (forM_, liftM2, mzero, replicateM) -import Data.Aeson (FromJSON (..), ToJSON (..), - Value (..), object, toJSON, - withObject, withText, (.:), (.=)) -import Data.Aeson.Encoding (pairs, unsafeToEncoding) -import Data.Binary (Binary (..)) -import Data.Bits (shiftL, shiftR, (.&.), (.|.)) -import qualified Data.ByteString as B -import Data.ByteString.Builder (char7) -import qualified Data.ByteString.Lazy as BL -import Data.Bytes.Get (MonadGet, getWord32le, runGetL, - runGetS) -import Data.Bytes.Put (MonadPut, putWord32le, runPutL, - runPutS) -import Data.Bytes.Serial (Serial (..)) -import Data.Hashable (Hashable) -import Data.Maybe (fromMaybe) -import Data.Serialize (Serialize (..)) -import Data.String (IsString, fromString) -import Data.String.Conversions (cs) -import Data.Text (Text) -import Data.Word (Word32) -import GHC.Generics (Generic) -import Haskoin.Crypto.Hash -import Haskoin.Network.Common -import Haskoin.Transaction.Common -import Haskoin.Util -import qualified Text.Read as R +import Control.DeepSeq +import Control.Monad (forM_, liftM2, mzero, replicateM, (<=<)) +import Data.Aeson ( + FromJSON (..), + ToJSON (..), + Value (..), + object, + toJSON, + withObject, + withText, + (.:), + (.=), + ) +import Data.Aeson.Encoding (pairs, unsafeToEncoding) +import Data.Binary (Binary (..)) +import Data.Bits (shiftL, shiftR, (.&.), (.|.)) +import qualified Data.ByteString as B +import Data.ByteString.Builder (char7) +import qualified Data.ByteString.Lazy as BL +import Data.Bytes.Get ( + MonadGet, + getWord32le, + runGetL, + runGetS, + ) +import Data.Bytes.Put ( + MonadPut, + putWord32le, + runPutL, + runPutS, + ) +import Data.Bytes.Serial (Serial (..)) +import Data.Hashable (Hashable) +import Data.Maybe (fromMaybe) +import Data.Serialize (Serialize (..)) +import Data.String (IsString, fromString) +import Data.String.Conversions (cs) +import Data.Text (Text) +import Data.Word (Word32) +import GHC.Generics (Generic) +import Haskoin.Crypto.Hash +import Haskoin.Network.Common +import Haskoin.Transaction.Common +import Haskoin.Util +import qualified Text.Read as R -- | Height of a block in the block chain, starting at 0 for Genesis. type BlockHeight = Word32 @@ -69,7 +86,7 @@ -- | Block header and transactions. data Block = Block { blockHeader :: !BlockHeader - , blockTxns :: ![Tx] + , blockTxns :: ![Tx] } deriving (Eq, Show, Read, Generic, Hashable, NFData) @@ -104,7 +121,8 @@ -- | Block header hash. To be serialized reversed for display purposes. newtype BlockHash = BlockHash { getBlockHash :: Hash256 - } deriving (Eq, Ord, Generic, Hashable, Serial, NFData) + } + deriving (Eq, Ord, Generic, Hashable, Serial, NFData) instance Serialize BlockHash where put = serialize @@ -125,55 +143,60 @@ instance IsString BlockHash where fromString s = let e = error "Could not read block hash from hex string" - in fromMaybe e $ hexToBlockHash $ cs s + in fromMaybe e $ hexToBlockHash $ cs s instance FromJSON BlockHash where - parseJSON = withText "BlockHash" $ - maybe mzero return . hexToBlockHash + parseJSON = + withText "BlockHash" $ + maybe mzero return . hexToBlockHash instance ToJSON BlockHash where toJSON = String . blockHashToHex toEncoding h = unsafeToEncoding $ - char7 '"' <> - hexBuilder (BL.reverse (runPutL (serialize h))) <> - char7 '"' + char7 '"' + <> hexBuilder (BL.reverse (runPutL (serialize h))) + <> char7 '"' --- | Block hashes are reversed with respect to the in-memory byte order in a --- block hash when displayed. +{- | Block hashes are reversed with respect to the in-memory byte order in a + block hash when displayed. +-} blockHashToHex :: BlockHash -> Text blockHashToHex (BlockHash h) = encodeHex (B.reverse (runPutS (serialize h))) --- | Convert a human-readable hex block hash into a 'BlockHash'. Bytes are --- reversed as normal. +{- | Convert a human-readable hex block hash into a 'BlockHash'. Bytes are + reversed as normal. +-} hexToBlockHash :: Text -> Maybe BlockHash hexToBlockHash hex = do bs <- B.reverse <$> decodeHex hex h <- eitherToMaybe (runGetS deserialize bs) return $ BlockHash h --- | Data type recording information of a 'Block'. The hash of a block is --- defined as the hash of this data structure, serialized. The block mining --- process involves finding a partial hash collision by varying the nonce in the --- 'BlockHeader' and/or additional entropy in the coinbase 'Transaction' of this --- 'Block'. Variations in the coinbase will result in different merkle roots in --- the 'BlockHeader'. +{- | Data type recording information of a 'Block'. The hash of a block is + defined as the hash of this data structure, serialized. The block mining + process involves finding a partial hash collision by varying the nonce in the + 'BlockHeader' and/or additional entropy in the coinbase 'Transaction' of this + 'Block'. Variations in the coinbase will result in different merkle roots in + the 'BlockHeader'. +-} data BlockHeader = BlockHeader - { blockVersion :: !Word32 -- 4 bytes - -- | hash of the previous block (parent) - , prevBlock :: !BlockHash -- 32 bytes - -- | root of the merkle tree of transactions - , merkleRoot :: !Hash256 -- 32 bytes - -- | unix timestamp - , blockTimestamp :: !Timestamp -- 4 bytes - -- | difficulty target - , blockBits :: !Word32 -- 4 bytes - -- | random nonce - , bhNonce :: !Word32 -- 4 bytes + { blockVersion :: !Word32 -- 4 bytes + , -- | hash of the previous block (parent) + prevBlock :: !BlockHash -- 32 bytes + , -- | root of the merkle tree of transactions + merkleRoot :: !Hash256 -- 32 bytes + , -- | unix timestamp + blockTimestamp :: !Timestamp -- 4 bytes + , -- | difficulty target + blockBits :: !Word32 -- 4 bytes + , -- | random nonce + bhNonce :: !Word32 -- 4 bytes } deriving (Eq, Ord, Show, Read, Generic, Hashable, NFData) - -- 80 bytes +-- 80 bytes + instance ToJSON BlockHeader where toJSON (BlockHeader v p m t b n) = object @@ -187,28 +210,24 @@ toEncoding (BlockHeader v p m t b n) = pairs ( "version" .= v - <> "prevblock" .= p - <> "merkleroot" .= encodeHex (runPutS (serialize m)) - <> "timestamp" .= t - <> "bits" .= b - <> "nonce" .= n + <> "prevblock" .= p + <> "merkleroot" .= encodeHex (runPutS (serialize m)) + <> "timestamp" .= t + <> "bits" .= b + <> "nonce" .= n ) instance FromJSON BlockHeader where parseJSON = withObject "BlockHeader" $ \o -> BlockHeader <$> o .: "version" - <*> o .: "prevblock" - <*> (f =<< o .: "merkleroot") - <*> o .: "timestamp" - <*> o .: "bits" - <*> o .: "nonce" + <*> o .: "prevblock" + <*> (f =<< o .: "merkleroot") + <*> o .: "timestamp" + <*> o .: "bits" + <*> o .: "nonce" where - f = maybe - mzero - return . - (eitherToMaybe . runGetS deserialize =<<) . - decodeHex + f = maybe mzero return . (eitherToMaybe . runGetS deserialize <=< decodeHex) instance Serial BlockHeader where deserialize = do @@ -247,35 +266,37 @@ headerHash :: BlockHeader -> BlockHash headerHash = BlockHash . doubleSHA256 . runPutS . serialize --- | A block locator is a set of block headers, denser towards the best block --- and sparser towards the genesis block. It starts at the highest block known. --- It is used by a node to synchronize against the network. When the locator is --- provided to a peer, it will send back block hashes starting from the first --- block in the locator that it recognizes. +{- | A block locator is a set of block headers, denser towards the best block + and sparser towards the genesis block. It starts at the highest block known. + It is used by a node to synchronize against the network. When the locator is + provided to a peer, it will send back block hashes starting from the first + block in the locator that it recognizes. +-} type BlockLocator = [BlockHash] --- | Data type representing a getblocks message request. It is used in the --- bitcoin protocol to retrieve blocks from a peer by providing it a --- 'BlockLocator' object. The response to a 'GetBlocks' message is an 'Inv' --- message containing a list of block hashes that the peer believes this node is --- missing. The number of block hashes in that inv message will end at the stop --- block hash, at at the tip of the chain, or after 500 entries, whichever comes --- earlier. +{- | Data type representing a getblocks message request. It is used in the + bitcoin protocol to retrieve blocks from a peer by providing it a + 'BlockLocator' object. The response to a 'GetBlocks' message is an 'Inv' + message containing a list of block hashes that the peer believes this node is + missing. The number of block hashes in that inv message will end at the stop + block hash, at at the tip of the chain, or after 500 entries, whichever comes + earlier. +-} data GetBlocks = GetBlocks - { getBlocksVersion :: !Word32 - -- | block locator object - , getBlocksLocator :: !BlockLocator - -- | hash of the last desired block - , getBlocksHashStop :: !BlockHash + { getBlocksVersion :: !Word32 + , -- | block locator object + getBlocksLocator :: !BlockLocator + , -- | hash of the last desired block + getBlocksHashStop :: !BlockHash } deriving (Eq, Show, Read, Generic, NFData) instance Serial GetBlocks where deserialize = GetBlocks - <$> getWord32le - <*> (repList =<< deserialize) - <*> deserialize + <$> getWord32le + <*> (repList =<< deserialize) + <*> deserialize where repList (VarInt c) = replicateM (fromIntegral c) deserialize serialize (GetBlocks v xs h) = putGetBlockMsg v xs h @@ -291,26 +312,27 @@ forM_ xs serialize serialize h --- | Similar to the 'GetBlocks' message type but for retrieving block headers --- only. The response to a 'GetHeaders' request is a 'Headers' message --- containing a list of block headers. A maximum of 2000 block headers can be --- returned. 'GetHeaders' is used by simplified payment verification (SPV) --- clients to exclude block contents when synchronizing the block chain. +{- | Similar to the 'GetBlocks' message type but for retrieving block headers + only. The response to a 'GetHeaders' request is a 'Headers' message + containing a list of block headers. A maximum of 2000 block headers can be + returned. 'GetHeaders' is used by simplified payment verification (SPV) + clients to exclude block contents when synchronizing the block chain. +-} data GetHeaders = GetHeaders - { getHeadersVersion :: !Word32 - -- | block locator object - , getHeadersBL :: !BlockLocator - -- | hash of the last desired block header - , getHeadersHashStop :: !BlockHash + { getHeadersVersion :: !Word32 + , -- | block locator object + getHeadersBL :: !BlockLocator + , -- | hash of the last desired block header + getHeadersHashStop :: !BlockHash } deriving (Eq, Show, Read, Generic, NFData) instance Serial GetHeaders where deserialize = GetHeaders - <$> getWord32le - <*> (repList =<< deserialize) - <*> deserialize + <$> getWord32le + <*> (repList =<< deserialize) + <*> deserialize where repList (VarInt c) = replicateM (fromIntegral c) deserialize serialize (GetHeaders v xs h) = putGetBlockMsg v xs h @@ -326,12 +348,14 @@ -- | 'BlockHeader' type with a transaction count as 'VarInt' type BlockHeaderCount = (BlockHeader, VarInt) --- | The 'Headers' type is used to return a list of block headers in --- response to a 'GetHeaders' message. +{- | The 'Headers' type is used to return a list of block headers in + response to a 'GetHeaders' message. +-} newtype Headers = Headers { -- | list of block headers with transaction count headersList :: [BlockHeaderCount] - } deriving (Eq, Show, Read, Generic, NFData) + } + deriving (Eq, Show, Read, Generic, NFData) instance Serial Headers where deserialize = Headers <$> (repList =<< deserialize) @@ -350,18 +374,22 @@ put = serialize get = deserialize --- | Decode the compact number used in the difficulty target of a block. --- --- The compact format is a representation of a whole number \(N\) using an --- unsigned 32-bit number similar to a floating point format. The most --- significant 8 bits are the unsigned exponent of base 256. This exponent can --- be thought of as the number of bytes of \(N\). The lower 23 bits are the --- mantissa. Bit number 24 represents the sign of \(N\). --- --- \[ --- N = -1^{sign} \times mantissa \times 256^{exponent-3} --- \] -decodeCompact :: Word32 -> (Integer, Bool) -- ^ true means overflow +{- | Decode the compact number used in the difficulty target of a block. + + The compact format is a representation of a whole number \(N\) using an + unsigned 32-bit number similar to a floating point format. The most + significant 8 bits are the unsigned exponent of base 256. This exponent can + be thought of as the number of bytes of \(N\). The lower 23 bits are the + mantissa. Bit number 24 represents the sign of \(N\). + + \[ + N = -1^{sign} \times mantissa \times 256^{exponent-3} + \] +-} +decodeCompact :: + Word32 -> + -- | true means overflow + (Integer, Bool) decodeCompact nCompact = (if neg then res * (-1) else res, over) where nSize :: Int @@ -369,27 +397,34 @@ nWord' :: Word32 nWord' = nCompact .&. 0x007fffff nWord :: Word32 - nWord | nSize <= 3 = nWord' `shiftR` (8 * (3 - nSize)) - | otherwise = nWord' + nWord + | nSize <= 3 = nWord' `shiftR` (8 * (3 - nSize)) + | otherwise = nWord' res :: Integer - res | nSize <= 3 = fromIntegral nWord + res + | nSize <= 3 = fromIntegral nWord | otherwise = fromIntegral nWord `shiftL` (8 * (nSize - 3)) neg = nWord /= 0 && (nCompact .&. 0x00800000) /= 0 - over = nWord /= 0 && (nSize > 34 || - nWord > 0xff && nSize > 33 || - nWord > 0xffff && nSize > 32) + over = + nWord /= 0 + && ( nSize > 34 + || nWord > 0xff && nSize > 33 + || nWord > 0xffff && nSize > 32 + ) --- | Encode an 'Integer' to the compact number format used in the difficulty --- target of a block. +{- | Encode an 'Integer' to the compact number format used in the difficulty + target of a block. +-} encodeCompact :: Integer -> Word32 encodeCompact i = nCompact where i' = abs i neg = i < 0 nSize' :: Int - nSize' = let f 0 = 0 - f n = 1 + f (n `shiftR` 8) - in f i' + nSize' = + let f 0 = 0 + f n = 1 + f (n `shiftR` 8) + in f i' nCompact''' :: Word32 nCompact''' | nSize' <= 3 = fromIntegral $ (low64 .&. i') `shiftL` (8 * (3 - nSize')) @@ -402,7 +437,8 @@ nCompact' :: Word32 nCompact' = nCompact'' .|. (fromIntegral nSize `shiftL` 24) nCompact :: Word32 - nCompact | neg && (nCompact' .&. 0x007fffff /= 0) = nCompact' .|. 0x00800000 - | otherwise = nCompact' + nCompact + | neg && (nCompact' .&. 0x007fffff /= 0) = nCompact' .|. 0x00800000 + | otherwise = nCompact' low64 :: Integer low64 = 0xffffffffffffffff diff --git a/src/Haskoin/Block/Headers.hs b/src/Haskoin/Block/Headers.hs --- a/src/Haskoin/Block/Headers.hs +++ b/src/Haskoin/Block/Headers.hs @@ -1,10 +1,11 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE RecordWildCards #-} -{-| +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RecordWildCards #-} + +{- | Module : Haskoin.Block.Headers Copyright : No rights reserved License : MIT @@ -14,128 +15,144 @@ Block chain header synchronization and proof-of-work consensus functions. -} -module Haskoin.Block.Headers - ( -- * Block Headers - BlockNode(..) - , BlockHeaders(..) - , BlockWork - , genesisNode - , genesisBlock - , isGenesis - , chooseBest - -- ** Header Store - , parentBlock - , getParents - , getAncestor - , splitPoint - , connectBlocks - , connectBlock - , blockLocator - -- ** Header Memory Store - , HeaderMemory(..) - , ShortBlockHash - , BlockMap - , shortBlockHash - , initialChain - , genesisMap - -- ** Helper Functions - , appendBlocks - , validBlock - , validCP - , afterLastCP - , bip34 - , validVersion - , lastNoMinDiff - , nextWorkRequired - , nextEdaWorkRequired - , nextDaaWorkRequired - , nextAsertWorkRequired - , computeAsertBits - , computeTarget - , getSuitableBlock - , nextPowWorkRequired - , calcNextWork - , isValidPOW - , blockPOW - , headerWork - , diffInterval - , blockLocatorNodes - , mineBlock - , computeSubsidy - , mtp - , firstGreaterOrEqual - , lastSmallerOrEqual - , ) where +module Haskoin.Block.Headers ( + -- * Block Headers + BlockNode (..), + BlockHeaders (..), + BlockWork, + genesisNode, + genesisBlock, + isGenesis, + chooseBest, -import Control.Applicative ((<|>)) -import Control.DeepSeq -import Control.Monad (guard, mzero, unless, when) -import Control.Monad.Except (ExceptT (..), runExceptT, - throwError) -import Control.Monad.State.Strict as State (StateT, get, gets, lift, - modify) -import Control.Monad.Trans.Maybe -import Data.Binary (Binary (..)) -import Data.Bits (shiftL, shiftR, (.&.)) -import qualified Data.ByteString as B -import Data.ByteString.Short (ShortByteString, fromShort, - toShort) -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import Data.Function (on) -import Data.HashMap.Strict (HashMap) -import qualified Data.HashMap.Strict as HashMap -import Data.Hashable -import Data.List (sort, sortBy) -import Data.Maybe (fromMaybe, listToMaybe) -import Data.Serialize (Serialize (..)) -import Data.Typeable (Typeable) -import Data.Word (Word32, Word64) -import GHC.Generics (Generic) -import Haskoin.Block.Common -import Haskoin.Constants -import Haskoin.Crypto -import Haskoin.Transaction.Genesis -import Haskoin.Util + -- ** Header Store + parentBlock, + getParents, + getAncestor, + splitPoint, + connectBlocks, + connectBlock, + blockLocator, --- | Short version of the block hash. Uses the good end of the hash (the part --- that doesn't have a long string of zeroes). + -- ** Header Memory Store + HeaderMemory (..), + ShortBlockHash, + BlockMap, + shortBlockHash, + initialChain, + genesisMap, + + -- ** Helper Functions + appendBlocks, + validBlock, + validCP, + afterLastCP, + bip34, + validVersion, + lastNoMinDiff, + nextWorkRequired, + nextEdaWorkRequired, + nextDaaWorkRequired, + nextAsertWorkRequired, + computeAsertBits, + computeTarget, + getSuitableBlock, + nextPowWorkRequired, + calcNextWork, + isValidPOW, + blockPOW, + headerWork, + diffInterval, + blockLocatorNodes, + mineBlock, + computeSubsidy, + mtp, + firstGreaterOrEqual, + lastSmallerOrEqual, +) where + +import Control.Applicative ((<|>)) +import Control.DeepSeq +import Control.Monad (guard, mzero, unless, when) +import Control.Monad.Except ( + ExceptT (..), + runExceptT, + throwError, + ) +import Control.Monad.State.Strict as State ( + StateT, + get, + gets, + lift, + modify, + ) +import Control.Monad.Trans.Maybe +import Data.Binary (Binary (..)) +import Data.Bits (shiftL, shiftR, (.&.)) +import qualified Data.ByteString as B +import Data.ByteString.Short ( + ShortByteString, + fromShort, + toShort, + ) +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.Function (on) +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as HashMap +import Data.Hashable +import Data.List (sort, sortBy) +import Data.Maybe (fromMaybe, listToMaybe) +import Data.Serialize (Serialize (..)) +import Data.Typeable (Typeable) +import Data.Word (Word32, Word64) +import GHC.Generics (Generic) +import Haskoin.Block.Common +import Haskoin.Crypto +import Haskoin.Data +import Haskoin.Transaction.Genesis +import Haskoin.Util + +{- | Short version of the block hash. Uses the good end of the hash (the part + that doesn't have a long string of zeroes). +-} type ShortBlockHash = Word64 --- | Memory-based map to a serialized 'BlockNode' data structure. --- 'ShortByteString' is used to avoid memory fragmentation and make the data --- structure compact. +{- | Memory-based map to a serialized 'BlockNode' data structure. + 'ShortByteString' is used to avoid memory fragmentation and make the data + structure compact. +-} type BlockMap = HashMap ShortBlockHash ShortByteString -- | Represents accumulated work in the block chain so far. type BlockWork = Integer --- | Data structure representing a block header and its position in the --- block chain. -data BlockNode - = BlockNode - { nodeHeader :: !BlockHeader - , nodeHeight :: !BlockHeight - -- | accumulated work so far - , nodeWork :: !BlockWork - -- | skip magic block hash - , nodeSkip :: !BlockHash - } +{- | Data structure representing a block header and its position in the + block chain. +-} +data BlockNode = BlockNode + { nodeHeader :: !BlockHeader + , nodeHeight :: !BlockHeight + , -- | accumulated work so far + nodeWork :: !BlockWork + , -- | skip magic block hash + nodeSkip :: !BlockHash + } deriving (Show, Read, Generic, Hashable, NFData) instance Serial BlockNode where deserialize = do nodeHeader <- deserialize nodeHeight <- getWord32le - nodeWork <- getInteger + nodeWork <- getInteger if nodeHeight == 0 then do let nodeSkip = headerHash nodeHeader - return BlockNode {..} + return BlockNode{..} else do nodeSkip <- deserialize - return BlockNode {..} + return BlockNode{..} serialize bn = do serialize $ nodeHeader bn putWord32le $ nodeHeight bn @@ -160,20 +177,25 @@ -- | Memory-based header tree. data HeaderMemory = HeaderMemory - { memoryHeaderMap :: !BlockMap + { memoryHeaderMap :: !BlockMap , memoryBestHeader :: !BlockNode - } deriving (Eq, Typeable, Show, Read, Generic, Hashable, NFData) + } + deriving (Eq, Typeable, Show, Read, Generic, Hashable, NFData) -- | Typeclass for block header chain storage monad. class Monad m => BlockHeaders m where -- | Add a new 'BlockNode' to the chain. Does not validate. addBlockHeader :: BlockNode -> m () + -- | Get a 'BlockNode' associated with a 'BlockHash'. getBlockHeader :: BlockHash -> m (Maybe BlockNode) + -- | Locate the 'BlockNode' for the highest block in the chain getBestBlockHeader :: m BlockNode + -- | Set the highest block in the chain. setBestBlockHeader :: BlockNode -> m () + -- | Add a continuous bunch of block headers the chain. Does not validate. addBlockHeaders :: [BlockNode] -> m () addBlockHeaders = mapM_ addBlockHeader @@ -182,14 +204,15 @@ addBlockHeader = modify . addBlockHeaderMemory getBlockHeader bh = getBlockHeaderMemory bh <$> State.get getBestBlockHeader = gets memoryBestHeader - setBestBlockHeader bn = modify $ \s -> s { memoryBestHeader = bn } + setBestBlockHeader bn = modify $ \s -> s{memoryBestHeader = bn} -- | Initialize memory-based chain. initialChain :: Network -> HeaderMemory -initialChain net = HeaderMemory - { memoryHeaderMap = genesisMap net - , memoryBestHeader = genesisNode net - } +initialChain net = + HeaderMemory + { memoryHeaderMap = genesisMap net + , memoryBestHeader = genesisNode net + } -- | Initialize map for memory-based chain. genesisMap :: Network -> BlockMap @@ -202,17 +225,18 @@ addBlockHeaderMemory :: BlockNode -> HeaderMemory -> HeaderMemory addBlockHeaderMemory bn s@HeaderMemory{..} = let bm' = addBlockToMap bn memoryHeaderMap - in s { memoryHeaderMap = bm' } + in s{memoryHeaderMap = bm'} -- | Get block header from memory block map. getBlockHeaderMemory :: BlockHash -> HeaderMemory -> Maybe BlockNode -getBlockHeaderMemory bh HeaderMemory {..} = do +getBlockHeaderMemory bh HeaderMemory{..} = do bs <- shortBlockHash bh `HashMap.lookup` memoryHeaderMap eitherToMaybe . runGetS deserialize $ fromShort bs --- | Calculate short block hash taking eight non-zero bytes from the 16-byte --- hash. This function will take the bytes that are not on the zero-side of the --- hash, making colissions between short block hashes difficult. +{- | Calculate short block hash taking eight non-zero bytes from the 16-byte + hash. This function will take the bytes that are not on the zero-side of the + hash, making colissions between short block hashes difficult. +-} shortBlockHash :: BlockHash -> ShortBlockHash shortBlockHash = either error id . runGetS deserialize . B.take 8 . runPutS . serialize @@ -221,15 +245,17 @@ addBlockToMap :: BlockNode -> BlockMap -> BlockMap addBlockToMap node = HashMap.insert - (shortBlockHash $ headerHash $ nodeHeader node) - (toShort $ runPutS $ serialize node) + (shortBlockHash $ headerHash $ nodeHeader node) + (toShort $ runPutS $ serialize node) --- | Get the ancestor of the provided 'BlockNode' at the specified --- 'BlockHeight'. -getAncestor :: BlockHeaders m - => BlockHeight - -> BlockNode - -> m (Maybe BlockNode) +{- | Get the ancestor of the provided 'BlockNode' at the specified + 'BlockHeight'. +-} +getAncestor :: + BlockHeaders m => + BlockHeight -> + BlockNode -> + m (Maybe BlockNode) getAncestor height node | height > nodeHeight node = return Nothing | otherwise = go node @@ -240,26 +266,29 @@ | nodeHeight walk > height = let heightSkip = skipHeight (nodeHeight walk) heightSkipPrev = skipHeight (nodeHeight walk - 1) - in if not (isGenesis walk) && - (heightSkip == height || - (heightSkip > height && - not - (heightSkipPrev < heightSkip - 2 && - heightSkipPrev >= height))) + in if not (isGenesis walk) + && ( heightSkip == height + || ( heightSkip > height + && not + ( heightSkipPrev < heightSkip - 2 + && heightSkipPrev >= height + ) + ) + ) then do walk' <- fromMaybe e1 <$> getBlockHeader (nodeSkip walk) go walk' else do walk' <- - fromMaybe e2 <$> - getBlockHeader (prevBlock (nodeHeader walk)) + fromMaybe e2 + <$> getBlockHeader (prevBlock (nodeHeader walk)) go walk' | otherwise = return $ Just walk -- | Is the provided 'BlockNode' the Genesis block? isGenesis :: BlockNode -> Bool -isGenesis BlockNode {nodeHeight = 0} = True -isGenesis _ = False +isGenesis BlockNode{nodeHeight = 0} = True +isGenesis _ = False -- | Build the genesis 'BlockNode' for the supplied 'Network'. genesisNode :: Network -> BlockNode @@ -271,15 +300,18 @@ , nodeSkip = headerHash (getGenesisHeader net) } --- | Validate a list of continuous block headers and import them to the --- block chain. Return 'Left' on failure with error information. -connectBlocks :: BlockHeaders m - => Network - -> Timestamp -- ^ current time - -> [BlockHeader] - -> m (Either String [BlockNode]) +{- | Validate a list of continuous block headers and import them to the + block chain. Return 'Left' on failure with error information. +-} +connectBlocks :: + BlockHeaders m => + Network -> + -- | current time + Timestamp -> + [BlockHeader] -> + m (Either String [BlockNode]) connectBlocks _ _ [] = return $ Right [] -connectBlocks net t bhs@(bh:_) = +connectBlocks net t bhs@(bh : _) = runExceptT $ do unless (chained bhs) $ throwError "Blocks to connect do not form a chain" @@ -290,15 +322,15 @@ pars <- lift $ getParents 10 par bb <- lift getBestBlockHeader go par [] bb par pars bhs >>= \case - bns@(bn:_) -> do + bns@(bn : _) -> do lift $ addBlockHeaders bns let bb' = chooseBest bn bb when (bb' /= bb) $ lift $ setBestBlockHeader bb' return bns _ -> undefined where - chained (h1:h2:hs) = headerHash h1 == prevBlock h2 && chained (h2 : hs) - chained _ = True + chained (h1 : h2 : hs) = headerHash h1 == prevBlock h2 && chained (h2 : hs) + chained _ = True skipit lbh ls par | sh == nodeHeight lbh = return lbh | sh < nodeHeight lbh = do @@ -307,8 +339,8 @@ Just sk -> return sk Nothing -> throwError $ - "BUG: Could not get skip for block " ++ - show (headerHash $ nodeHeader par) + "BUG: Could not get skip for block " + ++ show (headerHash $ nodeHeader par) | otherwise = do let sn = ls !! fromIntegral (nodeHeight par - sh) when (nodeHeight sn /= sh) $ @@ -317,26 +349,30 @@ where sh = skipHeight (nodeHeight par + 1) go _ acc _ _ _ [] = return acc - go lbh acc bb par pars (h:hs) = do + go lbh acc bb par pars (h : hs) = do sk <- skipit lbh acc par bn <- ExceptT . return $ validBlock net t bb par pars h sk go lbh (bn : acc) (chooseBest bn bb) bn (take 10 $ par : pars) hs --- | Block's parent. If the block header is in the store, its parent must also --- be there. No block header get deleted or pruned from the store. -parentBlock :: BlockHeaders m - => BlockHeader - -> m (Maybe BlockNode) +{- | Block's parent. If the block header is in the store, its parent must also + be there. No block header get deleted or pruned from the store. +-} +parentBlock :: + BlockHeaders m => + BlockHeader -> + m (Maybe BlockNode) parentBlock bh = getBlockHeader (prevBlock bh) --- | Validate and connect single block header to the block chain. Return 'Left' --- if fails to be validated. +{- | Validate and connect single block header to the block chain. Return 'Left' + if fails to be validated. +-} connectBlock :: - BlockHeaders m - => Network - -> Timestamp -- ^ current time - -> BlockHeader - -> m (Either String BlockNode) + BlockHeaders m => + Network -> + -- | current time + Timestamp -> + BlockHeader -> + m (Either String BlockNode) connectBlock net t bh = runExceptT $ do par <- @@ -350,8 +386,8 @@ Just sk -> return sk Nothing -> throwError $ - "BUG: Could not get skip for block " ++ - show (headerHash $ nodeHeader par) + "BUG: Could not get skip for block " + ++ show (headerHash $ nodeHeader par) bb <- lift getBestBlockHeader bn <- ExceptT . return $ validBlock net t bb par pars bh sk let bb' = chooseBest bb bn @@ -360,14 +396,21 @@ return bn -- | Validate this block header. Build a 'BlockNode' if successful. -validBlock :: Network - -> Timestamp -- ^ current time - -> BlockNode -- ^ best block - -> BlockNode -- ^ immediate parent - -> [BlockNode] -- ^ 10 parents above - -> BlockHeader -- ^ header to validate - -> BlockNode -- ^ skip node (black magic) - -> Either String BlockNode +validBlock :: + Network -> + -- | current time + Timestamp -> + -- | best block + BlockNode -> + -- | immediate parent + BlockNode -> + -- | 10 parents above + [BlockNode] -> + -- | header to validate + BlockHeader -> + -- | skip node (black magic) + BlockNode -> + Either String BlockNode validBlock net t bb par pars bh sk = do let mt = medianTime . map (blockTimestamp . nodeHeader) $ par : pars nt = blockTimestamp bh @@ -389,22 +432,26 @@ Left $ "Rejected BIP-34 block: " ++ show hh unless (validVersion net ng nv) $ Left $ "Invalid block version: " ++ show nv - return BlockNode { nodeHeader = bh - , nodeHeight = ng - , nodeWork = aw - , nodeSkip = headerHash $ nodeHeader sk - } + return + BlockNode + { nodeHeader = bh + , nodeHeight = ng + , nodeWork = aw + , nodeSkip = headerHash $ nodeHeader sk + } --- | Return the median of all provided timestamps. Can be unsorted. Error on --- empty list. +{- | Return the median of all provided timestamps. Can be unsorted. Error on + empty list. +-} medianTime :: [Timestamp] -> Timestamp medianTime ts | null ts = error "Cannot compute median time of empty header list" | otherwise = sort ts !! (length ts `div` 2) --- | Calculate the height of the skip (magic) block that corresponds to the --- given height. The block hash of the ancestor at that height will be placed on --- the 'BlockNode' structure to help locate ancestors at any height quickly. +{- | Calculate the height of the skip (magic) block that corresponds to the + given height. The block hash of the ancestor at that height will be placed on + the 'BlockNode' structure to help locate ancestors at any height quickly. +-} skipHeight :: BlockHeight -> BlockHeight skipHeight height | height < 2 = 0 @@ -416,98 +463,117 @@ invertLowestOne height = height .&. (height - 1) -- | Get a number of parents for the provided block. -getParents :: BlockHeaders m - => Int - -> BlockNode - -> m [BlockNode] -- ^ starts from immediate parent +getParents :: + BlockHeaders m => + Int -> + BlockNode -> + -- | starts from immediate parent + m [BlockNode] getParents = getpars [] where getpars acc 0 _ = return $ reverse acc getpars acc n BlockNode{..} - | nodeHeight == 0 = return $ reverse acc - | otherwise = do - parM <- getBlockHeader $ prevBlock nodeHeader - case parM of - Just bn -> getpars (bn : acc) (n - 1) bn - Nothing -> error "BUG: All non-genesis blocks should have a parent" + | nodeHeight == 0 = return $ reverse acc + | otherwise = do + parM <- getBlockHeader $ prevBlock nodeHeader + case parM of + Just bn -> getpars (bn : acc) (n - 1) bn + Nothing -> error "BUG: All non-genesis blocks should have a parent" -- | Verify that checkpoint location is valid. -validCP :: Network - -> BlockHeight -- ^ new child height - -> BlockHash -- ^ new child hash - -> Bool +validCP :: + Network -> + -- | new child height + BlockHeight -> + -- | new child hash + BlockHash -> + Bool validCP net height newChildHash = case lookup height (getCheckpoints net) of Just cpHash -> cpHash == newChildHash - Nothing -> True + Nothing -> True --- | New block height above the last checkpoint imported. Used to prevent a --- reorg below the highest checkpoint that was already imported. -afterLastCP :: Network - -> BlockHeight -- ^ best height - -> BlockHeight -- ^ new imported block height - -> Bool +{- | New block height above the last checkpoint imported. Used to prevent a + reorg below the highest checkpoint that was already imported. +-} +afterLastCP :: + Network -> + -- | best height + BlockHeight -> + -- | new imported block height + BlockHeight -> + Bool afterLastCP net bestHeight newChildHeight = case lM of - Just l -> l < newChildHeight + Just l -> l < newChildHeight Nothing -> True where lM = listToMaybe . reverse $ - [c | (c, _) <- getCheckpoints net, c <= bestHeight] + [c | (c, _) <- getCheckpoints net, c <= bestHeight] --- | This block should be at least version 2 (BIP34). Block height must be --- included in the coinbase transaction to prevent non-unique transaction --- hashes. -bip34 :: Network - -> BlockHeight -- ^ new child height - -> BlockHash -- ^ new child hash - -> Bool +{- | This block should be at least version 2 (BIP34). Block height must be + included in the coinbase transaction to prevent non-unique transaction + hashes. +-} +bip34 :: + Network -> + -- | new child height + BlockHeight -> + -- | new child hash + BlockHash -> + Bool bip34 net height hsh | fst (getBip34Block net) == 0 = True | fst (getBip34Block net) == height = snd (getBip34Block net) == hsh | otherwise = True -- | Check if the provided block height and version are valid. -validVersion :: Network - -> BlockHeight -- ^ new child height - -> Word32 -- ^ new child version - -> Bool +validVersion :: + Network -> + -- | new child height + BlockHeight -> + -- | new child version + Word32 -> + Bool validVersion net height version | version < 2 = height < fst (getBip34Block net) | version < 3 = height < getBip66Height net | version < 4 = height < getBip65Height net | otherwise = True --- | Find last block with normal, as opposed to minimum difficulty (for test --- networks). +{- | Find last block with normal, as opposed to minimum difficulty (for test + networks). +-} lastNoMinDiff :: BlockHeaders m => Network -> BlockNode -> m BlockNode -lastNoMinDiff _ bn@BlockNode {nodeHeight = 0} = return bn -lastNoMinDiff net bn@BlockNode {..} = do +lastNoMinDiff _ bn@BlockNode{nodeHeight = 0} = return bn +lastNoMinDiff net bn@BlockNode{..} = do let i = nodeHeight `mod` diffInterval net /= 0 c = encodeCompact (getPowLimit net) l = blockBits nodeHeader == c e1 = error $ - "Could not get block header for parent of " ++ - show (headerHash nodeHeader) + "Could not get block header for parent of " + ++ show (headerHash nodeHeader) if i && l then do bn' <- fromMaybe e1 <$> getBlockHeader (prevBlock nodeHeader) lastNoMinDiff net bn' else return bn --- | Returns the work required on a block header given the previous block. This --- coresponds to @bitcoind@ function @GetNextWorkRequired@ in @main.cpp@. -nextWorkRequired :: BlockHeaders m - => Network - -> BlockNode - -> BlockHeader - -> m Word32 +{- | Returns the work required on a block header given the previous block. This + coresponds to @bitcoind@ function @GetNextWorkRequired@ in @main.cpp@. +-} +nextWorkRequired :: + BlockHeaders m => + Network -> + BlockNode -> + BlockHeader -> + m Word32 nextWorkRequired net par bh = do ma <- getAsertAnchor net case asert ma <|> daa <|> eda <|> pow of - Just f -> f par bh + Just f -> f par bh Nothing -> error "Could not determine difficulty algorithm" where asert ma = do @@ -524,10 +590,11 @@ return $ nextEdaWorkRequired net pow = return $ nextPowWorkRequired net --- | Find out the next amount of work required according to the Emergency --- Difficulty Adjustment (EDA) algorithm from Bitcoin Cash. +{- | Find out the next amount of work required according to the Emergency + Difficulty Adjustment (EDA) algorithm from Bitcoin Cash. +-} nextEdaWorkRequired :: - BlockHeaders m => Network -> BlockNode -> BlockHeader -> m Word32 + BlockHeaders m => Network -> BlockNode -> BlockHeader -> m Word32 nextEdaWorkRequired net par bh | nodeHeight par + 1 `mod` diffInterval net == 0 = nextWorkRequired net par bh @@ -544,22 +611,24 @@ mtp6 = parmed - par6med if mtp6 < 12 * 3600 then return $ blockBits (nodeHeader par) - else return $ - let (diff, _) = decodeCompact (blockBits (nodeHeader par)) - ndiff = diff + (diff `shiftR` 2) - in if getPowLimit net > ndiff - then encodeCompact (getPowLimit net) - else encodeCompact ndiff + else + return $ + let (diff, _) = decodeCompact (blockBits (nodeHeader par)) + ndiff = diff + (diff `shiftR` 2) + in if getPowLimit net > ndiff + then encodeCompact (getPowLimit net) + else encodeCompact ndiff where minDifficulty = - blockTimestamp bh > - blockTimestamp (nodeHeader par) + getTargetSpacing net * 2 + blockTimestamp bh + > blockTimestamp (nodeHeader par) + getTargetSpacing net * 2 e1 = error "Could not get seventh ancestor of block" --- | Find the next amount of work required according to the Difficulty --- Adjustment Algorithm (DAA) from Bitcoin Cash. +{- | Find the next amount of work required according to the Difficulty + Adjustment Algorithm (DAA) from Bitcoin Cash. +-} nextDaaWorkRequired :: - BlockHeaders m => Network -> BlockNode -> BlockHeader -> m Word32 + BlockHeaders m => Network -> BlockNode -> BlockHeader -> m Word32 nextDaaWorkRequired net par bh | minDifficulty = return (encodeCompact (getPowLimit net)) | otherwise = do @@ -576,8 +645,8 @@ height = nodeHeight par e1 = error "Cannot get ancestor at parent - 144 height" minDifficulty = - blockTimestamp bh > - blockTimestamp (nodeHeader par) + getTargetSpacing net * 2 + blockTimestamp bh + > blockTimestamp (nodeHeader par) + getTargetSpacing net * 2 mtp :: BlockHeaders m => BlockNode -> m Timestamp mtp bn @@ -586,23 +655,26 @@ pars <- getParents 11 bn return $ medianTime (map (blockTimestamp . nodeHeader) pars) -firstGreaterOrEqual :: BlockHeaders m - => Network - -> (BlockNode -> m Ordering) - -> m (Maybe BlockNode) +firstGreaterOrEqual :: + BlockHeaders m => + Network -> + (BlockNode -> m Ordering) -> + m (Maybe BlockNode) firstGreaterOrEqual = binSearch False -lastSmallerOrEqual :: BlockHeaders m - => Network - -> (BlockNode -> m Ordering) - -> m (Maybe BlockNode) +lastSmallerOrEqual :: + BlockHeaders m => + Network -> + (BlockNode -> m Ordering) -> + m (Maybe BlockNode) lastSmallerOrEqual = binSearch True -binSearch :: BlockHeaders m - => Bool - -> Network - -> (BlockNode -> m Ordering) - -> m (Maybe BlockNode) +binSearch :: + BlockHeaders m => + Bool -> + Network -> + (BlockNode -> m Ordering) -> + m (Maybe BlockNode) binSearch top net f = runMaybeT $ do (a, b) <- lift $ extremes net go a b @@ -645,7 +717,7 @@ middleBlock a b = getAncestor h b >>= \case Nothing -> error "You fell into a pit full of mud and snakes" - Just x -> return x + Just x -> return x where h = middleOf (nodeHeight a) (nodeHeight b) @@ -656,7 +728,7 @@ getAsertAnchor :: BlockHeaders m => Network -> m (Maybe BlockNode) getAsertAnchor net = case getAsertActivationTime net of - Nothing -> return Nothing + Nothing -> return Nothing Just act -> firstGreaterOrEqual net (f act) where f act bn = do @@ -664,15 +736,17 @@ return $ compare m act -- | Find the next amount of work required according to the aserti3-2d algorithm. -nextAsertWorkRequired :: BlockHeaders m - => Network - -> BlockNode - -> BlockNode - -> BlockHeader - -> m Word32 +nextAsertWorkRequired :: + BlockHeaders m => + Network -> + BlockNode -> + BlockNode -> + BlockHeader -> + m Word32 nextAsertWorkRequired net anchor par bh = do - anchor_parent <- fromMaybe e_fork <$> - getBlockHeader (prevBlock (nodeHeader anchor)) + anchor_parent <- + fromMaybe e_fork + <$> getBlockHeader (prevBlock (nodeHeader anchor)) let anchor_parent_time = toInteger $ blockTimestamp $ nodeHeader anchor_parent time_diff = current_time - anchor_parent_time return $ computeAsertBits halflife anchor_bits time_diff height_diff @@ -700,37 +774,42 @@ maxTarget :: Integer maxTarget = fst $ decodeCompact maxBits -computeAsertBits - :: Integer - -> Word32 - -> Integer - -> Integer - -> Word32 +computeAsertBits :: + Integer -> + Word32 -> + Integer -> + Integer -> + Word32 computeAsertBits halflife anchor_bits time_diff height_diff = if e2 >= 0 && e2 < 65536 - then if g4 == 0 - then encodeCompact 1 - else if g4 > maxTarget - then maxBits - else encodeCompact g4 - else error $ "Exponent not in range: " ++ show e2 + then + if g4 == 0 + then encodeCompact 1 + else + if g4 > maxTarget + then maxBits + else encodeCompact g4 + else error $ "Exponent not in range: " ++ show e2 where g1 = fst (decodeCompact anchor_bits) - e1 = ((time_diff - idealBlockTime * (height_diff + 1)) * radix) - `quot` - halflife + e1 = + ((time_diff - idealBlockTime * (height_diff + 1)) * radix) + `quot` halflife s = e1 `shiftR` rBits e2 = e1 - s * radix - g2 = g1 * (radix + - ((195766423245049*e2 + 971821376*e2^2 + 5127*e2^3 + 2^47) - `shiftR` - (rBits*3))) - g3 = if s < 0 - then g2 `shiftR` negate (fromIntegral s) - else g2 `shiftL` fromIntegral s + g2 = + g1 + * ( radix + + ( (195766423245049 * e2 + 971821376 * e2 ^ 2 + 5127 * e2 ^ 3 + 2 ^ 47) + `shiftR` (rBits * 3) + ) + ) + g3 = + if s < 0 + then g2 `shiftR` negate (fromIntegral s) + else g2 `shiftL` fromIntegral s g4 = g3 `shiftR` rBits - -- | Compute Bitcoin Cash DAA target for a new block. computeTarget :: Network -> BlockNode -> BlockNode -> Integer computeTarget net f l = @@ -753,18 +832,20 @@ blocks <- (par :) <$> getParents 2 par return $ sortBy (compare `on` blockTimestamp . nodeHeader) blocks !! 1 --- | Returns the work required on a block header given the previous block. This --- coresponds to bitcoind function GetNextWorkRequired in main.cpp. +{- | Returns the work required on a block header given the previous block. This + coresponds to bitcoind function GetNextWorkRequired in main.cpp. +-} nextPowWorkRequired :: - BlockHeaders m => Network -> BlockNode -> BlockHeader -> m Word32 + BlockHeaders m => Network -> BlockNode -> BlockHeader -> m Word32 nextPowWorkRequired net par bh | nodeHeight par + 1 `mod` diffInterval net /= 0 = if getAllowMinDifficultyBlocks net - then if ht > pt + delta - then return $ encodeCompact (getPowLimit net) - else do - d <- lastNoMinDiff net par - return $ blockBits $ nodeHeader d + then + if ht > pt + delta + then return $ encodeCompact (getPowLimit net) + else do + d <- lastNoMinDiff net par + return $ blockBits $ nodeHeader d else return $ blockBits $ nodeHeader par | otherwise = do let rh = nodeHeight par - (diffInterval net - 1) @@ -778,26 +859,31 @@ delta = getTargetSpacing net * 2 -- | Computes the work required for the first block in a new retarget period. -calcNextWork :: Network - -> BlockHeader -- ^ last block in previous retarget (parent) - -> Timestamp -- ^ timestamp of first block in previous retarget - -> Word32 +calcNextWork :: + Network -> + -- | last block in previous retarget (parent) + BlockHeader -> + -- | timestamp of first block in previous retarget + Timestamp -> + Word32 calcNextWork net header time | getPowNoRetargetting net = blockBits header | new > getPowLimit net = encodeCompact (getPowLimit net) | otherwise = encodeCompact new where s = blockTimestamp header - time - n | s < getTargetTimespan net `div` 4 = getTargetTimespan net `div` 4 - | s > getTargetTimespan net * 4 = getTargetTimespan net * 4 - | otherwise = s + n + | s < getTargetTimespan net `div` 4 = getTargetTimespan net `div` 4 + | s > getTargetTimespan net * 4 = getTargetTimespan net * 4 + | otherwise = s l = fst $ decodeCompact $ blockBits header new = l * fromIntegral n `div` fromIntegral (getTargetTimespan net) --- | Returns True if the difficulty target (bits) of the header is valid and the --- proof of work of the header matches the advertised difficulty target. This --- function corresponds to the function @CheckProofOfWork@ from @bitcoind@ in --- @main.cpp@. +{- | Returns True if the difficulty target (bits) of the header is valid and the + proof of work of the header matches the advertised difficulty target. This + function corresponds to the function @CheckProofOfWork@ from @bitcoind@ in + @main.cpp@. +-} isValidPOW :: Network -> BlockHeader -> Bool isValidPOW net h | target <= 0 || over || target > getPowLimit net = False @@ -807,15 +893,16 @@ -- | Returns the proof of work of a block header hash as an 'Integer' number. blockPOW :: BlockHash -> Integer -blockPOW = bsToInteger . B.reverse . runPutS . serialize +blockPOW = bsToInteger . B.reverse . runPutS . serialize --- | Returns the work represented by this block. Work is defined as the number --- of tries needed to solve a block in the average case with respect to the --- target. +{- | Returns the work represented by this block. Work is defined as the number + of tries needed to solve a block in the average case with respect to the + target. +-} headerWork :: BlockHeader -> Integer headerWork bh = largestHash `div` (target + 1) where - target = fst $ decodeCompact $ blockBits bh + target = fst $ decodeCompact $ blockBits bh largestHash = 1 `shiftL` 256 -- | Number of blocks on average between difficulty cycles (2016 blocks). @@ -824,12 +911,13 @@ -- | Compare two blocks to get the best. chooseBest :: BlockNode -> BlockNode -> BlockNode -chooseBest b1 b2 | nodeWork b1 == nodeWork b2 = - if nodeHeight b1 >= nodeHeight b2 - then b1 - else b2 - | nodeWork b1 > nodeWork b2 = b1 - | otherwise = b2 +chooseBest b1 b2 + | nodeWork b1 == nodeWork b2 = + if nodeHeight b1 >= nodeHeight b2 + then b1 + else b2 + | nodeWork b1 > nodeWork b2 = b1 + | otherwise = b2 -- | Get list of blocks for a block locator. blockLocatorNodes :: BlockHeaders m => BlockNode -> m [BlockNode] @@ -839,15 +927,18 @@ e1 = error "Could not get ancestor" go loc bn n = let loc' = bn : loc - n' = if length loc' > 10 - then n * 2 - else 1 - in if nodeHeight bn < n' - then do a <- fromMaybe e1 <$> getAncestor 0 bn - return $ a : loc' - else do let h = nodeHeight bn - n' - bn' <- fromMaybe e1 <$> getAncestor h bn - go loc' bn' n' + n' = + if length loc' > 10 + then n * 2 + else 1 + in if nodeHeight bn < n' + then do + a <- fromMaybe e1 <$> getAncestor 0 bn + return $ a : loc' + else do + let h = nodeHeight bn - n' + bn' <- fromMaybe e1 <$> getAncestor h bn + go loc' bn' n' -- | Get block locator. blockLocator :: BlockHeaders m => BlockNode -> m BlockLocator @@ -859,26 +950,31 @@ head [ j | i <- (+ seed) <$> [0 .. maxBound] - , let j = h {bhNonce = i} + , let j = h{bhNonce = i} , isValidPOW net j ] -- | Generate and append new blocks (mining). Only practical in regtest network. appendBlocks :: - Network - -> Word32 -- ^ random seed - -> BlockHeader - -> Int - -> [BlockHeader] + Network -> + -- | random seed + Word32 -> + BlockHeader -> + Int -> + [BlockHeader] appendBlocks _ _ _ 0 = [] appendBlocks net seed bh i = bh' : appendBlocks net seed bh' (i - 1) where - bh' = mineBlock net seed bh - { prevBlock = headerHash bh - -- Just to make it different in every header - , merkleRoot = sha256 $ runPutS $ serialize seed - } + bh' = + mineBlock + net + seed + bh + { prevBlock = headerHash bh + , -- Just to make it different in every header + merkleRoot = sha256 $ runPutS $ serialize seed + } -- | Find the last common block ancestor between provided block headers. splitPoint :: BlockHeaders m => BlockNode -> BlockNode -> m BlockNode diff --git a/src/Haskoin/Block/Merkle.hs b/src/Haskoin/Block/Merkle.hs --- a/src/Haskoin/Block/Merkle.hs +++ b/src/Haskoin/Block/Merkle.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-| +{-# LANGUAGE DeriveGeneric #-} + +{- | Module : Haskoin.Block.Merkle Copyright : No rights reserved License : MIT @@ -10,79 +11,80 @@ Function to deal with Merkle trees inside blocks. -} -module Haskoin.Block.Merkle - ( -- * Merkle Blocks - MerkleBlock(..) - , MerkleRoot - , FlagBits - , PartialMerkleTree - , buildMerkleRoot - , merkleBlockTxs - , testMerkleRoot - , buildPartialMerkle - , decodeMerkleFlags - , encodeMerkleFlags - , calcTreeHeight - , calcTreeWidth - , hash2 - , calcHash - , traverseAndBuild - , traverseAndExtract - , extractMatches - , splitIn - , boolsToWord8 - ) where +module Haskoin.Block.Merkle ( + -- * Merkle Blocks + MerkleBlock (..), + MerkleRoot, + FlagBits, + PartialMerkleTree, + buildMerkleRoot, + merkleBlockTxs, + testMerkleRoot, + buildPartialMerkle, + decodeMerkleFlags, + encodeMerkleFlags, + calcTreeHeight, + calcTreeWidth, + hash2, + calcHash, + traverseAndBuild, + traverseAndExtract, + extractMatches, + splitIn, + boolsToWord8, +) where -import Control.DeepSeq -import Control.Monad (forM_, replicateM, when) -import Data.Binary (Binary (..)) -import Data.Bits -import qualified Data.ByteString as BS -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import Data.Either (isRight) -import Data.Hashable -import Data.Maybe -import Data.Serialize (Serialize (..)) -import Data.Word (Word32, Word8) -import GHC.Generics -import Haskoin.Block.Common -import Haskoin.Constants -import Haskoin.Crypto.Hash -import Haskoin.Network.Common -import Haskoin.Transaction.Common +import Control.DeepSeq +import Control.Monad (forM_, replicateM, when) +import Data.Binary (Binary (..)) +import Data.Bits +import qualified Data.ByteString as BS +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.Either (isRight) +import Data.Hashable +import Data.Maybe +import Data.Serialize (Serialize (..)) +import Data.Word (Word32, Word8) +import GHC.Generics +import Haskoin.Block.Common +import Haskoin.Crypto.Hash +import Haskoin.Data +import Haskoin.Network.Common +import Haskoin.Transaction.Common -- | Hash of the block's Merkle root. -type MerkleRoot = Hash256 +type MerkleRoot = Hash256 -- | Bits that are used to rebuild partial merkle tree transaction hash list. -type FlagBits = [Bool] +type FlagBits = [Bool] -- | Partial Merkle tree for a filtered block. type PartialMerkleTree = [Hash256] --- | Filtered block: a block with a partial Merkle tree that only includes the --- transactions that pass a bloom filter that was negotiated. -data MerkleBlock = - MerkleBlock { - -- | block header - merkleHeader :: !BlockHeader - -- | total number of transactions in block - , merkleTotalTxns :: !Word32 - -- | hashes in depth-first order - , mHashes :: !PartialMerkleTree - -- | bits to rebuild partial merkle tree - , mFlags :: !FlagBits - } deriving (Eq, Show, Read, Generic, Hashable, NFData) +{- | Filtered block: a block with a partial Merkle tree that only includes the + transactions that pass a bloom filter that was negotiated. +-} +data MerkleBlock = MerkleBlock + { -- | block header + merkleHeader :: !BlockHeader + , -- | total number of transactions in block + merkleTotalTxns :: !Word32 + , -- | hashes in depth-first order + mHashes :: !PartialMerkleTree + , -- | bits to rebuild partial merkle tree + mFlags :: !FlagBits + } + deriving (Eq, Show, Read, Generic, Hashable, NFData) instance Serial MerkleBlock where deserialize = do header <- deserialize - ntx <- getWord32le + ntx <- getWord32le (VarInt matchLen) <- deserialize hashes <- replicateM (fromIntegral matchLen) deserialize - (VarInt flagLen) <- deserialize + (VarInt flagLen) <- deserialize ws <- replicateM (fromIntegral flagLen) getWord8 return $ MerkleBlock header ntx hashes (decodeMerkleFlags ws) @@ -106,8 +108,7 @@ -- | Unpack Merkle flags into 'FlagBits' structure. decodeMerkleFlags :: [Word8] -> FlagBits decodeMerkleFlags ws = - [ b | p <- [ 0 .. length ws * 8 - 1 ] - , b <- [ testBit (ws !! (p `div` 8)) (p `mod` 8) ] + [ b | p <- [0 .. length ws * 8 - 1], b <- [testBit (ws !! (p `div` 8)) (p `mod` 8)] ] -- | Pack Merkle flags from 'FlagBits'. @@ -115,22 +116,34 @@ encodeMerkleFlags bs = map boolsToWord8 $ splitIn 8 bs -- | Computes the height of a Merkle tree. -calcTreeHeight :: Int -- ^ number of transactions (leaf nodes) - -> Int -- ^ height of the merkle tree -calcTreeHeight ntx | ntx < 2 = 0 - | even ntx = 1 + calcTreeHeight (ntx `div` 2) - | otherwise = calcTreeHeight $ ntx + 1 +calcTreeHeight :: + -- | number of transactions (leaf nodes) + Int -> + -- | height of the merkle tree + Int +calcTreeHeight ntx + | ntx < 2 = 0 + | even ntx = 1 + calcTreeHeight (ntx `div` 2) + | otherwise = calcTreeHeight $ ntx + 1 --- | Computes the width of a Merkle tree at a specific height. The transactions --- are at height 0. -calcTreeWidth :: Int -- ^ number of transactions (leaf nodes) - -> Int -- ^ height at which we want to compute the width - -> Int -- ^ width of the Merkle tree +{- | Computes the width of a Merkle tree at a specific height. The transactions + are at height 0. +-} +calcTreeWidth :: + -- | number of transactions (leaf nodes) + Int -> + -- | height at which we want to compute the width + Int -> + -- | width of the Merkle tree + Int calcTreeWidth ntx h = (ntx + (1 `shiftL` h) - 1) `shiftR` h -- | Computes the root of a Merkle tree from a list of leaf node hashes. -buildMerkleRoot :: [TxHash] -- ^ transaction hashes (leaf nodes) - -> MerkleRoot -- ^ root of the Merkle tree +buildMerkleRoot :: + -- | transaction hashes (leaf nodes) + [TxHash] -> + -- | root of the Merkle tree + MerkleRoot buildMerkleRoot txs = calcHash (calcTreeHeight $ length txs) 0 txs -- | Concatenate and compute double SHA256. @@ -138,33 +151,43 @@ hash2 a b = doubleSHA256 $ runPutS (serialize a) <> runPutS (serialize b) -- | Computes the hash of a specific node in a Merkle tree. -calcHash :: Int -- ^ height of the node - -> Int -- ^ position of the node (0 for the leftmost node) - -> [TxHash] -- ^ transaction hashes (leaf nodes) - -> Hash256 -- ^ hash of the node at the specified position +calcHash :: + -- | height of the node + Int -> + -- | position of the node (0 for the leftmost node) + Int -> + -- | transaction hashes (leaf nodes) + [TxHash] -> + -- | hash of the node at the specified position + Hash256 calcHash height pos txs | height < 0 || pos < 0 = error "calcHash: Invalid parameters" | height == 0 = getTxHash $ txs !! pos | otherwise = hash2 left right where - left = calcHash (height-1) (pos*2) txs - right | pos*2+1 < calcTreeWidth (length txs) (height-1) = - calcHash (height-1) (pos*2+1) txs - | otherwise = left + left = calcHash (height - 1) (pos * 2) txs + right + | pos * 2 + 1 < calcTreeWidth (length txs) (height - 1) = + calcHash (height - 1) (pos * 2 + 1) txs + | otherwise = left --- | Build a partial Merkle tree. Provide a list of tuples with all transaction --- hashes in the block, and whether the transaction is to be included in the --- partial tree. Returns a flag bits structure and the computed partial Merkle --- tree. +{- | Build a partial Merkle tree. Provide a list of tuples with all transaction + hashes in the block, and whether the transaction is to be included in the + partial tree. Returns a flag bits structure and the computed partial Merkle + tree. +-} buildPartialMerkle :: - [(TxHash, Bool)] -- ^ transaction hash and whether to include - -> (FlagBits, PartialMerkleTree) -- ^ flag bits and partial Merkle tree + -- | transaction hash and whether to include + [(TxHash, Bool)] -> + -- | flag bits and partial Merkle tree + (FlagBits, PartialMerkleTree) buildPartialMerkle hs = traverseAndBuild (calcTreeHeight $ length hs) 0 hs --- | Helper function to build partial Merkle tree. Used by 'buildPartialMerkle' --- above. +{- | Helper function to build partial Merkle tree. Used by 'buildPartialMerkle' + above. +-} traverseAndBuild :: - Int -> Int -> [(TxHash, Bool)] -> (FlagBits, PartialMerkleTree) + Int -> Int -> [(TxHash, Bool)] -> (FlagBits, PartialMerkleTree) traverseAndBuild height pos txs | height < 0 || pos < 0 = error "traverseAndBuild: Invalid parameters" | height == 0 || not match = ([match], [calcHash height pos t]) @@ -181,62 +204,83 @@ | otherwise = ([], []) -- | Helper function to extract transaction hashes from partial Merkle tree. -traverseAndExtract :: Int -> Int -> Int -> FlagBits -> PartialMerkleTree - -> Maybe (MerkleRoot, [TxHash], Int, Int) +traverseAndExtract :: + Int -> + Int -> + Int -> + FlagBits -> + PartialMerkleTree -> + Maybe (MerkleRoot, [TxHash], Int, Int) traverseAndExtract height pos ntx flags hashes - | null flags = Nothing + | null flags = Nothing | height == 0 || not match = leafResult - | isNothing leftM = Nothing - | (pos*2+1) >= calcTreeWidth ntx (height-1) = - Just (hash2 lh lh, lm, lcf+1, lch) - | isNothing rightM = Nothing + | isNothing leftM = Nothing + | (pos * 2 + 1) >= calcTreeWidth ntx (height - 1) = + Just (hash2 lh lh, lm, lcf + 1, lch) + | isNothing rightM = Nothing | otherwise = - Just (hash2 lh rh, lm ++ rm, lcf+rcf+1, lch+rch) + Just (hash2 lh rh, lm ++ rm, lcf + rcf + 1, lch + rch) where leafResult | null hashes = Nothing - | otherwise = Just (h, [ TxHash h | height == 0 && match ], 1, 1) - (match:fs) = flags - (h:_) = hashes - leftM = traverseAndExtract (height-1) (pos*2) ntx fs hashes - (lh,lm,lcf,lch) = fromMaybe e leftM - rightM = traverseAndExtract (height-1) (pos*2+1) ntx - (drop lcf fs) (drop lch hashes) - (rh,rm,rcf,rch) = fromMaybe e rightM + | otherwise = Just (h, [TxHash h | height == 0 && match], 1, 1) + (match : fs) = flags + (h : _) = hashes + leftM = traverseAndExtract (height - 1) (pos * 2) ntx fs hashes + (lh, lm, lcf, lch) = fromMaybe e leftM + rightM = + traverseAndExtract + (height - 1) + (pos * 2 + 1) + ntx + (drop lcf fs) + (drop lch hashes) + (rh, rm, rcf, rch) = fromMaybe e rightM e = error "traverseAndExtract: unexpected error extracting a Maybe value" --- | Extracts the matching hashes from a partial merkle tree. This will return --- the list of transaction hashes that have been included (set to true) in --- a call to 'buildPartialMerkle'. -extractMatches :: Network - -> FlagBits - -> PartialMerkleTree - -> Int -- ^ number of transaction at height 0 (leaf nodes) - -> Either String (MerkleRoot, [TxHash]) - -- ^ Merkle root and list of matching transaction hashes +{- | Extracts the matching hashes from a partial merkle tree. This will return + the list of transaction hashes that have been included (set to true) in + a call to 'buildPartialMerkle'. +-} +extractMatches :: + Network -> + FlagBits -> + PartialMerkleTree -> + -- | number of transaction at height 0 (leaf nodes) + Int -> + -- | Merkle root and list of matching transaction hashes + Either String (MerkleRoot, [TxHash]) extractMatches net flags hashes ntx - | ntx == 0 = Left - "extractMatches: number of transactions can not be 0" - | ntx > getMaxBlockSize net `div` 60 = Left - "extractMatches: number of transactions excessively high" - | length hashes > ntx = Left - "extractMatches: More hashes provided than the number of transactions" - | length flags < length hashes = Left - "extractMatches: At least one bit per node and one bit per hash" - | isNothing resM = Left - "extractMatches: traverseAndExtract failed" - | (nBitsUsed+7) `div` 8 /= (length flags+7) `div` 8 = Left - "extractMatches: All bits were not consumed" - | nHashUsed /= length hashes = Left $ - "extractMatches: All hashes were not consumed: " ++ show nHashUsed + | ntx == 0 = + Left + "extractMatches: number of transactions can not be 0" + | ntx > getMaxBlockSize net `div` 60 = + Left + "extractMatches: number of transactions excessively high" + | length hashes > ntx = + Left + "extractMatches: More hashes provided than the number of transactions" + | length flags < length hashes = + Left + "extractMatches: At least one bit per node and one bit per hash" + | isNothing resM = + Left + "extractMatches: traverseAndExtract failed" + | (nBitsUsed + 7) `div` 8 /= (length flags + 7) `div` 8 = + Left + "extractMatches: All bits were not consumed" + | nHashUsed /= length hashes = + Left $ + "extractMatches: All hashes were not consumed: " ++ show nHashUsed | otherwise = return (merkRoot, matches) where resM = traverseAndExtract (calcTreeHeight ntx) 0 ntx flags hashes (merkRoot, matches, nBitsUsed, nHashUsed) = fromMaybe e resM e = error "extractMatches: unexpected error extracting a Maybe value" --- | Helper function to split a list in chunks 'Int' length. Last chunk may be --- smaller. +{- | Helper function to split a list in chunks 'Int' length. Last chunk may be + smaller. +-} splitIn :: Int -> [a] -> [[a]] splitIn _ [] = [] splitIn c xs = xs1 : splitIn c xs2 @@ -246,7 +290,7 @@ -- | Pack up to eight bools in a byte. boolsToWord8 :: [Bool] -> Word8 boolsToWord8 [] = 0 -boolsToWord8 xs = foldl setBit 0 (map snd $ filter fst $ zip xs [0..7]) +boolsToWord8 xs = foldl setBit 0 (map snd $ filter fst $ zip xs [0 .. 7]) -- | Get matching transactions from Merkle block. merkleBlockTxs :: Network -> MerkleBlock -> Either String [TxHash] @@ -255,9 +299,10 @@ hs = mHashes b n = fromIntegral $ merkleTotalTxns b merkle = merkleRoot $ merkleHeader b - in do (root, ths) <- extractMatches net flags hs n - when (root /= merkle) $ Left "merkleBlockTxs: Merkle root incorrect" - return ths + in do + (root, ths) <- extractMatches net flags hs n + when (root /= merkle) $ Left "merkleBlockTxs: Merkle root incorrect" + return ths -- | Check if Merkle block root is valid against the block header. testMerkleRoot :: Network -> MerkleBlock -> Bool diff --git a/src/Haskoin/Constants.hs b/src/Haskoin/Constants.hs --- a/src/Haskoin/Constants.hs +++ b/src/Haskoin/Constants.hs @@ -1,574 +1,614 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} -{-| -Module : Haskoin.Constants -Copyright : No rights reserved -License : MIT -Maintainer : jprupp@protonmail.ch -Stability : experimental -Portability : POSIX - -Network constants for various networks, including Bitcoin SegWit (BTC), Bitcoin -Cash (BCH), and corresponding public test and private regression test networks. --} -module Haskoin.Constants - ( -- * Constants - Network(..) - , btc - , btcTest - , btcRegTest - , bch - , bchTest - , bchRegTest - , allNets - , netByName - , netByIdent - ) where - -import Control.DeepSeq -import Data.Binary (Binary (..)) -import Data.ByteString (ByteString) -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import Data.List -import Data.Maybe -import Data.Serialize (Serialize (..)) -import Data.String -import Data.Text (Text) -import Data.Word (Word32, Word64, Word8) -import GHC.Generics (Generic) -import Haskoin.Block.Common -import Text.Read - --- | Version of Haskoin Core package. -versionString :: IsString a => a -#ifdef CURRENT_PACKAGE_VERSION -versionString = CURRENT_PACKAGE_VERSION -#else -versionString = "Unavailable" -#endif - --- | Constants for network. -data Network = Network - { -- | lowercase alphanumeric and dashes - getNetworkName :: !String - -- | network Haskell identifier - , getNetworkIdent :: !String - -- | prefix for 'Base58' P2PKH addresses - , getAddrPrefix :: !Word8 - -- | prefix for 'Base58' P2SH addresses - , getScriptPrefix :: !Word8 - -- | prefix for WIF private key - , getSecretPrefix :: !Word8 - -- | prefix for extended public key - , getExtPubKeyPrefix :: !Word32 - -- | prefix for extended private key - , getExtSecretPrefix :: !Word32 - -- | network magic - , getNetworkMagic :: !Word32 - -- | genesis block header - , getGenesisHeader :: !BlockHeader - -- | maximum block size in bytes - , getMaxBlockSize :: !Int - -- | maximum amount of satoshi - , getMaxSatoshi :: !Word64 - -- | user agent string - , getHaskoinUserAgent :: !ByteString - -- | default port for P2P connections - , getDefaultPort :: !Int - -- | allow min difficulty blocks (testnet) - , getAllowMinDifficultyBlocks :: !Bool - -- | do not retarget difficulty (regtest) - , getPowNoRetargetting :: !Bool - -- | proof-of-work target higest possible value - , getPowLimit :: !Integer - -- | block at which BIP34 activates - , getBip34Block :: !(BlockHeight, BlockHash) - -- | block at which BIP65 activates - , getBip65Height :: !BlockHeight - -- | block at which BIP66 activates - , getBip66Height :: !BlockHeight - -- | time between difficulty retargets - , getTargetTimespan :: !Word32 - -- | time between blocks - , getTargetSpacing :: !Word32 - -- | checkpoints - , getCheckpoints :: ![(BlockHeight, BlockHash)] - -- | BIP44 derivation path root - , getBip44Coin :: !Word32 - -- | peer-to-peer network seeds - , getSeeds :: ![String] - -- | fork id for replay protection - , getSigHashForkId :: !(Maybe Word32) - -- | EDA start block height - , getEdaBlockHeight :: !(Maybe Word32) - -- | DAA start block height - , getDaaBlockHeight :: !(Maybe Word32) - -- | asert3-2d algorithm activation time - -- TODO: Replace with block height after fork - , getAsertActivationTime :: !(Maybe Word32) - -- | asert3-2d algorithm halflife (not used for non-BCH networks) - , getAsertHalfLife :: !Integer - -- | segregated witness active - , getSegWit :: !Bool - -- | 'CashAddr' prefix (for Bitcoin Cash) - , getCashAddrPrefix :: !(Maybe Text) - -- | 'Bech32' prefix (for SegWit network) - , getBech32Prefix :: !(Maybe Text) - -- | Replace-By-Fee (BIP-125) - , getReplaceByFee :: !Bool - -- | Subsidy halving interval - , getHalvingInterval :: !Word32 - } deriving (Eq, Generic, NFData) - -instance Serial Network where - serialize net = - putWord32be $ getNetworkMagic net - deserialize = do - magic <- getWord32be - case find ((== magic) . getNetworkMagic) allNets of - Nothing -> fail $ "Network magic unknown: " <> show magic - Just net -> return net - -instance Binary Network where - put = serialize - get = deserialize - -instance Serialize Network where - put = serialize - get = deserialize - -instance Show Network where - show = getNetworkIdent - -instance Read Network where - readPrec = do - Ident str <- lexP - maybe pfail return (netByIdent str) - -instance IsString Network where - fromString = fromMaybe (error "Network name invalid") . netByName - --- | Query known networks by name. -netByName :: String -> Maybe Network -netByName str = find ((== str) . getNetworkName) allNets - --- | Query known networks by Haskell identifier. -netByIdent :: String -> Maybe Network -netByIdent str = find ((== str) . getNetworkIdent) allNets - --- | Bitcoin SegWit network. Symbol: BTC. -btc :: Network -btc = - Network - { getNetworkName = "btc" - , getNetworkIdent = "btc" - , getAddrPrefix = 0 - , getScriptPrefix = 5 - , getSecretPrefix = 128 - , getExtPubKeyPrefix = 0x0488b21e - , getExtSecretPrefix = 0x0488ade4 - , getNetworkMagic = 0xf9beb4d9 - , getGenesisHeader = - BlockHeader - 0x01 - "0000000000000000000000000000000000000000000000000000000000000000" - "3ba3edfd7a7b12b27ac72c3e67768f617fc81bc3888a51323a9fb8aa4b1e5e4a" - 1231006505 - 0x1d00ffff - 2083236893 - -- Hash 000000000019d6689c085ae165831e934ff763ae46a2a6c172b3f1b60a8ce26f - , getMaxBlockSize = 1000000 - , getMaxSatoshi = 2100000000000000 - , getHaskoinUserAgent = - "/haskoin-btc:" <> versionString <> "/" - , getDefaultPort = 8333 - , getAllowMinDifficultyBlocks = False - , getPowNoRetargetting = False - , getPowLimit = - 0x00000000ffffffffffffffffffffffffffffffffffffffffffffffffffffffff - , getBip34Block = - ( 227931 - , "000000000000024b89b42a942fe0d9fea3bb44ab7bd1b19115dd6a759c0808b8") - , getBip65Height = 388381 - , getBip66Height = 363725 - , getTargetTimespan = 14 * 24 * 60 * 60 - , getTargetSpacing = 10 * 60 - , getCheckpoints = - [ ( 11111 - , "0000000069e244f73d78e8fd29ba2fd2ed618bd6fa2ee92559f542fdb26e7c1d") - , ( 33333 - , "000000002dd5588a74784eaa7ab0507a18ad16a236e7b1ce69f00d7ddfb5d0a6") - , ( 74000 - , "0000000000573993a3c9e41ce34471c079dcf5f52a0e824a81e7f953b8661a20") - , ( 105000 - , "00000000000291ce28027faea320c8d2b054b2e0fe44a773f3eefb151d6bdc97") - , ( 134444 - , "00000000000005b12ffd4cd315cd34ffd4a594f430ac814c91184a0d42d2b0fe") - , ( 168000 - , "000000000000099e61ea72015e79632f216fe6cb33d7899acb35b75c8303b763") - , ( 193000 - , "000000000000059f452a5f7340de6682a977387c17010ff6e6c3bd83ca8b1317") - , ( 210000 - , "000000000000048b95347e83192f69cf0366076336c639f9b7228e9ba171342e") - , ( 216116 - , "00000000000001b4f4b433e81ee46494af945cf96014816a4e2370f11b23df4e") - , ( 225430 - , "00000000000001c108384350f74090433e7fcf79a606b8e797f065b130575932") - , ( 250000 - , "000000000000003887df1f29024b06fc2200b55f8af8f35453d7be294df2d214") - , ( 279000 - , "0000000000000001ae8c72a0b0c301f67e3afca10e819efa9041e458e9bd7e40") - , ( 295000 - , "00000000000000004d9b4ef50f0f9d686fd69db2e03af35a100370c64632a983") - ] - , getSeeds = - [ "seed.bitcoin.sipa.be" -- Pieter Wuille - , "dnsseed.bluematt.me" -- Matt Corallo - , "dnsseed.bitcoin.dashjr.org" -- Luke Dashjr - , "seed.bitcoinstats.com" -- Chris Decker - , "seed.bitcoin.jonasschnelli.ch" -- Jonas Schnelli - , "seed.btc.petertodd.org" -- Peter Todd - , "seed.bitcoin.sprovoost.nl" -- Sjors Provoost - , "dnsseed.emzy.de" -- Stephan Oeste - , "seed.bitcoin.wiz.biz" -- Jason Maurice - ] - , getBip44Coin = 0 - , getSigHashForkId = Nothing - , getEdaBlockHeight = Nothing - , getDaaBlockHeight = Nothing - , getAsertActivationTime = Nothing - , getAsertHalfLife = 0 - , getSegWit = True - , getCashAddrPrefix = Nothing - , getBech32Prefix = Just "bc" - , getReplaceByFee = True - , getHalvingInterval = 210000 - } - --- | Testnet for Bitcoin SegWit network. -btcTest :: Network -btcTest = - Network - { getNetworkName = "btctest" - , getNetworkIdent = "btcTest" - , getAddrPrefix = 111 - , getScriptPrefix = 196 - , getSecretPrefix = 239 - , getExtPubKeyPrefix = 0x043587cf - , getExtSecretPrefix = 0x04358394 - , getNetworkMagic = 0x0b110907 - , getGenesisHeader = - BlockHeader - 0x01 - "0000000000000000000000000000000000000000000000000000000000000000" - "3ba3edfd7a7b12b27ac72c3e67768f617fc81bc3888a51323a9fb8aa4b1e5e4a" - 1296688602 - 486604799 - 414098458 - -- Hash 000000000933ea01ad0ee984209779baaec3ced90fa3f408719526f8d77f4943 - , getMaxBlockSize = 1000000 - , getMaxSatoshi = 2100000000000000 - , getHaskoinUserAgent = "/haskoin-btc-test:" <> versionString <> "/" - , getDefaultPort = 18333 - , getAllowMinDifficultyBlocks = True - , getPowNoRetargetting = False - , getPowLimit = - 0x00000000ffffffffffffffffffffffffffffffffffffffffffffffffffffffff - , getBip34Block = - ( 21111 - , "0000000023b3a96d3484e5abb3755c413e7d41500f8e2a5c3f0dd01299cd8ef8") - , getBip65Height = 581885 - , getBip66Height = 330776 - , getTargetTimespan = 14 * 24 * 60 * 60 - , getTargetSpacing = 10 * 60 - , getCheckpoints = - [ ( 546 - , "000000002a936ca763904c3c35fce2f3556c559c0214345d31b1bcebf76acb70") - ] - , getSeeds = - [ "testnet-seed.bitcoin.jonasschnelli.ch" - , "seed.tbtc.petertodd.org" - , "seed.testnet.bitcoin.sprovoost.nl" - , "testnet-seed.bluematt.me" - ] - , getBip44Coin = 1 - , getSigHashForkId = Nothing - , getEdaBlockHeight = Nothing - , getDaaBlockHeight = Nothing - , getAsertActivationTime = Nothing - , getAsertHalfLife = 0 - , getSegWit = True - , getCashAddrPrefix = Nothing - , getBech32Prefix = Just "tb" - , getReplaceByFee = True - , getHalvingInterval = 210000 - } - --- | RegTest for Bitcoin SegWit network. -btcRegTest :: Network -btcRegTest = - Network - { getNetworkName = "btcreg" - , getNetworkIdent = "btcRegTest" - , getAddrPrefix = 111 - , getScriptPrefix = 196 - , getSecretPrefix = 239 - , getExtPubKeyPrefix = 0x043587cf - , getExtSecretPrefix = 0x04358394 - , getNetworkMagic = 0xfabfb5da - , getGenesisHeader = - BlockHeader - -- 0f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e2206 - 0x01 - "0000000000000000000000000000000000000000000000000000000000000000" - "3ba3edfd7a7b12b27ac72c3e67768f617fc81bc3888a51323a9fb8aa4b1e5e4a" - 1296688602 - 0x207fffff - 2 - , getMaxBlockSize = 1000000 - , getMaxSatoshi = 2100000000000000 - , getHaskoinUserAgent = "/haskoin-btc-regtest:" <> versionString <> "/" - , getDefaultPort = 18444 - , getAllowMinDifficultyBlocks = True - , getPowNoRetargetting = True - , getPowLimit = - 0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff - , getBip34Block = - ( 100000000 - , "0000000000000000000000000000000000000000000000000000000000000000") - , getBip65Height = 1351 - , getBip66Height = 1251 - , getTargetTimespan = 14 * 24 * 60 * 60 - , getTargetSpacing = 10 * 60 - , getCheckpoints = [] - , getSeeds = ["localhost"] - , getBip44Coin = 1 - , getSigHashForkId = Nothing - , getEdaBlockHeight = Nothing - , getDaaBlockHeight = Nothing - , getAsertActivationTime = Nothing - , getAsertHalfLife = 0 - , getSegWit = True - , getCashAddrPrefix = Nothing - , getBech32Prefix = Just "bcrt" - , getReplaceByFee = True - , getHalvingInterval = 150 - } - --- | Bitcoin Cash network. Symbol: BCH. -bch :: Network -bch = - Network - { getNetworkName = "bch" - , getNetworkIdent = "bch" - , getAddrPrefix = 0 - , getScriptPrefix = 5 - , getSecretPrefix = 128 - , getExtPubKeyPrefix = 0x0488b21e - , getExtSecretPrefix = 0x0488ade4 - , getNetworkMagic = 0xe3e1f3e8 - , getGenesisHeader = - BlockHeader - 0x01 - "0000000000000000000000000000000000000000000000000000000000000000" - "3ba3edfd7a7b12b27ac72c3e67768f617fc81bc3888a51323a9fb8aa4b1e5e4a" - 1231006505 - 0x1d00ffff - 2083236893 - -- Hash 000000000019d6689c085ae165831e934ff763ae46a2a6c172b3f1b60a8ce26f - , getMaxBlockSize = 32000000 - , getMaxSatoshi = 2100000000000000 - , getHaskoinUserAgent = "/haskoin-bch:" <> versionString <> "/" - , getDefaultPort = 8333 - , getAllowMinDifficultyBlocks = False - , getPowNoRetargetting = False - , getPowLimit = - 0x00000000ffffffffffffffffffffffffffffffffffffffffffffffffffffffff - , getBip34Block = - ( 227931 - , "000000000000024b89b42a942fe0d9fea3bb44ab7bd1b19115dd6a759c0808b8") - , getBip65Height = 388381 - , getBip66Height = 363725 - , getTargetTimespan = 14 * 24 * 60 * 60 - , getTargetSpacing = 10 * 60 - , getCheckpoints = - [ ( 11111 - , "0000000069e244f73d78e8fd29ba2fd2ed618bd6fa2ee92559f542fdb26e7c1d") - , ( 33333 - , "000000002dd5588a74784eaa7ab0507a18ad16a236e7b1ce69f00d7ddfb5d0a6") - , ( 74000 - , "0000000000573993a3c9e41ce34471c079dcf5f52a0e824a81e7f953b8661a20") - , ( 105000 - , "00000000000291ce28027faea320c8d2b054b2e0fe44a773f3eefb151d6bdc97") - , ( 134444 - , "00000000000005b12ffd4cd315cd34ffd4a594f430ac814c91184a0d42d2b0fe") - , ( 168000 - , "000000000000099e61ea72015e79632f216fe6cb33d7899acb35b75c8303b763") - , ( 193000 - , "000000000000059f452a5f7340de6682a977387c17010ff6e6c3bd83ca8b1317") - , ( 210000 - , "000000000000048b95347e83192f69cf0366076336c639f9b7228e9ba171342e") - , ( 216116 - , "00000000000001b4f4b433e81ee46494af945cf96014816a4e2370f11b23df4e") - , ( 225430 - , "00000000000001c108384350f74090433e7fcf79a606b8e797f065b130575932") - , ( 250000 - , "000000000000003887df1f29024b06fc2200b55f8af8f35453d7be294df2d214") - , ( 279000 - , "0000000000000001ae8c72a0b0c301f67e3afca10e819efa9041e458e9bd7e40") - , ( 295000 - , "00000000000000004d9b4ef50f0f9d686fd69db2e03af35a100370c64632a983") - -- UAHF fork block. - , ( 478559 - , "000000000000000000651ef99cb9fcbe0dadde1d424bd9f15ff20136191a5eec") - -- Nov, 13 DAA activation block. - , ( 504031 - , "0000000000000000011ebf65b60d0a3de80b8175be709d653b4c1a1beeb6ab9c") - ] - , getSeeds = - [ "seed.bitcoinabc.org" - , "seed-bch.bitcoinforks.org" - , "btccash-seeder.bitcoinunlimited.info" - , "seed.bchd.cash" - , "seed.bch.loping.net" - , "dnsseed.electroncash.de" - ] - , getBip44Coin = 145 - , getSigHashForkId = Just 0 - , getEdaBlockHeight = Just 478559 - , getDaaBlockHeight = Just 404031 - , getAsertActivationTime = Just 1605441600 - , getAsertHalfLife = 60 * 60 * 10 - , getSegWit = False - , getCashAddrPrefix = Just "bitcoincash" - , getBech32Prefix = Nothing - , getReplaceByFee = False - , getHalvingInterval = 210000 - } - --- | Testnet for Bitcoin Cash network. -bchTest :: Network -bchTest = - Network - { getNetworkName = "bchtest" - , getNetworkIdent = "bchTest" - , getAddrPrefix = 111 - , getScriptPrefix = 196 - , getSecretPrefix = 239 - , getExtPubKeyPrefix = 0x043587cf - , getExtSecretPrefix = 0x04358394 - , getNetworkMagic = 0xf4e5f3f4 - , getGenesisHeader = - BlockHeader - 0x01 - "0000000000000000000000000000000000000000000000000000000000000000" - "3ba3edfd7a7b12b27ac72c3e67768f617fc81bc3888a51323a9fb8aa4b1e5e4a" - 1296688602 - 486604799 - 414098458 - -- Hash 000000000933ea01ad0ee984209779baaec3ced90fa3f408719526f8d77f4943 - , getMaxBlockSize = 32000000 - , getMaxSatoshi = 2100000000000000 - , getHaskoinUserAgent = "/haskoin-bch-test:" <> versionString <> "/" - , getDefaultPort = 18333 - , getAllowMinDifficultyBlocks = True - , getPowNoRetargetting = False - , getPowLimit = - 0x00000000ffffffffffffffffffffffffffffffffffffffffffffffffffffffff - , getBip34Block = - ( 21111 - , "0000000023b3a96d3484e5abb3755c413e7d41500f8e2a5c3f0dd01299cd8ef8") - , getBip65Height = 581885 - , getBip66Height = 330776 - , getTargetTimespan = 14 * 24 * 60 * 60 - , getTargetSpacing = 10 * 60 - , getCheckpoints = - [ ( 546 - , "000000002a936ca763904c3c35fce2f3556c559c0214345d31b1bcebf76acb70") - -- UAHF fork block. - , ( 1155876 - , "00000000000e38fef93ed9582a7df43815d5c2ba9fd37ef70c9a0ea4a285b8f5") - -- Nov, 13. DAA activation block. - , ( 1188697 - , "0000000000170ed0918077bde7b4d36cc4c91be69fa09211f748240dabe047fb") - ] - , getSeeds = - [ "testnet-seed.bitcoinabc.org" - , "testnet-seed-bch.bitcoinforks.org" - , "testnet-seed.bchd.cash" - , "seed.tbch.loping.net" - ] - , getBip44Coin = 1 - , getSigHashForkId = Just 0 - , getEdaBlockHeight = Just 1155876 - , getDaaBlockHeight = Just 1188697 - , getAsertActivationTime = Just 1605441600 - , getAsertHalfLife = 60 * 60 - , getSegWit = False - , getCashAddrPrefix = Just "bchtest" - , getBech32Prefix = Nothing - , getReplaceByFee = False - , getHalvingInterval = 210000 - } - --- | RegTest for Bitcoin Cash network. -bchRegTest :: Network -bchRegTest = - Network - { getNetworkName = "bchreg" - , getNetworkIdent = "bchRegTest" - , getAddrPrefix = 111 - , getScriptPrefix = 196 - , getSecretPrefix = 239 - , getExtPubKeyPrefix = 0x043587cf - , getExtSecretPrefix = 0x04358394 - , getNetworkMagic = 0xdab5bffa - , getGenesisHeader = - BlockHeader - -- 0f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e2206 - 0x01 - "0000000000000000000000000000000000000000000000000000000000000000" - "3ba3edfd7a7b12b27ac72c3e67768f617fc81bc3888a51323a9fb8aa4b1e5e4a" - 1296688602 - 0x207fffff - 2 - , getMaxBlockSize = 1000000 - , getMaxSatoshi = 2100000000000000 - , getHaskoinUserAgent = "/haskoin-bch-regtest:" <> versionString <> "/" - , getDefaultPort = 18444 - , getAllowMinDifficultyBlocks = True - , getPowNoRetargetting = True - , getPowLimit = - 0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff - , getBip34Block = - ( 100000000 - , "0000000000000000000000000000000000000000000000000000000000000000") - , getBip65Height = 1351 - , getBip66Height = 1251 - , getTargetTimespan = 14 * 24 * 60 * 60 - , getTargetSpacing = 10 * 60 - , getCheckpoints = - [ ( 0 - , "0f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e2206") - ] - , getSeeds = ["localhost"] - , getBip44Coin = 1 - , getSigHashForkId = Just 0 - , getEdaBlockHeight = Nothing - , getDaaBlockHeight = Just 0 - , getAsertActivationTime = Just 1605441600 - , getAsertHalfLife = 2 * 24 * 60 * 60 - , getSegWit = False - , getCashAddrPrefix = Just "bchreg" - , getBech32Prefix = Nothing - , getReplaceByFee = False - , getHalvingInterval = 150 - } - --- | List of all networks supported by this library. -allNets :: [Network] -allNets = [btc, bch, btcTest, bchTest, btcRegTest, bchRegTest] +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +{- | +Module : Haskoin.Constants +Copyright : No rights reserved +License : MIT +Maintainer : jprupp@protonmail.ch +Stability : experimental +Portability : POSIX + +Network constants for various networks, including Bitcoin SegWit (BTC), Bitcoin +Cash (BCH), and corresponding public test and private regression test networks. +-} +module Haskoin.Constants ( + Network(..), + -- * Constants + btc, + btcTest, + btcRegTest, + bch, + bchTest, + bchTest4, + bchRegTest, + allNets, + netByName, +) where + +import Control.DeepSeq +import Data.Binary (Binary (..)) +import Data.ByteString (ByteString) +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.List +import Data.Maybe +import Data.Serialize (Serialize (..)) +import Data.String +import Data.Text (Text) +import Data.Word (Word32, Word64, Word8) +import GHC.Generics (Generic) +import Haskoin.Block +import Haskoin.Data +import Haskoin.Network.Common +import Haskoin.Transaction +import Text.Read + +-- | Version of Haskoin Core package. +versionString :: IsString a => a + +#ifdef CURRENT_PACKAGE_VERSION +versionString = CURRENT_PACKAGE_VERSION +#else +versionString = "Unavailable" +#endif + +-- | Query known networks by name. +netByName :: String -> Maybe Network +netByName str = find ((== str) . getNetworkName) allNets + +-- | Bitcoin SegWit network. Symbol: BTC. +btc :: Network +btc = + Network + { getNetworkName = "btc" + , getAddrPrefix = 0 + , getScriptPrefix = 5 + , getSecretPrefix = 128 + , getExtPubKeyPrefix = 0x0488b21e + , getExtSecretPrefix = 0x0488ade4 + , getNetworkMagic = 0xf9beb4d9 + , getGenesisHeader = + BlockHeader + 0x01 + "0000000000000000000000000000000000000000000000000000000000000000" + (buildMerkleRoot [txHash genesisTx]) + 1231006505 + 0x1d00ffff + 2083236893 + , -- Hash 000000000019d6689c085ae165831e934ff763ae46a2a6c172b3f1b60a8ce26f + getMaxBlockSize = 1000000 + , getMaxSatoshi = 2100000000000000 + , getHaskoinUserAgent = + "/haskoin-btc:" <> versionString <> "/" + , getDefaultPort = 8333 + , getAllowMinDifficultyBlocks = False + , getPowNoRetargetting = False + , getPowLimit = + 0x00000000ffffffffffffffffffffffffffffffffffffffffffffffffffffffff + , getBip34Block = + ( 227931 + , "000000000000024b89b42a942fe0d9fea3bb44ab7bd1b19115dd6a759c0808b8" + ) + , getBip65Height = 388381 + , getBip66Height = 363725 + , getTargetTimespan = 14 * 24 * 60 * 60 + , getTargetSpacing = 10 * 60 + , getCheckpoints = + [ + ( 11111 + , "0000000069e244f73d78e8fd29ba2fd2ed618bd6fa2ee92559f542fdb26e7c1d" + ) + , + ( 33333 + , "000000002dd5588a74784eaa7ab0507a18ad16a236e7b1ce69f00d7ddfb5d0a6" + ) + , + ( 74000 + , "0000000000573993a3c9e41ce34471c079dcf5f52a0e824a81e7f953b8661a20" + ) + , + ( 105000 + , "00000000000291ce28027faea320c8d2b054b2e0fe44a773f3eefb151d6bdc97" + ) + , + ( 134444 + , "00000000000005b12ffd4cd315cd34ffd4a594f430ac814c91184a0d42d2b0fe" + ) + , + ( 168000 + , "000000000000099e61ea72015e79632f216fe6cb33d7899acb35b75c8303b763" + ) + , + ( 193000 + , "000000000000059f452a5f7340de6682a977387c17010ff6e6c3bd83ca8b1317" + ) + , + ( 210000 + , "000000000000048b95347e83192f69cf0366076336c639f9b7228e9ba171342e" + ) + , + ( 216116 + , "00000000000001b4f4b433e81ee46494af945cf96014816a4e2370f11b23df4e" + ) + , + ( 225430 + , "00000000000001c108384350f74090433e7fcf79a606b8e797f065b130575932" + ) + , + ( 250000 + , "000000000000003887df1f29024b06fc2200b55f8af8f35453d7be294df2d214" + ) + , + ( 279000 + , "0000000000000001ae8c72a0b0c301f67e3afca10e819efa9041e458e9bd7e40" + ) + , + ( 295000 + , "00000000000000004d9b4ef50f0f9d686fd69db2e03af35a100370c64632a983" + ) + ] + , getSeeds = + [ "seed.bitcoin.sipa.be" -- Pieter Wuille + , "dnsseed.bluematt.me" -- Matt Corallo + , "dnsseed.bitcoin.dashjr.org" -- Luke Dashjr + , "seed.bitcoinstats.com" -- Chris Decker + , "seed.bitcoin.jonasschnelli.ch" -- Jonas Schnelli + , "seed.btc.petertodd.org" -- Peter Todd + , "seed.bitcoin.sprovoost.nl" -- Sjors Provoost + , "dnsseed.emzy.de" -- Stephan Oeste + , "seed.bitcoin.wiz.biz" -- Jason Maurice + ] + , getBip44Coin = 0 + , getSigHashForkId = Nothing + , getEdaBlockHeight = Nothing + , getDaaBlockHeight = Nothing + , getAsertActivationTime = Nothing + , getAsertHalfLife = 0 + , getSegWit = True + , getCashAddrPrefix = Nothing + , getBech32Prefix = Just "bc" + , getReplaceByFee = True + , getHalvingInterval = 210000 + } + +-- | Testnet for Bitcoin SegWit network. +btcTest :: Network +btcTest = + Network + { getNetworkName = "btctest" + , getAddrPrefix = 111 + , getScriptPrefix = 196 + , getSecretPrefix = 239 + , getExtPubKeyPrefix = 0x043587cf + , getExtSecretPrefix = 0x04358394 + , getNetworkMagic = 0x0b110907 + , getGenesisHeader = + BlockHeader + 0x01 + "0000000000000000000000000000000000000000000000000000000000000000" + (buildMerkleRoot [txHash genesisTx]) + 1296688602 + 486604799 + 414098458 + , -- Hash 000000000933ea01ad0ee984209779baaec3ced90fa3f408719526f8d77f4943 + getMaxBlockSize = 1000000 + , getMaxSatoshi = 2100000000000000 + , getHaskoinUserAgent = "/haskoin-btc-test:" <> versionString <> "/" + , getDefaultPort = 18333 + , getAllowMinDifficultyBlocks = True + , getPowNoRetargetting = False + , getPowLimit = + 0x00000000ffffffffffffffffffffffffffffffffffffffffffffffffffffffff + , getBip34Block = + ( 21111 + , "0000000023b3a96d3484e5abb3755c413e7d41500f8e2a5c3f0dd01299cd8ef8" + ) + , getBip65Height = 581885 + , getBip66Height = 330776 + , getTargetTimespan = 14 * 24 * 60 * 60 + , getTargetSpacing = 10 * 60 + , getCheckpoints = + [ + ( 546 + , "000000002a936ca763904c3c35fce2f3556c559c0214345d31b1bcebf76acb70" + ) + ] + , getSeeds = + [ "testnet-seed.bitcoin.jonasschnelli.ch" + , "seed.tbtc.petertodd.org" + , "seed.testnet.bitcoin.sprovoost.nl" + , "testnet-seed.bluematt.me" + ] + , getBip44Coin = 1 + , getSigHashForkId = Nothing + , getEdaBlockHeight = Nothing + , getDaaBlockHeight = Nothing + , getAsertActivationTime = Nothing + , getAsertHalfLife = 0 + , getSegWit = True + , getCashAddrPrefix = Nothing + , getBech32Prefix = Just "tb" + , getReplaceByFee = True + , getHalvingInterval = 210000 + } + +-- | RegTest for Bitcoin SegWit network. +btcRegTest :: Network +btcRegTest = + Network + { getNetworkName = "btcreg" + , getAddrPrefix = 111 + , getScriptPrefix = 196 + , getSecretPrefix = 239 + , getExtPubKeyPrefix = 0x043587cf + , getExtSecretPrefix = 0x04358394 + , getNetworkMagic = 0xfabfb5da + , getGenesisHeader = + BlockHeader + -- 0f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e2206 + 0x01 + "0000000000000000000000000000000000000000000000000000000000000000" + (buildMerkleRoot [txHash genesisTx]) + 1296688602 + 0x207fffff + 2 + , getMaxBlockSize = 1000000 + , getMaxSatoshi = 2100000000000000 + , getHaskoinUserAgent = "/haskoin-btc-regtest:" <> versionString <> "/" + , getDefaultPort = 18444 + , getAllowMinDifficultyBlocks = True + , getPowNoRetargetting = True + , getPowLimit = + 0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff + , getBip34Block = + ( 100000000 + , "0000000000000000000000000000000000000000000000000000000000000000" + ) + , getBip65Height = 1351 + , getBip66Height = 1251 + , getTargetTimespan = 14 * 24 * 60 * 60 + , getTargetSpacing = 10 * 60 + , getCheckpoints = [] + , getSeeds = ["localhost"] + , getBip44Coin = 1 + , getSigHashForkId = Nothing + , getEdaBlockHeight = Nothing + , getDaaBlockHeight = Nothing + , getAsertActivationTime = Nothing + , getAsertHalfLife = 0 + , getSegWit = True + , getCashAddrPrefix = Nothing + , getBech32Prefix = Just "bcrt" + , getReplaceByFee = True + , getHalvingInterval = 150 + } + +-- | Bitcoin Cash network. Symbol: BCH. +bch :: Network +bch = + Network + { getNetworkName = "bch" + , getAddrPrefix = 0 + , getScriptPrefix = 5 + , getSecretPrefix = 128 + , getExtPubKeyPrefix = 0x0488b21e + , getExtSecretPrefix = 0x0488ade4 + , getNetworkMagic = 0xe3e1f3e8 + , getGenesisHeader = + BlockHeader + 0x01 + "0000000000000000000000000000000000000000000000000000000000000000" + (buildMerkleRoot [txHash genesisTx]) + 1231006505 + 0x1d00ffff + 2083236893 + , -- Hash 000000000019d6689c085ae165831e934ff763ae46a2a6c172b3f1b60a8ce26f + getMaxBlockSize = 32000000 + , getMaxSatoshi = 2100000000000000 + , getHaskoinUserAgent = "/haskoin-bch:" <> versionString <> "/" + , getDefaultPort = 8333 + , getAllowMinDifficultyBlocks = False + , getPowNoRetargetting = False + , getPowLimit = + 0x00000000ffffffffffffffffffffffffffffffffffffffffffffffffffffffff + , getBip34Block = + ( 227931 + , "000000000000024b89b42a942fe0d9fea3bb44ab7bd1b19115dd6a759c0808b8" + ) + , getBip65Height = 388381 + , getBip66Height = 363725 + , getTargetTimespan = 14 * 24 * 60 * 60 + , getTargetSpacing = 10 * 60 + , getCheckpoints = + [ + ( 11111 + , "0000000069e244f73d78e8fd29ba2fd2ed618bd6fa2ee92559f542fdb26e7c1d" + ) + , + ( 33333 + , "000000002dd5588a74784eaa7ab0507a18ad16a236e7b1ce69f00d7ddfb5d0a6" + ) + , + ( 74000 + , "0000000000573993a3c9e41ce34471c079dcf5f52a0e824a81e7f953b8661a20" + ) + , + ( 105000 + , "00000000000291ce28027faea320c8d2b054b2e0fe44a773f3eefb151d6bdc97" + ) + , + ( 134444 + , "00000000000005b12ffd4cd315cd34ffd4a594f430ac814c91184a0d42d2b0fe" + ) + , + ( 168000 + , "000000000000099e61ea72015e79632f216fe6cb33d7899acb35b75c8303b763" + ) + , + ( 193000 + , "000000000000059f452a5f7340de6682a977387c17010ff6e6c3bd83ca8b1317" + ) + , + ( 210000 + , "000000000000048b95347e83192f69cf0366076336c639f9b7228e9ba171342e" + ) + , + ( 216116 + , "00000000000001b4f4b433e81ee46494af945cf96014816a4e2370f11b23df4e" + ) + , + ( 225430 + , "00000000000001c108384350f74090433e7fcf79a606b8e797f065b130575932" + ) + , + ( 250000 + , "000000000000003887df1f29024b06fc2200b55f8af8f35453d7be294df2d214" + ) + , + ( 279000 + , "0000000000000001ae8c72a0b0c301f67e3afca10e819efa9041e458e9bd7e40" + ) + , + ( 295000 + , "00000000000000004d9b4ef50f0f9d686fd69db2e03af35a100370c64632a983" + ) + , -- UAHF fork block. + + ( 478559 + , "000000000000000000651ef99cb9fcbe0dadde1d424bd9f15ff20136191a5eec" + ) + , -- Nov, 13 DAA activation block. + + ( 504031 + , "0000000000000000011ebf65b60d0a3de80b8175be709d653b4c1a1beeb6ab9c" + ) + ] + , getSeeds = + [ "seed.bitcoinabc.org" + , "seed-bch.bitcoinforks.org" + , "btccash-seeder.bitcoinunlimited.info" + , "seed.bchd.cash" + , "seed.bch.loping.net" + , "dnsseed.electroncash.de" + ] + , getBip44Coin = 145 + , getSigHashForkId = Just 0 + , getEdaBlockHeight = Just 478559 + , getDaaBlockHeight = Just 404031 + , getAsertActivationTime = Just 1605441600 + , getAsertHalfLife = 60 * 60 * 10 + , getSegWit = False + , getCashAddrPrefix = Just "bitcoincash" + , getBech32Prefix = Nothing + , getReplaceByFee = False + , getHalvingInterval = 210000 + } + +-- | Testnet for Bitcoin Cash network. +bchTest4 :: Network +bchTest4 = + Network + { getNetworkName = "bchtest4" + , getAddrPrefix = 111 + , getScriptPrefix = 196 + , getSecretPrefix = 239 + , getExtPubKeyPrefix = 0x043587cf + , getExtSecretPrefix = 0x04358394 + , getNetworkMagic = 0xe2b7daaf + , getGenesisHeader = + BlockHeader + 0x01 + "0000000000000000000000000000000000000000000000000000000000000000" + (buildMerkleRoot [txHash genesisTx]) + 1597811185 + 0x1d00ffff + 114152193 + , -- Hash 000000000933ea01ad0ee984209779baaec3ced90fa3f408719526f8d77f4943 + getMaxBlockSize = 2000000 + , getMaxSatoshi = 2100000000000000 + , getHaskoinUserAgent = "/haskoin-bch-test4:" <> versionString <> "/" + , getDefaultPort = 28333 + , getAllowMinDifficultyBlocks = True + , getPowNoRetargetting = False + , getPowLimit = + 0x00000000ffffffffffffffffffffffffffffffffffffffffffffffffffffffff + , getBip34Block = + ( 2 + , "00000000b0c65b1e03baace7d5c093db0d6aac224df01484985ffd5e86a1a20c" + ) + , getBip65Height = 3 + , getBip66Height = 4 + , getTargetTimespan = 14 * 24 * 60 * 60 + , getTargetSpacing = 10 * 60 + , getCheckpoints = + [ + ( 5000 + , "000000009f092d074574a216faec682040a853c4f079c33dfd2c3ef1fd8108c4" + ) + , -- Axion activation + + ( 16845 + , "00000000fb325b8f34fe80c96a5f708a08699a68bbab82dba4474d86bd743077" + ) + , + ( 38000 + , "000000000015197537e59f339e3b1bbf81a66f691bd3d7aa08560fc7bf5113fb" + ) + , + ( 54700 + , "00000000009af4379d87f17d0f172ee4769b48839a5a3a3e81d69da4322518b8" + ) + ] + , getSeeds = + [ "testnet4-seed-bch.bitcoinforks.org" + , "testnet4-seed-bch.toom.im" + , "seed.tbch4.loping.net" + , "testnet4-seed.flowee.cash" + ] + , getBip44Coin = 1 + , getSigHashForkId = Just 0 + , getEdaBlockHeight = Just 7 + , getDaaBlockHeight = Just 3000 + , getAsertActivationTime = Just 1605441600 + , getAsertHalfLife = 60 * 60 + , getSegWit = False + , getCashAddrPrefix = Just "bchtest" + , getBech32Prefix = Nothing + , getReplaceByFee = False + , getHalvingInterval = 210000 + } + +-- | Testnet for Bitcoin Cash network. +bchTest :: Network +bchTest = + Network + { getNetworkName = "bchtest" + , getAddrPrefix = 111 + , getScriptPrefix = 196 + , getSecretPrefix = 239 + , getExtPubKeyPrefix = 0x043587cf + , getExtSecretPrefix = 0x04358394 + , getNetworkMagic = 0xf4e5f3f4 + , getGenesisHeader = + BlockHeader + 0x01 + "0000000000000000000000000000000000000000000000000000000000000000" + (buildMerkleRoot [txHash genesisTx]) + 1296688602 + 486604799 + 414098458 + , -- Hash 000000000933ea01ad0ee984209779baaec3ced90fa3f408719526f8d77f4943 + getMaxBlockSize = 32000000 + , getMaxSatoshi = 2100000000000000 + , getHaskoinUserAgent = "/haskoin-bch-test:" <> versionString <> "/" + , getDefaultPort = 18333 + , getAllowMinDifficultyBlocks = True + , getPowNoRetargetting = False + , getPowLimit = + 0x00000000ffffffffffffffffffffffffffffffffffffffffffffffffffffffff + , getBip34Block = + ( 21111 + , "0000000023b3a96d3484e5abb3755c413e7d41500f8e2a5c3f0dd01299cd8ef8" + ) + , getBip65Height = 581885 + , getBip66Height = 330776 + , getTargetTimespan = 14 * 24 * 60 * 60 + , getTargetSpacing = 10 * 60 + , getCheckpoints = + [ + ( 546 + , "000000002a936ca763904c3c35fce2f3556c559c0214345d31b1bcebf76acb70" + ) + , -- UAHF fork block. + + ( 1155876 + , "00000000000e38fef93ed9582a7df43815d5c2ba9fd37ef70c9a0ea4a285b8f5" + ) + , -- Nov, 13. DAA activation block. + + ( 1188697 + , "0000000000170ed0918077bde7b4d36cc4c91be69fa09211f748240dabe047fb" + ) + ] + , getSeeds = + [ "testnet-seed.bitcoinabc.org" + , "testnet-seed-bch.bitcoinforks.org" + , "testnet-seed.bchd.cash" + , "seed.tbch.loping.net" + ] + , getBip44Coin = 1 + , getSigHashForkId = Just 0 + , getEdaBlockHeight = Just 1155876 + , getDaaBlockHeight = Just 1188697 + , getAsertActivationTime = Just 1605441600 + , getAsertHalfLife = 60 * 60 + , getSegWit = False + , getCashAddrPrefix = Just "bchtest" + , getBech32Prefix = Nothing + , getReplaceByFee = False + , getHalvingInterval = 210000 + } + +-- | RegTest for Bitcoin Cash network. +bchRegTest :: Network +bchRegTest = + Network + { getNetworkName = "bchreg" + , getAddrPrefix = 111 + , getScriptPrefix = 196 + , getSecretPrefix = 239 + , getExtPubKeyPrefix = 0x043587cf + , getExtSecretPrefix = 0x04358394 + , getNetworkMagic = 0xdab5bffa + , getGenesisHeader = + BlockHeader + -- 0f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e2206 + 0x01 + "0000000000000000000000000000000000000000000000000000000000000000" + (buildMerkleRoot [txHash genesisTx]) + 1296688602 + 0x207fffff + 2 + , getMaxBlockSize = 1000000 + , getMaxSatoshi = 2100000000000000 + , getHaskoinUserAgent = "/haskoin-bch-regtest:" <> versionString <> "/" + , getDefaultPort = 18444 + , getAllowMinDifficultyBlocks = True + , getPowNoRetargetting = True + , getPowLimit = + 0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff + , getBip34Block = + ( 100000000 + , "0000000000000000000000000000000000000000000000000000000000000000" + ) + , getBip65Height = 1351 + , getBip66Height = 1251 + , getTargetTimespan = 14 * 24 * 60 * 60 + , getTargetSpacing = 10 * 60 + , getCheckpoints = + [ + ( 0 + , "0f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e2206" + ) + ] + , getSeeds = ["localhost"] + , getBip44Coin = 1 + , getSigHashForkId = Just 0 + , getEdaBlockHeight = Nothing + , getDaaBlockHeight = Just 0 + , getAsertActivationTime = Just 1605441600 + , getAsertHalfLife = 2 * 24 * 60 * 60 + , getSegWit = False + , getCashAddrPrefix = Just "bchreg" + , getBech32Prefix = Nothing + , getReplaceByFee = False + , getHalvingInterval = 150 + } + +-- | List of all networks supported by this library. +allNets :: [Network] +allNets = [btc, bch, btcTest, bchTest4, bchTest, btcRegTest, bchRegTest] diff --git a/src/Haskoin/Crypto.hs b/src/Haskoin/Crypto.hs --- a/src/Haskoin/Crypto.hs +++ b/src/Haskoin/Crypto.hs @@ -1,4 +1,4 @@ -{-| +{- | Module : Haskoin.Crypto Copyright : No rights reserved License : MIT @@ -8,12 +8,12 @@ Hashing functions and ECDSA signatures. -} -module Haskoin.Crypto - ( module Hash - , module Signature - , module Secp256k1 - ) where +module Haskoin.Crypto ( + module Hash, + module Signature, + module Secp256k1, +) where -import Crypto.Secp256k1 as Secp256k1 -import Haskoin.Crypto.Hash as Hash -import Haskoin.Crypto.Signature as Signature +import Crypto.Secp256k1 as Secp256k1 +import Haskoin.Crypto.Hash as Hash +import Haskoin.Crypto.Signature as Signature diff --git a/src/Haskoin/Crypto/Hash.hs b/src/Haskoin/Crypto/Hash.hs --- a/src/Haskoin/Crypto/Hash.hs +++ b/src/Haskoin/Crypto/Hash.hs @@ -1,6 +1,8 @@ {-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-| +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeApplications #-} + +{- | Module : Haskoin.Crypto.Hash Copyright : No rights reserved License : MIT @@ -11,53 +13,63 @@ Hashing functions and corresponding data types. Uses functions from the cryptonite library. -} -module Haskoin.Crypto.Hash - ( -- * Hashes - Hash512(getHash512) - , Hash256(getHash256) - , Hash160(getHash160) - , CheckSum32(getCheckSum32) - , sha512 - , sha256 - , ripemd160 - , sha1 - , doubleSHA256 - , addressHash - , checkSum32 - , hmac512 - , hmac256 - , split512 - , join512 - ) where +module Haskoin.Crypto.Hash ( + -- * Hashes + Hash512 (getHash512), + Hash256 (getHash256), + Hash160 (getHash160), + CheckSum32 (getCheckSum32), + sha512, + sha256, + ripemd160, + sha1, + doubleSHA256, + addressHash, + checkSum32, + hmac512, + hmac256, + split512, + join512, + initTaggedHash, +) where -import Control.DeepSeq -import Crypto.Hash (RIPEMD160 (..), SHA1 (..), - SHA256 (..), SHA512 (..), hashWith) -import Crypto.MAC.HMAC (HMAC, hmac) -import Data.Binary (Binary (..)) -import Data.ByteArray (ByteArrayAccess) -import qualified Data.ByteArray as BA -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import Data.ByteString.Short (ShortByteString) -import qualified Data.ByteString.Short as BSS -import qualified Data.Bytes.Get as Get -import qualified Data.Bytes.Put as Put -import Data.Bytes.Serial (Serial (..)) -import Data.Either (fromRight) -import Data.Hashable (Hashable) -import Data.Serialize (Serialize (..)) -import Data.String (IsString, fromString) -import Data.String.Conversions (cs) -import Data.Word (Word32) -import GHC.Generics (Generic) -import Haskoin.Util -import Text.Read as R +import Control.DeepSeq +import Crypto.Hash ( + Context, + RIPEMD160 (..), + SHA1 (..), + SHA256 (..), + SHA512 (..), + hashInit, + hashUpdates, + hashWith, + ) +import Crypto.MAC.HMAC (HMAC, hmac) +import Data.Binary (Binary (..)) +import Data.ByteArray (ByteArrayAccess) +import qualified Data.ByteArray as BA +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.ByteString.Short (ShortByteString) +import qualified Data.ByteString.Short as BSS +import qualified Data.Bytes.Get as Get +import qualified Data.Bytes.Put as Put +import Data.Bytes.Serial (Serial (..)) +import Data.Either (fromRight) +import Data.Hashable (Hashable) +import Data.Serialize (Serialize (..)) +import Data.String (IsString, fromString) +import Data.String.Conversions (cs) +import Data.Word (Word32) +import GHC.Generics (Generic) +import Haskoin.Util +import Text.Read as R -- | 'Word32' wrapped for type-safe 32-bit checksums. newtype CheckSum32 = CheckSum32 { getCheckSum32 :: Word32 - } deriving (Eq, Ord, Serial, Show, Read, Hashable, Generic, NFData) + } + deriving (Eq, Ord, Serial, Show, Read, Hashable, Generic, NFData) instance Serialize CheckSum32 where put = serialize @@ -68,15 +80,15 @@ get = deserialize -- | Type for 512-bit hashes. -newtype Hash512 = Hash512 { getHash512 :: ShortByteString } +newtype Hash512 = Hash512 {getHash512 :: ShortByteString} deriving (Eq, Ord, Hashable, Generic, NFData) -- | Type for 256-bit hashes. -newtype Hash256 = Hash256 { getHash256 :: ShortByteString } +newtype Hash256 = Hash256 {getHash256 :: ShortByteString} deriving (Eq, Ord, Hashable, Generic, NFData) -- | Type for 160-bit hashes. -newtype Hash160 = Hash160 { getHash160 :: ShortByteString } +newtype Hash160 = Hash160 {getHash160 :: ShortByteString} deriving (Eq, Ord, Hashable, Generic, NFData) instance Show Hash512 where @@ -110,7 +122,7 @@ Just bs -> case BS.length bs of 64 -> Hash512 (BSS.toShort bs) - _ -> e + _ -> e where e = error "Could not decode hash from hex string" @@ -133,7 +145,7 @@ Just bs -> case BS.length bs of 32 -> Hash256 (BSS.toShort bs) - _ -> e + _ -> e where e = error "Could not decode hash from hex string" @@ -156,7 +168,7 @@ Just bs -> case BS.length bs of 20 -> Hash160 (BSS.toShort bs) - _ -> e + _ -> e where e = error "Could not decode hash from hex string" @@ -202,12 +214,13 @@ -- | Computes a 32 bit checksum. checkSum32 :: ByteArrayAccess b => b -> CheckSum32 -checkSum32 = fromRight (error "Could not decode bytes as CheckSum32") - . Get.runGetS deserialize - . BS.take 4 - . BA.convert - . hashWith SHA256 - . hashWith SHA256 +checkSum32 = + fromRight (error "Could not decode bytes as CheckSum32") + . Get.runGetS deserialize + . BS.take 4 + . BA.convert + . hashWith SHA256 + . hashWith SHA256 {- HMAC -} @@ -231,6 +244,20 @@ -- | Join a pair of 'Hash256' into a 'Hash512'. join512 :: (Hash256, Hash256) -> Hash512 join512 (a, b) = - Hash512 . - BSS.toShort $ - BSS.fromShort (getHash256 a) `BS.append` BSS.fromShort (getHash256 b) + Hash512 + . BSS.toShort + $ BSS.fromShort (getHash256 a) `BS.append` BSS.fromShort (getHash256 b) + +{- | Initialize tagged hash specified in BIP340 + +@since 0.21.0 +-} +initTaggedHash :: + -- | Hash tag + ByteString -> + Context SHA256 +initTaggedHash tag = + (`hashUpdates` [hashedTag, hashedTag]) $ + hashInit @SHA256 + where + hashedTag = hashWith SHA256 tag diff --git a/src/Haskoin/Crypto/Signature.hs b/src/Haskoin/Crypto/Signature.hs --- a/src/Haskoin/Crypto/Signature.hs +++ b/src/Haskoin/Crypto/Signature.hs @@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -{-| + +{- | Module : Haskoin.Crypto.Signature Copyright : No rights reserved License : MIT @@ -10,29 +11,29 @@ ECDSA signatures using secp256k1 curve. Uses functions from upstream secp256k1 library. -} -module Haskoin.Crypto.Signature - ( -- * Signatures - putSig - , getSig - , signHash - , verifyHashSig - , isCanonicalHalfOrder - , decodeStrictSig - , exportSig - ) where +module Haskoin.Crypto.Signature ( + -- * Signatures + putSig, + getSig, + signHash, + verifyHashSig, + isCanonicalHalfOrder, + decodeStrictSig, + exportSig, +) where -import Control.Monad (guard, unless, when) -import Crypto.Secp256k1 -import Data.Binary (Binary (..)) -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import Data.Maybe (fromMaybe, isNothing) -import Data.Serialize (Serialize (..)) -import Haskoin.Crypto.Hash -import Numeric (showHex) +import Control.Monad (guard, unless, when) +import Crypto.Secp256k1 +import Data.Binary (Binary (..)) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.Maybe (fromMaybe, isNothing) +import Data.Serialize (Serialize (..)) +import Haskoin.Crypto.Hash +import Numeric (showHex) -- | Convert 256-bit hash into a 'Msg' for signing or verification. hashToMsg :: Hash256 -> Msg @@ -60,14 +61,14 @@ -- 0x30 is DER sequence type unless (t == 0x30) $ fail $ - "Bad DER identifier byte 0x" ++ showHex t ". Expecting 0x30" + "Bad DER identifier byte 0x" ++ showHex t ". Expecting 0x30" l <- getWord8 when (l == 0x00) $ fail "Indeterminate form unsupported" when (l >= 0x80) $ fail "Multi-octect length not supported" return $ fromIntegral l bs <- getByteString $ l + 2 case decodeStrictSig bs of - Just s -> return s + Just s -> return s Nothing -> fail "Invalid signature" -- | Serialize an ECDSA signature for Bitcoin use. diff --git a/src/Haskoin/Data.hs b/src/Haskoin/Data.hs new file mode 100644 --- /dev/null +++ b/src/Haskoin/Data.hs @@ -0,0 +1,93 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} + +module Haskoin.Data ( + Network (..), +) where + +import Control.DeepSeq +import Data.Binary (Binary (..)) +import Data.ByteString (ByteString) +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.List +import Data.Serialize (Serialize (..)) +import Data.String +import Data.Text (Text) +import Data.Word (Word32, Word64, Word8) +import GHC.Generics (Generic) +import Haskoin.Block.Common +import Text.Read + +-- | Network definition. +data Network = Network + { -- | lowercase alphanumeric and dashes + getNetworkName :: !String + , -- | prefix for 'Base58' P2PKH addresses + getAddrPrefix :: !Word8 + , -- | prefix for 'Base58' P2SH addresses + getScriptPrefix :: !Word8 + , -- | prefix for WIF private key + getSecretPrefix :: !Word8 + , -- | prefix for extended public key + getExtPubKeyPrefix :: !Word32 + , -- | prefix for extended private key + getExtSecretPrefix :: !Word32 + , -- | network magic + getNetworkMagic :: !Word32 + , -- | genesis block header + getGenesisHeader :: !BlockHeader + , -- | maximum block size in bytes + getMaxBlockSize :: !Int + , -- | maximum amount of satoshi + getMaxSatoshi :: !Word64 + , -- | user agent string + getHaskoinUserAgent :: !ByteString + , -- | default port for P2P connections + getDefaultPort :: !Int + , -- | allow min difficulty blocks (testnet) + getAllowMinDifficultyBlocks :: !Bool + , -- | do not retarget difficulty (regtest) + getPowNoRetargetting :: !Bool + , -- | proof-of-work target higest possible value + getPowLimit :: !Integer + , -- | block at which BIP34 activates + getBip34Block :: !(BlockHeight, BlockHash) + , -- | block at which BIP65 activates + getBip65Height :: !BlockHeight + , -- | block at which BIP66 activates + getBip66Height :: !BlockHeight + , -- | time between difficulty retargets + getTargetTimespan :: !Word32 + , -- | time between blocks + getTargetSpacing :: !Word32 + , -- | checkpoints + getCheckpoints :: ![(BlockHeight, BlockHash)] + , -- | BIP44 derivation path root + getBip44Coin :: !Word32 + , -- | peer-to-peer network seeds + getSeeds :: ![String] + , -- | fork id for replay protection + getSigHashForkId :: !(Maybe Word32) + , -- | EDA start block height + getEdaBlockHeight :: !(Maybe Word32) + , -- | DAA start block height + getDaaBlockHeight :: !(Maybe Word32) + , -- | asert3-2d algorithm activation time + -- TODO: Replace with block height after fork + getAsertActivationTime :: !(Maybe Word32) + , -- | asert3-2d algorithm halflife (not used for non-BCH networks) + getAsertHalfLife :: !Integer + , -- | segregated witness active + getSegWit :: !Bool + , -- | 'CashAddr' prefix (for Bitcoin Cash) + getCashAddrPrefix :: !(Maybe Text) + , -- | 'Bech32' prefix (for SegWit network) + getBech32Prefix :: !(Maybe Text) + , -- | Replace-By-Fee (BIP-125) + getReplaceByFee :: !Bool + , -- | Subsidy halving interval + getHalvingInterval :: !Word32 + } + deriving (Eq, Show, Read, Generic, NFData) diff --git a/src/Haskoin/Keys.hs b/src/Haskoin/Keys.hs --- a/src/Haskoin/Keys.hs +++ b/src/Haskoin/Keys.hs @@ -1,4 +1,4 @@ -{-| +{- | Module : Haskoin.Keys Copyright : No rights reserved License : MIT @@ -9,12 +9,12 @@ ECDSA private and public keys, extended keys (BIP-32) and mnemonic sentences (BIP-39). -} -module Haskoin.Keys - ( module Haskoin.Keys.Common - , module Haskoin.Keys.Extended - , module Haskoin.Keys.Mnemonic - ) where +module Haskoin.Keys ( + module Haskoin.Keys.Common, + module Haskoin.Keys.Extended, + module Haskoin.Keys.Mnemonic, +) where -import Haskoin.Keys.Common -import Haskoin.Keys.Extended -import Haskoin.Keys.Mnemonic +import Haskoin.Keys.Common +import Haskoin.Keys.Extended +import Haskoin.Keys.Mnemonic diff --git a/src/Haskoin/Keys/Common.hs b/src/Haskoin/Keys/Common.hs --- a/src/Haskoin/Keys/Common.hs +++ b/src/Haskoin/Keys/Common.hs @@ -1,11 +1,12 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -{-| + +{- | Module : Haskoin.Keys.Common Copyright : No rights reserved License : MIT @@ -15,54 +16,61 @@ ECDSA private and public key functions. -} -module Haskoin.Keys.Common - ( -- * Public & Private Keys - PubKeyI(..) - , SecKeyI(..) - , exportPubKey - , importPubKey - , wrapPubKey - , derivePubKeyI - , wrapSecKey - , fromMiniKey - , tweakPubKey - , tweakSecKey - , getSecKey - , secKey +module Haskoin.Keys.Common ( + -- * Public & Private Keys + PubKeyI (..), + SecKeyI (..), + exportPubKey, + importPubKey, + wrapPubKey, + derivePubKeyI, + wrapSecKey, + fromMiniKey, + tweakPubKey, + tweakSecKey, + getSecKey, + secKey, + -- ** Private Key Wallet Import Format (WIF) - , fromWif - , toWif - ) where + fromWif, + toWif, +) where -import Control.DeepSeq -import Control.Monad (guard, mzero, (<=<)) -import Crypto.Secp256k1 -import Data.Aeson (FromJSON, ToJSON (..), Value (String), - parseJSON, withText) -import Data.Aeson.Encoding (unsafeToEncoding) -import Data.Binary (Binary (..)) -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import Data.ByteString.Builder (char7) -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import Data.Hashable -import Data.Maybe (fromMaybe) -import Data.Serialize (Serialize (..)) -import Data.String (IsString, fromString) -import Data.String.Conversions (cs) -import GHC.Generics (Generic) -import Haskoin.Address.Base58 -import Haskoin.Constants -import Haskoin.Crypto.Hash -import Haskoin.Util +import Control.DeepSeq +import Control.Monad (guard, mzero, (<=<)) +import Crypto.Secp256k1 +import Data.Aeson ( + FromJSON, + ToJSON (..), + Value (String), + parseJSON, + withText, + ) +import Data.Aeson.Encoding (unsafeToEncoding) +import Data.Binary (Binary (..)) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.ByteString.Builder (char7) +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.Hashable +import Data.Maybe (fromMaybe) +import Data.Serialize (Serialize (..)) +import Data.String (IsString, fromString) +import Data.String.Conversions (cs) +import GHC.Generics (Generic) +import Haskoin.Address.Base58 +import Haskoin.Crypto.Hash +import Haskoin.Data +import Haskoin.Util -- | Elliptic curve public key type with expected serialized compression flag. data PubKeyI = PubKeyI - { pubKeyPoint :: !PubKey + { pubKeyPoint :: !PubKey , pubKeyCompressed :: !Bool - } deriving (Generic, Eq, Show, Read, Hashable, NFData) + } + deriving (Generic, Eq, Show, Read, Hashable, NFData) instance IsString PubKeyI where fromString str = @@ -72,25 +80,30 @@ instance ToJSON PubKeyI where toJSON = String . encodeHex . runPutS . serialize - toEncoding s = unsafeToEncoding $ - char7 '"' <> - hexBuilder (runPutL (serialize s)) <> - char7 '"' + toEncoding s = + unsafeToEncoding $ + char7 '"' + <> hexBuilder (runPutL (serialize s)) + <> char7 '"' instance FromJSON PubKeyI where - parseJSON = withText "PubKeyI" $ - maybe mzero return . ((eitherToMaybe . runGetS deserialize) <=< decodeHex) + parseJSON = + withText "PubKeyI" $ + maybe mzero return . ((eitherToMaybe . runGetS deserialize) <=< decodeHex) instance Serial PubKeyI where - deserialize = s >>= \case - True -> c - False -> u + deserialize = + s >>= \case + True -> c + False -> u where - s = lookAhead $ getWord8 >>= \case - 0x02 -> return True - 0x03 -> return True - 0x04 -> return False - _ -> fail "Not a public key" + s = + lookAhead $ + getWord8 >>= \case + 0x02 -> return True + 0x03 -> return True + 0x04 -> return False + _ -> fail "Not a public key" c = do bs <- getByteString 33 maybe (fail "Could not decode public key") return $ @@ -114,8 +127,9 @@ wrapPubKey :: Bool -> PubKey -> PubKeyI wrapPubKey c p = PubKeyI p c --- | Derives a public key from a private key. This function will preserve --- compression flag. +{- | Derives a public key from a private key. This function will preserve + compression flag. +-} derivePubKeyI :: SecKeyI -> PubKeyI derivePubKeyI (SecKeyI d c) = PubKeyI (derivePubKey d) c @@ -123,14 +137,16 @@ tweakPubKey :: PubKey -> Hash256 -> Maybe PubKey tweakPubKey p h = tweakAddPubKey p =<< tweak (runPutS (serialize h)) --- | Elliptic curve private key type with expected public key compression --- information. Compression information is stored in private key WIF formats and --- needs to be preserved to generate the correct address from the corresponding --- public key. +{- | Elliptic curve private key type with expected public key compression + information. Compression information is stored in private key WIF formats and + needs to be preserved to generate the correct address from the corresponding + public key. +-} data SecKeyI = SecKeyI - { secKeyData :: !SecKey + { secKeyData :: !SecKey , secKeyCompressed :: !Bool - } deriving (Eq, Show, Read, Generic, NFData) + } + deriving (Eq, Show, Read, Generic, NFData) -- | Wrap private key with corresponding public key compression flag. wrapSecKey :: Bool -> SecKey -> SecKeyI @@ -163,12 +179,12 @@ guard $ BS.last bs == 0x01 wrapSecKey True <$> secKey (BS.tail $ BS.init bs) -- Bad length - _ -> Nothing + _ -> Nothing -- | Encode private key into a WIF string. toWif :: Network -> SecKeyI -> Base58 toWif net (SecKeyI k c) = encodeBase58Check . BS.cons (getSecretPrefix net) $ - if c - then getSecKey k `BS.snoc` 0x01 - else getSecKey k + if c + then getSecKey k `BS.snoc` 0x01 + else getSecKey k diff --git a/src/Haskoin/Keys/Extended.hs b/src/Haskoin/Keys/Extended.hs --- a/src/Haskoin/Keys/Extended.hs +++ b/src/Haskoin/Keys/Extended.hs @@ -1,9 +1,10 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} -{-| + +{- | Module : Haskoin.Keys.Extended Copyright : No rights reserved License : MIT @@ -13,135 +14,149 @@ BIP-32 extended keys. -} -module Haskoin.Keys.Extended - ( - -- * Extended Keys - XPubKey(..) - , XPrvKey(..) - , ChainCode - , KeyIndex - , Fingerprint - , DerivationException(..) - , makeXPrvKey - , deriveXPubKey - , prvSubKey - , pubSubKey - , hardSubKey - , xPrvIsHard - , xPubIsHard - , xPrvChild - , xPubChild - , xPubID - , xPrvID - , xPubFP - , xPrvFP - , xPubAddr - , xPubWitnessAddr - , xPubCompatWitnessAddr - , xPubExport - , xPubToJSON - , xPubToEncoding - , xPubFromJSON - , xPrvExport - , xPrvToJSON - , xPrvToEncoding - , xPrvFromJSON - , xPubImport - , xPrvImport - , xPrvWif - , putXPrvKey - , putXPubKey - , getXPrvKey - , getXPubKey - - -- ** Helper Functions - , prvSubKeys - , pubSubKeys - , hardSubKeys - , deriveAddr - , deriveWitnessAddr - , deriveCompatWitnessAddr - , deriveAddrs - , deriveWitnessAddrs - , deriveCompatWitnessAddrs - , deriveMSAddr - , deriveMSAddrs - , cycleIndex +module Haskoin.Keys.Extended ( + -- * Extended Keys + XPubKey (..), + XPrvKey (..), + ChainCode, + KeyIndex, + Fingerprint, + fingerprintToText, + textToFingerprint, + DerivationException (..), + makeXPrvKey, + deriveXPubKey, + prvSubKey, + pubSubKey, + hardSubKey, + xPrvIsHard, + xPubIsHard, + xPrvChild, + xPubChild, + xPubID, + xPrvID, + xPubFP, + xPrvFP, + xPubAddr, + xPubWitnessAddr, + xPubCompatWitnessAddr, + xPubExport, + xPubToJSON, + xPubToEncoding, + xPubFromJSON, + xPrvExport, + xPrvToJSON, + xPrvToEncoding, + xPrvFromJSON, + xPubImport, + xPrvImport, + xPrvWif, + putXPrvKey, + putXPubKey, + getXPrvKey, + getXPubKey, - -- ** Derivation Paths - , DerivPathI(..) - , AnyDeriv, HardDeriv, SoftDeriv - , HardOrAny - , AnyOrSoft - , DerivPath - , HardPath - , SoftPath - , Bip32PathIndex (..) - , derivePath - , derivePubPath - , toHard - , toSoft - , toGeneric - , (++/) - , pathToStr - , listToPath - , pathToList + -- ** Helper Functions + prvSubKeys, + pubSubKeys, + hardSubKeys, + deriveAddr, + deriveWitnessAddr, + deriveCompatWitnessAddr, + deriveAddrs, + deriveWitnessAddrs, + deriveCompatWitnessAddrs, + deriveMSAddr, + deriveMSAddrs, + cycleIndex, - -- *** Derivation Path Parser - , XKey(..) - , ParsedPath(..) - , parsePath - , parseHard - , parseSoft - , applyPath - , derivePathAddr - , derivePathAddrs - , derivePathMSAddr - , derivePathMSAddrs - , concatBip32Segments - ) where + -- ** Derivation Paths + DerivPathI (..), + AnyDeriv, + HardDeriv, + SoftDeriv, + HardOrAny, + AnyOrSoft, + DerivPath, + HardPath, + SoftPath, + Bip32PathIndex (..), + derivePath, + derivePubPath, + toHard, + toSoft, + toGeneric, + (++/), + pathToStr, + listToPath, + pathToList, -import Control.Applicative -import Control.DeepSeq -import Control.Exception (Exception, throw) -import Control.Monad (guard, mzero, unless, (<=<)) -import Crypto.Secp256k1 -import Data.Aeson as A (FromJSON, ToJSON (..), - Value (String), parseJSON, - toJSON, withText) -import Data.Aeson.Encoding (Encoding, text) -import Data.Aeson.Types (Parser) -import Data.Binary (Binary (get, put)) -import Data.Bits (clearBit, setBit, testBit) -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import Data.Either (fromRight) -import Data.Hashable -import Data.List (foldl') -import Data.List.Split (splitOn) -import Data.Maybe (fromMaybe) -import Data.Serialize (Serialize (..)) -import qualified Data.Serialize as S -import Data.String (IsString, fromString) -import Data.String.Conversions (cs) -import Data.Typeable (Typeable) -import Data.Word (Word32, Word8) -import GHC.Generics (Generic) -import Haskoin.Address -import Haskoin.Constants -import Haskoin.Crypto.Hash -import Haskoin.Keys.Common -import Haskoin.Script -import Haskoin.Util -import Text.Read as R -import Text.Read.Lex + -- *** Derivation Path Parser + XKey (..), + ParsedPath (..), + parsePath, + parseHard, + parseSoft, + applyPath, + derivePathAddr, + derivePathAddrs, + derivePathMSAddr, + derivePathMSAddrs, + concatBip32Segments, +) where +import Control.Applicative +import Control.DeepSeq +import Control.Exception (Exception, throw) +import Control.Monad (guard, mzero, unless, (<=<)) +import Crypto.Secp256k1 +import Data.Aeson as A ( + FromJSON, + ToJSON (..), + Value (String), + parseJSON, + toJSON, + withText, + ) +import Data.Aeson.Encoding (Encoding, text) +import Data.Aeson.Types (Parser) +import Data.Binary (Binary (get, put)) +import Data.Bits (clearBit, setBit, testBit) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.Either (fromRight) +import Data.Hashable +import Data.List (foldl') +import Data.List.Split (splitOn) +import Data.Maybe (fromMaybe) +import Data.Serialize (Serialize (..)) +import qualified Data.Serialize as S +import Data.String (IsString, fromString) +import Data.String.Conversions (cs) +import qualified Data.Text as Text +import Data.Typeable (Typeable) +import Data.Word (Word32, Word8) +import GHC.Generics (Generic) +import Haskoin.Address +import Haskoin.Crypto.Hash +import Haskoin.Data +import Haskoin.Keys.Common +import Haskoin.Keys.Extended.Internal ( + Fingerprint (..), + fingerprintToText, + textToFingerprint, + ) +import Haskoin.Script +import Haskoin.Util +import Text.Read as R +import Text.Read.Lex --- | A derivation exception is thrown in the very unlikely event that a --- derivation is invalid. +{- | A derivation exception is thrown in the very unlikely event that a + derivation is invalid. +-} newtype DerivationException = DerivationException String deriving (Eq, Read, Show, Typeable, Generic, NFData) @@ -153,33 +168,37 @@ -- | Index of key as specified in BIP-32. type KeyIndex = Word32 --- | Fingerprint of parent -type Fingerprint = Word32 - --- | Data type representing an extended BIP32 private key. An extended key --- is a node in a tree of key derivations. It has a depth in the tree, a --- parent node and an index to differentiate it from other siblings. +{- | Data type representing an extended BIP32 private key. An extended key + is a node in a tree of key derivations. It has a depth in the tree, a + parent node and an index to differentiate it from other siblings. +-} data XPrvKey = XPrvKey - { xPrvDepth :: !Word8 -- ^ depth in the tree - , xPrvParent :: !Fingerprint -- ^ fingerprint of parent - , xPrvIndex :: !KeyIndex -- ^ derivation index - , xPrvChain :: !ChainCode -- ^ chain code - , xPrvKey :: !SecKey -- ^ private key of this node - } deriving (Generic, Eq, Show, Read, NFData, Hashable) + { -- | depth in the tree + xPrvDepth :: !Word8 + , -- | fingerprint of parent + xPrvParent :: !Fingerprint + , -- | derivation index + xPrvIndex :: !KeyIndex + , -- | chain code + xPrvChain :: !ChainCode + , -- | private key of this node + xPrvKey :: !SecKey + } + deriving (Generic, Eq, Show, Read, NFData, Hashable) instance Serial XPrvKey where serialize k = do putWord8 $ xPrvDepth k - putWord32be $ xPrvParent k + serialize $ xPrvParent k putWord32be $ xPrvIndex k serialize $ xPrvChain k putPadPrvKey $ xPrvKey k deserialize = XPrvKey <$> getWord8 - <*> getWord32be - <*> getWord32be - <*> deserialize - <*> getPadPrvKey + <*> deserialize + <*> getWord32be + <*> deserialize + <*> getPadPrvKey instance Binary XPrvKey where put = serialize @@ -201,30 +220,36 @@ withText "xprv" $ \t -> case xPrvImport net t of Nothing -> fail "could not read xprv" - Just x -> return x + Just x -> return x -- | Data type representing an extended BIP32 public key. data XPubKey = XPubKey - { xPubDepth :: !Word8 -- ^ depth in the tree - , xPubParent :: !Fingerprint -- ^ fingerprint of parent - , xPubIndex :: !KeyIndex -- ^ derivation index - , xPubChain :: !ChainCode -- ^ chain code - , xPubKey :: !PubKey -- ^ public key of this node - } deriving (Generic, Eq, Show, Read, NFData, Hashable) + { -- | depth in the tree + xPubDepth :: !Word8 + , -- | fingerprint of parent + xPubParent :: !Fingerprint + , -- | derivation index + xPubIndex :: !KeyIndex + , -- | chain code + xPubChain :: !ChainCode + , -- | public key of this node + xPubKey :: !PubKey + } + deriving (Generic, Eq, Show, Read, NFData, Hashable) instance Serial XPubKey where serialize k = do putWord8 $ xPubDepth k - putWord32be $ xPubParent k + serialize $ xPubParent k putWord32be $ xPubIndex k serialize $ xPubChain k serialize $ wrapPubKey True (xPubKey k) deserialize = XPubKey <$> getWord8 - <*> getWord32be - <*> getWord32be - <*> deserialize - <*> (pubKeyPoint <$> deserialize) + <*> deserialize + <*> getWord32be + <*> deserialize + <*> (pubKeyPoint <$> deserialize) instance Serialize XPubKey where put = serialize @@ -240,7 +265,7 @@ withText "xpub" $ \t -> case xPubImport net t of Nothing -> fail "could not read xpub" - Just x -> return x + Just x -> return x -- | Get JSON 'Value' from 'XPubKey'. xPubToJSON :: Network -> XPubKey -> Value @@ -249,34 +274,41 @@ xPubToEncoding :: Network -> XPubKey -> Encoding xPubToEncoding net = text . xPubExport net --- | Build a BIP32 compatible extended private key from a bytestring. This will --- produce a root node (@depth=0@ and @parent=0@). +{- | Build a BIP32 compatible extended private key from a bytestring. This will + produce a root node (@depth=0@ and @parent=0@). +-} makeXPrvKey :: ByteString -> XPrvKey makeXPrvKey bs = - XPrvKey 0 0 0 c k + XPrvKey 0 (Fingerprint 0) 0 c k where (p, c) = split512 $ hmac512 "Bitcoin seed" bs - k = fromMaybe err (secKey (runPutS (serialize p))) - err = throw $ DerivationException "Invalid seed" + k = fromMaybe err (secKey (runPutS (serialize p))) + err = throw $ DerivationException "Invalid seed" --- | Derive an extended public key from an extended private key. This function --- will preserve the depth, parent, index and chaincode fields of the extended --- private keys. +{- | Derive an extended public key from an extended private key. This function + will preserve the depth, parent, index and chaincode fields of the extended + private keys. +-} deriveXPubKey :: XPrvKey -> XPubKey deriveXPubKey (XPrvKey d p i c k) = XPubKey d p i c (derivePubKey k) --- | Compute a private, soft child key derivation. A private soft derivation --- will allow the equivalent extended public key to derive the public key for --- this child. Given a parent key /m/ and a derivation index /i/, this function --- will compute /m\/i/. --- --- Soft derivations allow for more flexibility such as read-only wallets. --- However, care must be taken not the leak both the parent extended public key --- and one of the extended child private keys as this would compromise the --- extended parent private key. -prvSubKey :: XPrvKey -- ^ extended parent private key - -> KeyIndex -- ^ child derivation index - -> XPrvKey -- ^ extended child private key +{- | Compute a private, soft child key derivation. A private soft derivation + will allow the equivalent extended public key to derive the public key for + this child. Given a parent key /m/ and a derivation index /i/, this function + will compute /m\/i/. + + Soft derivations allow for more flexibility such as read-only wallets. + However, care must be taken not the leak both the parent extended public key + and one of the extended child private keys as this would compromise the + extended parent private key. +-} +prvSubKey :: + -- | extended parent private key + XPrvKey -> + -- | child derivation index + KeyIndex -> + -- | extended child private key + XPrvKey prvSubKey xkey child | child >= 0 && child < 0x80000000 = XPrvKey (xPrvDepth xkey + 1) (xPrvFP xkey) child c k @@ -288,11 +320,16 @@ k = fromMaybe err $ tweakSecKey (xPrvKey xkey) a err = throw $ DerivationException "Invalid prvSubKey derivation" --- | Compute a public, soft child key derivation. Given a parent key /M/ --- and a derivation index /i/, this function will compute /M\/i/. -pubSubKey :: XPubKey -- ^ extended parent public key - -> KeyIndex -- ^ child derivation index - -> XPubKey -- ^ extended child public key +{- | Compute a public, soft child key derivation. Given a parent key /M/ + and a derivation index /i/, this function will compute /M\/i/. +-} +pubSubKey :: + -- | extended parent public key + XPubKey -> + -- | child derivation index + KeyIndex -> + -- | extended child public key + XPubKey pubSubKey xKey child | child >= 0 && child < 0x80000000 = XPubKey (xPubDepth xKey + 1) (xPubFP xKey) child c pK @@ -303,15 +340,20 @@ pK = fromMaybe err $ tweakPubKey (xPubKey xKey) a err = throw $ DerivationException "Invalid pubSubKey derivation" --- | Compute a hard child key derivation. Hard derivations can only be computed --- for private keys. Hard derivations do not allow the parent public key to --- derive the child public keys. However, they are safer as a breach of the --- parent public key and child private keys does not lead to a breach of the --- parent private key. Given a parent key /m/ and a derivation index /i/, this --- function will compute /m\/i'/. -hardSubKey :: XPrvKey -- ^ extended parent private key - -> KeyIndex -- ^ child derivation index - -> XPrvKey -- ^ extended child private key +{- | Compute a hard child key derivation. Hard derivations can only be computed + for private keys. Hard derivations do not allow the parent public key to + derive the child public keys. However, they are safer as a breach of the + parent public key and child private keys does not lead to a breach of the + parent private key. Given a parent key /m/ and a derivation index /i/, this + function will compute /m\/i'/. +-} +hardSubKey :: + -- | extended parent private key + XPrvKey -> + -- | child derivation index + KeyIndex -> + -- | extended child private key + XPrvKey hardSubKey xkey child | child >= 0 && child < 0x80000000 = XPrvKey (xPrvDepth xkey + 1) (xPrvFP xkey) i c k @@ -323,23 +365,27 @@ k = fromMaybe err $ tweakSecKey (xPrvKey xkey) a err = throw $ DerivationException "Invalid hardSubKey derivation" --- | Returns true if the extended private key was derived through a hard --- derivation. +{- | Returns true if the extended private key was derived through a hard + derivation. +-} xPrvIsHard :: XPrvKey -> Bool xPrvIsHard k = testBit (xPrvIndex k) 31 --- | Returns true if the extended public key was derived through a hard --- derivation. +{- | Returns true if the extended public key was derived through a hard + derivation. +-} xPubIsHard :: XPubKey -> Bool xPubIsHard k = testBit (xPubIndex k) 31 --- | Returns the derivation index of this extended private key without the hard --- bit set. +{- | Returns the derivation index of this extended private key without the hard + bit set. +-} xPrvChild :: XPrvKey -> KeyIndex xPrvChild k = clearBit (xPrvIndex k) 31 --- | Returns the derivation index of this extended public key without the hard --- bit set. +{- | Returns the derivation index of this extended public key without the hard + bit set. +-} xPubChild :: XPubKey -> KeyIndex xPubChild k = clearBit (xPubIndex k) 31 @@ -373,8 +419,9 @@ xPubWitnessAddr :: XPubKey -> Address xPubWitnessAddr xkey = pubKeyWitnessAddr (wrapPubKey True (xPubKey xkey)) --- | Compute a backwards-compatible SegWit P2SH-P2WPKH address for an extended --- public key. +{- | Compute a backwards-compatible SegWit P2SH-P2WPKH address for an extended + public key. +-} xPubCompatWitnessAddr :: XPubKey -> Address xPubCompatWitnessAddr xkey = pubKeyCompatWitnessAddr (wrapPubKey True (xPubKey xkey)) @@ -387,13 +434,15 @@ xPubExport :: Network -> XPubKey -> Base58 xPubExport net = encodeBase58Check . runPutS . putXPubKey net --- | Decodes a BIP32 encoded extended private key. This function will fail if --- invalid base 58 characters are detected or if the checksum fails. +{- | Decodes a BIP32 encoded extended private key. This function will fail if + invalid base 58 characters are detected or if the checksum fails. +-} xPrvImport :: Network -> Base58 -> Maybe XPrvKey xPrvImport net = eitherToMaybe . runGetS (getXPrvKey net) <=< decodeBase58Check --- | Decodes a BIP32 encoded extended public key. This function will fail if --- invalid base 58 characters are detected or if the checksum fails. +{- | Decodes a BIP32 encoded extended public key. This function will fail if + invalid base 58 characters are detected or if the checksum fails. +-} xPubImport :: Network -> Base58 -> Maybe XPubKey xPubImport net = eitherToMaybe . runGetS (getXPubKey net) <=< decodeBase58Check @@ -405,8 +454,9 @@ getXPrvKey :: MonadGet m => Network -> m XPrvKey getXPrvKey net = do ver <- getWord32be - unless (ver == getExtSecretPrefix net) $ fail - "Get: Invalid version for extended private key" + unless (ver == getExtSecretPrefix net) $ + fail + "Get: Invalid version for extended private key" deserialize -- | Serialize an extended private key. @@ -419,8 +469,9 @@ getXPubKey :: MonadGet m => Network -> m XPubKey getXPubKey net = do ver <- getWord32be - unless (ver == getExtPubKeyPrefix net) $ fail - "Get: Invalid version for extended public key" + unless (ver == getExtPubKeyPrefix net) $ + fail + "Get: Invalid version for extended public key" deserialize -- | Serialize an extended public key. @@ -431,18 +482,21 @@ {- Derivation helpers -} --- | Cyclic list of all private soft child key derivations of a parent key --- starting from an offset index. +{- | Cyclic list of all private soft child key derivations of a parent key + starting from an offset index. +-} prvSubKeys :: XPrvKey -> KeyIndex -> [(XPrvKey, KeyIndex)] prvSubKeys k = map (\i -> (prvSubKey k i, i)) . cycleIndex --- | Cyclic list of all public soft child key derivations of a parent key --- starting from an offset index. +{- | Cyclic list of all public soft child key derivations of a parent key + starting from an offset index. +-} pubSubKeys :: XPubKey -> KeyIndex -> [(XPubKey, KeyIndex)] pubSubKeys k = map (\i -> (pubSubKey k i, i)) . cycleIndex --- | Cyclic list of all hard child key derivations of a parent key starting --- from an offset index. +{- | Cyclic list of all hard child key derivations of a parent key starting + from an offset index. +-} hardSubKeys :: XPrvKey -> KeyIndex -> [(XPrvKey, KeyIndex)] hardSubKeys k = map (\i -> (hardSubKey k i, i)) . cycleIndex @@ -460,52 +514,61 @@ where key = pubSubKey k i --- | Derive a backwards-compatible SegWit P2SH-P2WPKH address from an extended --- public key and an index. +{- | Derive a backwards-compatible SegWit P2SH-P2WPKH address from an extended + public key and an index. +-} deriveCompatWitnessAddr :: XPubKey -> KeyIndex -> (Address, PubKey) deriveCompatWitnessAddr k i = (xPubCompatWitnessAddr key, xPubKey key) where key = pubSubKey k i --- | Cyclic list of all addresses derived from a public key starting from an --- offset index. +{- | Cyclic list of all addresses derived from a public key starting from an + offset index. +-} deriveAddrs :: XPubKey -> KeyIndex -> [(Address, PubKey, KeyIndex)] deriveAddrs k = map f . cycleIndex where f i = let (a, key) = deriveAddr k i in (a, key, i) --- | Cyclic list of all SegWit P2WPKH addresses derived from a public key --- starting from an offset index. +{- | Cyclic list of all SegWit P2WPKH addresses derived from a public key + starting from an offset index. +-} deriveWitnessAddrs :: XPubKey -> KeyIndex -> [(Address, PubKey, KeyIndex)] deriveWitnessAddrs k = map f . cycleIndex where f i = let (a, key) = deriveWitnessAddr k i in (a, key, i) --- | Cyclic list of all backwards-compatible SegWit P2SH-P2WPKH addresses --- derived from a public key starting from an offset index. +{- | Cyclic list of all backwards-compatible SegWit P2SH-P2WPKH addresses + derived from a public key starting from an offset index. +-} deriveCompatWitnessAddrs :: XPubKey -> KeyIndex -> [(Address, PubKey, KeyIndex)] deriveCompatWitnessAddrs k = map f . cycleIndex where f i = let (a, key) = deriveCompatWitnessAddr k i in (a, key, i) --- | Derive a multisig address from a list of public keys, the number of --- required signatures /m/ and a derivation index. The derivation type is a --- public, soft derivation. +{- | Derive a multisig address from a list of public keys, the number of + required signatures /m/ and a derivation index. The derivation type is a + public, soft derivation. +-} deriveMSAddr :: [XPubKey] -> Int -> KeyIndex -> (Address, RedeemScript) deriveMSAddr keys m i = (payToScriptAddress rdm, rdm) where rdm = sortMulSig $ PayMulSig k m k = map (wrapPubKey True . xPubKey . flip pubSubKey i) keys --- | Cyclic list of all multisig addresses derived from a list of public keys, --- a number of required signatures /m/ and starting from an offset index. The --- derivation type is a public, soft derivation. -deriveMSAddrs :: [XPubKey] -> Int -> KeyIndex - -> [(Address, RedeemScript, KeyIndex)] +{- | Cyclic list of all multisig addresses derived from a list of public keys, + a number of required signatures /m/ and starting from an offset index. The + derivation type is a public, soft derivation. +-} +deriveMSAddrs :: + [XPubKey] -> + Int -> + KeyIndex -> + [(Address, RedeemScript, KeyIndex)] deriveMSAddrs keys m = map f . cycleIndex where f i = @@ -515,21 +578,23 @@ -- | Helper function to go through derivation indices. cycleIndex :: KeyIndex -> [KeyIndex] cycleIndex i - | i == 0 = cycle [0..0x7fffffff] - | i < 0x80000000 = cycle $ [i..0x7fffffff] ++ [0..(i-1)] - | otherwise = error $ "cycleIndex: invalid index " ++ show i + | i == 0 = cycle [0 .. 0x7fffffff] + | i < 0x80000000 = cycle $ [i .. 0x7fffffff] ++ [0 .. (i - 1)] + | otherwise = error $ "cycleIndex: invalid index " ++ show i {- Derivation Paths -} --- | Phantom type signaling a hardened derivation path that can only be computed --- from private extended key. +{- | Phantom type signaling a hardened derivation path that can only be computed + from private extended key. +-} data HardDeriv deriving (Generic, NFData) -- | Phantom type signaling no knowledge about derivation path: can be hardened or not. data AnyDeriv deriving (Generic, NFData) --- | Phantom type signaling derivation path including only non-hardened paths --- that can be computed from an extended public key. +{- | Phantom type signaling derivation path including only non-hardened paths + that can be computed from an extended public key. +-} data SoftDeriv deriving (Generic, NFData) -- | Hardened derivation path. Can be computed from extended private key only. @@ -543,43 +608,46 @@ -- | Helper class to perform validations on a hardened derivation path. class HardOrAny a + instance HardOrAny HardDeriv instance HardOrAny AnyDeriv -- | Helper class to perform validations on a non-hardened derivation path. class AnyOrSoft a + instance AnyOrSoft AnyDeriv instance AnyOrSoft SoftDeriv --- | Data type representing a derivation path. Two constructors are provided --- for specifying soft or hard derivations. The path /\/0\/1'\/2/ for example can be --- expressed as @'Deriv' :\/ 0 :| 1 :\/ 2@. The 'HardOrAny' and 'AnyOrSoft' type --- classes are used to constrain the valid values for the phantom type /t/. If --- you mix hard '(:|)' and soft '(:\/)' paths, the only valid type for /t/ is 'AnyDeriv'. --- Otherwise, /t/ can be 'HardDeriv' if you only have hard derivation or 'SoftDeriv' --- if you only have soft derivations. --- --- Using this type is as easy as writing the required derivation like in these --- example: --- --- > Deriv :/ 0 :/ 1 :/ 2 :: SoftPath --- > Deriv :| 0 :| 1 :| 2 :: HardPath --- > Deriv :| 0 :/ 1 :/ 2 :: DerivPath +{- | Data type representing a derivation path. Two constructors are provided + for specifying soft or hard derivations. The path /\/0\/1'\/2/ for example can be + expressed as @'Deriv' :\/ 0 :| 1 :\/ 2@. The 'HardOrAny' and 'AnyOrSoft' type + classes are used to constrain the valid values for the phantom type /t/. If + you mix hard '(:|)' and soft '(:\/)' paths, the only valid type for /t/ is 'AnyDeriv'. + Otherwise, /t/ can be 'HardDeriv' if you only have hard derivation or 'SoftDeriv' + if you only have soft derivations. + + Using this type is as easy as writing the required derivation like in these + example: + + > Deriv :/ 0 :/ 1 :/ 2 :: SoftPath + > Deriv :| 0 :| 1 :| 2 :: HardPath + > Deriv :| 0 :/ 1 :/ 2 :: DerivPath +-} data DerivPathI t where - (:|) :: HardOrAny t => !(DerivPathI t) -> !KeyIndex -> DerivPathI t - (:/) :: AnyOrSoft t => !(DerivPathI t) -> !KeyIndex -> DerivPathI t + (:|) :: HardOrAny t => !(DerivPathI t) -> !KeyIndex -> DerivPathI t + (:/) :: AnyOrSoft t => !(DerivPathI t) -> !KeyIndex -> DerivPathI t Deriv :: DerivPathI t instance NFData (DerivPathI t) where rnf (a :| b) = rnf a `seq` rnf b rnf (a :/ b) = rnf a `seq` rnf b - rnf Deriv = () + rnf Deriv = () instance Eq (DerivPathI t) where (nextA :| iA) == (nextB :| iB) = iA == iB && nextA == nextB (nextA :/ iA) == (nextB :/ iB) = iA == iB && nextA == nextB - Deriv == Deriv = True - _ == _ = False + Deriv == Deriv = True + _ == _ = False instance Ord (DerivPathI t) where -- Same hardness on each side @@ -587,16 +655,14 @@ if nextA == nextB then iA `compare` iB else nextA `compare` nextB (nextA :/ iA) `compare` (nextB :/ iB) = if nextA == nextB then iA `compare` iB else nextA `compare` nextB - -- Different hardness: hard paths are LT soft paths (nextA :/ _iA) `compare` (nextB :| _iB) = if nextA == nextB then LT else nextA `compare` nextB (nextA :| _iA) `compare` (nextB :/ _iB) = if nextA == nextB then GT else nextA `compare` nextB - - Deriv `compare` Deriv = EQ - Deriv `compare` _ = LT - _ `compare` Deriv = GT + Deriv `compare` Deriv = EQ + Deriv `compare` _ = LT + _ `compare` Deriv = GT instance Serial DerivPath where deserialize = listToPath <$> getList getWord32be @@ -613,11 +679,11 @@ instance Serial HardPath where deserialize = maybe - (fail "Could not decode hard path") - return . - toHard . - listToPath =<< - getList getWord32be + (fail "Could not decode hard path") + return + . toHard + . listToPath + =<< getList getWord32be serialize = putList putWord32be . pathToList instance Serialize HardPath where @@ -631,11 +697,11 @@ instance Serial SoftPath where deserialize = maybe - (fail "Could not decode soft path") - return . - toSoft . - listToPath =<< - getList getWord32be + (fail "Could not decode soft path") + return + . toSoft + . listToPath + =<< getList getWord32be serialize = putList putWord32be . pathToList instance Serialize SoftPath where @@ -653,51 +719,54 @@ where go (next :| i) = setBit i 31 : go next go (next :/ i) = i : go next - go _ = [] + go _ = [] -- | Convert a list of derivation indices to a derivation path. listToPath :: [KeyIndex] -> DerivPath listToPath = go . reverse where - go (i:is) + go (i : is) | testBit i 31 = go is :| clearBit i 31 - | otherwise = go is :/ i + | otherwise = go is :/ i go [] = Deriv -- | Convert a derivation path to a human-readable string. pathToStr :: DerivPathI t -> String pathToStr p = case p of - next :| i -> concat [ pathToStr next, "/", show i, "'" ] - next :/ i -> concat [ pathToStr next, "/", show i ] - Deriv -> "" + next :| i -> concat [pathToStr next, "/", show i, "'"] + next :/ i -> concat [pathToStr next, "/", show i] + Deriv -> "" --- | Turn a derivation path into a hard derivation path. Will fail if the path --- contains soft derivations. +{- | Turn a derivation path into a hard derivation path. Will fail if the path + contains soft derivations. +-} toHard :: DerivPathI t -> Maybe HardPath toHard p = case p of next :| i -> (:| i) <$> toHard next - Deriv -> Just Deriv - _ -> Nothing + Deriv -> Just Deriv + _ -> Nothing --- | Turn a derivation path into a soft derivation path. Will fail if the path --- has hard derivations. +{- | Turn a derivation path into a soft derivation path. Will fail if the path + has hard derivations. +-} toSoft :: DerivPathI t -> Maybe SoftPath toSoft p = case p of next :/ i -> (:/ i) <$> toSoft next - Deriv -> Just Deriv - _ -> Nothing + Deriv -> Just Deriv + _ -> Nothing -- | Make a derivation path generic. toGeneric :: DerivPathI t -> DerivPath toGeneric p = case p of next :/ i -> toGeneric next :/ i next :| i -> toGeneric next :| i - Deriv -> Deriv + Deriv -> Deriv --- | Append two derivation paths together. The result will be a mixed --- derivation path. +{- | Append two derivation paths together. The result will be a mixed + derivation path. +-} (++/) :: DerivPathI t1 -> DerivPathI t2 -> DerivPath (++/) p1 p2 = go id (toGeneric p2) $ toGeneric p1 @@ -705,7 +774,7 @@ go f p = case p of next :/ i -> go (f . (:/ i)) $ toGeneric next next :| i -> go (f . (:| i)) $ toGeneric next - _ -> f + _ -> f -- | Derive a private key from a derivation path derivePath :: DerivPathI t -> XPrvKey -> XPrvKey @@ -715,7 +784,7 @@ go f p = case p of next :| i -> go (f . flip hardSubKey i) next next :/ i -> go (f . flip prvSubKey i) next - _ -> f + _ -> f -- | Derive a public key from a soft derivation path derivePubPath :: SoftPath -> XPubKey -> XPubKey @@ -724,11 +793,12 @@ -- Build the full derivation function starting from the end go f p = case p of next :/ i -> go (f . flip pubSubKey i) next - _ -> f + _ -> f instance Show DerivPath where - showsPrec d p = showParen (d > 10) $ - showString "DerivPath " . shows (pathToStr p) + showsPrec d p = + showParen (d > 10) $ + showString "DerivPath " . shows (pathToStr p) instance Read DerivPath where readPrec = parens $ do @@ -737,8 +807,9 @@ maybe pfail return $ getParsedPath <$> parsePath str instance Show HardPath where - showsPrec d p = showParen (d > 10) $ - showString "HardPath " . shows (pathToStr p) + showsPrec d p = + showParen (d > 10) $ + showString "HardPath " . shows (pathToStr p) instance Read HardPath where readPrec = parens $ do @@ -747,8 +818,9 @@ maybe pfail return $ parseHard str instance Show SoftPath where - showsPrec d p = showParen (d > 10) $ - showString "SoftPath " . shows (pathToStr p) + showsPrec d p = + showParen (d > 10) $ + showString "SoftPath " . shows (pathToStr p) instance Read SoftPath where readPrec = parens $ do @@ -783,51 +855,53 @@ instance FromJSON ParsedPath where parseJSON = withText "ParsedPath" $ \str -> case parsePath $ cs str of Just p -> return p - _ -> mzero + _ -> mzero instance FromJSON DerivPath where parseJSON = withText "DerivPath" $ \str -> case parsePath $ cs str of Just p -> return $ getParsedPath p - _ -> mzero + _ -> mzero instance FromJSON HardPath where parseJSON = withText "HardPath" $ \str -> case parseHard $ cs str of Just p -> return p - _ -> mzero + _ -> mzero instance FromJSON SoftPath where parseJSON = withText "SoftPath" $ \str -> case parseSoft $ cs str of Just p -> return p - _ -> mzero + _ -> mzero instance ToJSON (DerivPathI t) where toJSON = A.String . cs . pathToStr toEncoding = text . cs . pathToStr instance ToJSON ParsedPath where - toJSON (ParsedPrv p) = A.String . cs . ("m" ++) . pathToStr $ p - toJSON (ParsedPub p) = A.String . cs . ("M" ++) . pathToStr $ p + toJSON (ParsedPrv p) = A.String . cs . ("m" ++) . pathToStr $ p + toJSON (ParsedPub p) = A.String . cs . ("M" ++) . pathToStr $ p toJSON (ParsedEmpty p) = A.String . cs . ("" ++) . pathToStr $ p - toEncoding (ParsedPrv p) = text . cs . ("m" ++) . pathToStr $ p - toEncoding (ParsedPub p) = text . cs . ("M" ++) . pathToStr $ p + toEncoding (ParsedPrv p) = text . cs . ("m" ++) . pathToStr $ p + toEncoding (ParsedPub p) = text . cs . ("M" ++) . pathToStr $ p toEncoding (ParsedEmpty p) = text . cs . ("" ++) . pathToStr $ p {- Parsing derivation paths of the form m/1/2'/3 or M/1/2'/3 -} --- | Type for parsing derivation paths of the form /m\/1\/2'\/3/ or --- /M\/1\/2'\/3/. -data ParsedPath = ParsedPrv { getParsedPath :: !DerivPath } - | ParsedPub { getParsedPath :: !DerivPath } - | ParsedEmpty { getParsedPath :: !DerivPath } - deriving (Eq, Generic, NFData) +{- | Type for parsing derivation paths of the form /m\/1\/2'\/3/ or + /M\/1\/2'\/3/. +-} +data ParsedPath + = ParsedPrv {getParsedPath :: !DerivPath} + | ParsedPub {getParsedPath :: !DerivPath} + | ParsedEmpty {getParsedPath :: !DerivPath} + deriving (Eq, Generic, NFData) instance Show ParsedPath where showsPrec d p = showParen (d > 10) $ showString "ParsedPath " . shows f where f = case p of - ParsedPrv d' -> "m" <> pathToStr d' - ParsedPub d' -> "M" <> pathToStr d' + ParsedPrv d' -> "m" <> pathToStr d' + ParsedPub d' -> "M" <> pathToStr d' ParsedEmpty d' -> pathToStr d' instance Read ParsedPath where @@ -836,16 +910,17 @@ R.String str <- lexP maybe pfail return $ parsePath str --- | Parse derivation path string for extended key. --- Forms: /m\/0'\/2/, /M\/2\/3\/4/. +{- | Parse derivation path string for extended key. + Forms: /m\/0'\/2/, /M\/2\/3\/4/. +-} parsePath :: String -> Maybe ParsedPath parsePath str = do res <- concatBip32Segments <$> mapM parseBip32PathIndex xs case x of "m" -> Just $ ParsedPrv res "M" -> Just $ ParsedPub res - "" -> Just $ ParsedEmpty res - _ -> Nothing + "" -> Just $ ParsedEmpty res + _ -> Nothing where (x : xs) = splitOn "/" str @@ -854,27 +929,30 @@ concatBip32Segments = foldl' appendBip32Segment Deriv -- | Append an extra derivation path index element into an existing path. -appendBip32Segment :: DerivPath -> Bip32PathIndex -> DerivPath +appendBip32Segment :: DerivPath -> Bip32PathIndex -> DerivPath appendBip32Segment d (Bip32SoftIndex i) = d :/ i appendBip32Segment d (Bip32HardIndex i) = d :| i -- | Parse a BIP32 derivation path index element from a string. parseBip32PathIndex :: String -> Maybe Bip32PathIndex parseBip32PathIndex segment = case reads segment of - [(i, "" )] -> guard (is31Bit i) >> return (Bip32SoftIndex i) + [(i, "")] -> guard (is31Bit i) >> return (Bip32SoftIndex i) [(i, "'")] -> guard (is31Bit i) >> return (Bip32HardIndex i) - _ -> Nothing + _ -> Nothing -- | Type for BIP32 path index element. -data Bip32PathIndex = Bip32HardIndex KeyIndex - | Bip32SoftIndex KeyIndex - deriving (Eq, Generic, NFData) +data Bip32PathIndex + = Bip32HardIndex KeyIndex + | Bip32SoftIndex KeyIndex + deriving (Eq, Generic, NFData) instance Show Bip32PathIndex where - showsPrec d (Bip32HardIndex i) = showParen (d > 10) $ - showString "Bip32HardIndex " . shows i - showsPrec d (Bip32SoftIndex i) = showParen (d > 10) $ - showString "Bip32SoftIndex " . shows i + showsPrec d (Bip32HardIndex i) = + showParen (d > 10) $ + showString "Bip32HardIndex " . shows i + showsPrec d (Bip32SoftIndex i) = + showParen (d > 10) $ + showString "Bip32SoftIndex " . shows i instance Read Bip32PathIndex where readPrec = h <|> s @@ -906,25 +984,30 @@ -- | Data type representing a private or public key with its respective network. data XKey - = XPrv { getXKeyPrv :: !XPrvKey - , getXKeyNet :: !Network } - | XPub { getXKeyPub :: !XPubKey - , getXKeyNet :: !Network } + = XPrv + { getXKeyPrv :: !XPrvKey + , getXKeyNet :: !Network + } + | XPub + { getXKeyPub :: !XPubKey + , getXKeyNet :: !Network + } deriving (Eq, Show, Generic, NFData) --- | Apply a parsed path to an extended key to derive the new key defined in the --- path. If the path starts with /m/, a private key will be returned and if the --- path starts with /M/, a public key will be returned. Private derivations on a --- public key, and public derivations with a hard segment, return an error --- value. +{- | Apply a parsed path to an extended key to derive the new key defined in the + path. If the path starts with /m/, a private key will be returned and if the + path starts with /M/, a public key will be returned. Private derivations on a + public key, and public derivations with a hard segment, return an error + value. +-} applyPath :: ParsedPath -> XKey -> Either String XKey applyPath path key = case (path, key) of (ParsedPrv _, XPrv k n) -> return $ XPrv (derivPrvF k) n - (ParsedPrv _, XPub {}) -> Left "applyPath: Invalid public key" + (ParsedPrv _, XPub{}) -> Left "applyPath: Invalid public key" (ParsedPub _, XPrv k n) -> return $ XPub (deriveXPubKey (derivPrvF k)) n (ParsedPub _, XPub k n) -> derivPubFE >>= \f -> return $ XPub (f k) n - -- For empty parsed paths, we take a hint from the provided key + -- For empty parsed paths, we take a hint from the provided key (ParsedEmpty _, XPrv k n) -> return $ XPrv (derivPrvF k) n (ParsedEmpty _, XPub k n) -> derivPubFE >>= \f -> return $ XPub (f k) n where @@ -935,13 +1018,13 @@ case p of next :| i -> goPrv (f . flip hardSubKey i) next next :/ i -> goPrv (f . flip prvSubKey i) next - Deriv -> f + Deriv -> f -- Build the full public derivation function starting from the end goPubE f p = case p of next :/ i -> goPubE (f . flip pubSubKey i) next - Deriv -> Right f - _ -> Left "applyPath: Invalid hard derivation" + Deriv -> Right f + _ -> Left "applyPath: Invalid hard derivation" {- Helpers for derivation paths and addresses -} @@ -949,32 +1032,35 @@ derivePathAddr :: XPubKey -> SoftPath -> KeyIndex -> (Address, PubKey) derivePathAddr key path = deriveAddr (derivePubPath path key) --- | Cyclic list of all addresses derived from a given parent path and starting --- from the given offset index. +{- | Cyclic list of all addresses derived from a given parent path and starting + from the given offset index. +-} derivePathAddrs :: - XPubKey -> SoftPath -> KeyIndex -> [(Address, PubKey, KeyIndex)] + XPubKey -> SoftPath -> KeyIndex -> [(Address, PubKey, KeyIndex)] derivePathAddrs key path = deriveAddrs (derivePubPath path key) --- | Derive a multisig address from a given parent path. The number of required --- signatures (m in m of n) is also needed. +{- | Derive a multisig address from a given parent path. The number of required + signatures (m in m of n) is also needed. +-} derivePathMSAddr :: - [XPubKey] - -> SoftPath - -> Int - -> KeyIndex - -> (Address, RedeemScript) + [XPubKey] -> + SoftPath -> + Int -> + KeyIndex -> + (Address, RedeemScript) derivePathMSAddr keys path = deriveMSAddr $ map (derivePubPath path) keys --- | Cyclic list of all multisig addresses derived from a given parent path and --- starting from the given offset index. The number of required signatures --- (m in m of n) is also needed. +{- | Cyclic list of all multisig addresses derived from a given parent path and + starting from the given offset index. The number of required signatures + (m in m of n) is also needed. +-} derivePathMSAddrs :: - [XPubKey] - -> SoftPath - -> Int - -> KeyIndex - -> [(Address, RedeemScript, KeyIndex)] + [XPubKey] -> + SoftPath -> + Int -> + KeyIndex -> + [(Address, RedeemScript, KeyIndex)] derivePathMSAddrs keys path = deriveMSAddrs $ map (derivePubPath path) keys @@ -987,7 +1073,7 @@ unless (pad == 0x00) $ fail "Private key must be padded with 0x00" bs <- getByteString 32 case runGetS S.get bs of - Left e -> fail e + Left e -> fail e Right x -> return x -- | Serialize HDW-specific private key. diff --git a/src/Haskoin/Keys/Extended/Internal.hs b/src/Haskoin/Keys/Extended/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Haskoin/Keys/Extended/Internal.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Haskoin.Keys.Extended.Internal ( + Fingerprint (..), + fingerprintToText, + textToFingerprint, +) where + +import Control.DeepSeq (NFData) +import Control.Monad ((>=>)) +import Data.Aeson ( + FromJSON, + ToJSON, + parseJSON, + toJSON, + withText, + ) +import Data.Binary (Binary (..)) +import Data.Bytes.Get (getWord32be) +import Data.Bytes.Put (putWord32be) +import Data.Bytes.Serial (Serial (..)) +import Data.Either (fromRight) +import Data.Hashable (Hashable) +import Data.Maybe (fromMaybe) +import Data.Serialize (Serialize (..)) +import qualified Data.Serialize as S +import Data.String (IsString (..)) +import Data.Text (Text) +import qualified Data.Text as Text +import Data.Typeable (Typeable) +import Data.Word (Word32) +import GHC.Generics (Generic) +import Haskoin.Util (decodeHex, encodeHex) +import Text.Read (readEither, readPrec) + +-- | Fingerprint of parent +newtype Fingerprint = Fingerprint {unFingerprint :: Word32} + deriving (Eq, Ord, Hashable, Typeable, Generic, NFData) + +fingerprintToText :: Fingerprint -> Text +fingerprintToText = encodeHex . S.encode + +textToFingerprint :: Text -> Either String Fingerprint +textToFingerprint = maybe (Left "Fingerprint: invalid hex") Right . decodeHex >=> S.decode + +instance Show Fingerprint where + show = show . Text.unpack . encodeHex . S.encode + +instance Read Fingerprint where + readPrec = + readPrec + >>= maybe (fail "Fingerprint: invalid hex") pure . decodeHex + >>= either (fail . ("Fingerprint: " <>)) pure . S.decode + +instance IsString Fingerprint where + fromString = + fromRight decodeError + . S.decode + . fromMaybe hexError + . decodeHex + . Text.pack + where + decodeError = error "Fingerprint literal: Unable to decode" + hexError = error "Fingerprint literal: Invalid hex" + +instance Serial Fingerprint where + serialize = putWord32be . unFingerprint + deserialize = Fingerprint <$> getWord32be + +instance Binary Fingerprint where + put = serialize + get = deserialize + +instance Serialize Fingerprint where + put = serialize + get = deserialize + +instance FromJSON Fingerprint where + parseJSON = withText "Fingerprint" $ either fail pure . textToFingerprint + +instance ToJSON Fingerprint where + toJSON = toJSON . fingerprintToText diff --git a/src/Haskoin/Keys/Mnemonic.hs b/src/Haskoin/Keys/Mnemonic.hs --- a/src/Haskoin/Keys/Mnemonic.hs +++ b/src/Haskoin/Keys/Mnemonic.hs @@ -1,519 +1,2233 @@ {-# LANGUAGE OverloadedStrings #-} -{-| -Module : Haskoin.Keys.Mnemonic -Copyright : No rights reserved -License : MIT -Maintainer : jprupp@protonmail.ch -Stability : experimental -Portability : POSIX - -Mnemonic keys (BIP-39). Only English dictionary. --} -module Haskoin.Keys.Mnemonic - ( -- * Mnemonic Sentences - Entropy - , Mnemonic - , Passphrase - , Seed - , toMnemonic - , fromMnemonic - , mnemonicToSeed - ) where - -import Control.Monad (when) -import Crypto.Hash (SHA256 (..), hashWith) -import Crypto.KDF.PBKDF2 (Parameters (..), fastPBKDF2_SHA512) -import Data.Bits (shiftL, shiftR) -import qualified Data.ByteArray as BA -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import Data.List -import qualified Data.Map.Strict as M -import Data.Maybe -import Data.String.Conversions (cs) -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.Encoding as E -import Data.Vector (Vector, (!)) -import qualified Data.Vector as V -import Haskoin.Util - --- | Random data used to create a mnemonic sentence. Use a good entropy source. --- You will get your coins stolen if you don't. You have been warned. -type Entropy = ByteString - --- | Human-readable mnemonic sentence. -type Mnemonic = Text - --- | Optional passphrase for mnemnoic sentence. -type Passphrase = Text - --- | Seed for a private key from a mnemonic sentence. -type Seed = ByteString - --- | Mnemonic key checksum. -type Checksum = ByteString - --- | Paremeters for PBKDF2 function. -pbkdfParams :: Parameters -pbkdfParams = Parameters {iterCounts = 2048, outputLength = 64} - --- | Provide intial 'Entropy' as a 'ByteString' of length multiple of 4 bytes. --- Output a 'Mnemonic' sentence. -toMnemonic :: Entropy -> Either String Mnemonic -toMnemonic ent = do - when (BS.null ent) $ - Left "toMnemonic: entropy can not be empty" - when (remainder /= 0) $ - Left "toMnemonic: entropy must be multiples of 4 bytes" - when (cs_len > 16) $ - Left "toMnemonic: maximum entropy is 64 bytes (512 bits)" - return ms - where - (cs_len, remainder) = BS.length ent `quotRem` 4 - c = calcCS cs_len ent - indices = bsToIndices $ ent `BS.append` c - ms = T.unwords $ map (wl!) indices - --- | Revert 'toMnemonic'. Do not use this to generate a 'Seed'. Instead use --- 'mnemonicToSeed'. This outputs the original 'Entropy' used to generate a --- 'Mnemonic' sentence. -fromMnemonic :: Mnemonic -> Either String Entropy -fromMnemonic ms = do - when (T.null ms) $ - Left "fromMnemonic: empty mnemonic" - when (word_count > 48) $ - Left $ "fromMnemonic: too many words: " ++ show word_count - when (word_count `mod` 3 /= 0) $ - Left $ "fromMnemonic: wrong number of words:" ++ show word_count - ms_bs <- indicesToBS =<< getIndices ms_words - let (ms_ent, ms_cs) = BS.splitAt (ent_len * 4) ms_bs - ms_cs_num = numCS cs_len ms_cs - ent_cs_num = numCS cs_len $ calcCS cs_len ms_ent - when (ent_cs_num /= ms_cs_num) $ - Left $ "fromMnemonic: checksum failed: " ++ sh ent_cs_num ms_cs_num - return ms_ent - where - ms_words = T.words ms - word_count = length ms_words - (ent_len, cs_len) = (word_count * 11) `quotRem` 32 - sh cs_a cs_b = show cs_a ++ " /= " ++ show cs_b - --- | Compute 'Checksum'. -calcCS :: Int -> Entropy -> Checksum -calcCS len = getBits len . BA.convert . hashWith SHA256 - -numCS :: Int -> Entropy -> Integer -numCS len = - shiftCS . bsToInteger - where - shiftCS = case 8 - len `mod` 8 of - 8 -> id - x -> flip shiftR x - --- | Turn an arbitrary sequence of characters into a 512-bit 'Seed'. Use --- 'mnemonicToSeed' to get a seed from a 'Mnemonic' sentence. Warning: Does not --- perform NFKD normalization. -anyToSeed :: Passphrase -> Mnemonic -> Seed -anyToSeed pf ms = - fastPBKDF2_SHA512 - pbkdfParams - (E.encodeUtf8 ms) - ("mnemonic" `mappend` E.encodeUtf8 pf) - --- | Get a 512-bit 'Seed' from a 'Mnemonic' sentence. Will validate checksum. --- 'Passphrase' can be used to protect the 'Mnemonic'. Use an empty string as --- 'Passphrase' if none is required. -mnemonicToSeed :: Passphrase -> Mnemonic -> Either String Seed -mnemonicToSeed pf ms = do - ent <- fromMnemonic ms - mnm <- toMnemonic ent - return $ anyToSeed pf mnm - --- | Get indices of words in word list. -getIndices :: [Text] -> Either String [Int] -getIndices ws - | null n = return $ catMaybes i - | otherwise = Left $ "getIndices: words not found: " ++ cs w - where - i = map (`M.lookup` wl') ws - n = elemIndices Nothing i - w = T.unwords $ map (ws !!) n - --- | Turn a list of 11-bit numbers into a 'ByteString' -indicesToBS :: [Int] -> Either String ByteString -indicesToBS is = do - when lrg $ Left "indicesToBS: index larger or equal than 2048" - return . pad . integerToBS $ foldl' f 0 is `shiftL` shift_width - where - lrg = isJust $ find (>= 2048) is - (q, r) = (length is * 11) `quotRem` 8 - shift_width = - if r == 0 - then 0 - else 8 - r - bl = - if r == 0 - then q - else q + 1 -- length of resulting ByteString - pad bs = BS.append (BS.replicate (bl - BS.length bs) 0x00) bs - f acc x = (acc `shiftL` 11) + fromIntegral x - --- | Turn a 'ByteString' into a list of 11-bit numbers. -bsToIndices :: ByteString -> [Int] -bsToIndices bs = - reverse . go q $ bsToInteger bs `shiftR` r - where - (q, r) = (BS.length bs * 8) `quotRem` 11 - go 0 _ = [] - go n i = fromIntegral (i `mod` 2048) : go (n - 1) (i `shiftR` 11) - -wl' :: M.Map Text Int -wl' = V.ifoldr' (\i w m -> M.insert w i m) M.empty wl - --- | Standard English dictionary from BIP-39 specification. -wl :: Vector Text -wl = V.fromListN 2048 - [ "abandon", "ability", "able", "about", "above", "absent" - , "absorb", "abstract", "absurd", "abuse", "access", "accident" - , "account", "accuse", "achieve", "acid", "acoustic", "acquire" - , "across", "act", "action", "actor", "actress", "actual" - , "adapt", "add", "addict", "address", "adjust", "admit" - , "adult", "advance", "advice", "aerobic", "affair", "afford" - , "afraid", "again", "age", "agent", "agree", "ahead" - , "aim", "air", "airport", "aisle", "alarm", "album" - , "alcohol", "alert", "alien", "all", "alley", "allow" - , "almost", "alone", "alpha", "already", "also", "alter" - , "always", "amateur", "amazing", "among", "amount", "amused" - , "analyst", "anchor", "ancient", "anger", "angle", "angry" - , "animal", "ankle", "announce", "annual", "another", "answer" - , "antenna", "antique", "anxiety", "any", "apart", "apology" - , "appear", "apple", "approve", "april", "arch", "arctic" - , "area", "arena", "argue", "arm", "armed", "armor" - , "army", "around", "arrange", "arrest", "arrive", "arrow" - , "art", "artefact", "artist", "artwork", "ask", "aspect" - , "assault", "asset", "assist", "assume", "asthma", "athlete" - , "atom", "attack", "attend", "attitude", "attract", "auction" - , "audit", "august", "aunt", "author", "auto", "autumn" - , "average", "avocado", "avoid", "awake", "aware", "away" - , "awesome", "awful", "awkward", "axis", "baby", "bachelor" - , "bacon", "badge", "bag", "balance", "balcony", "ball" - , "bamboo", "banana", "banner", "bar", "barely", "bargain" - , "barrel", "base", "basic", "basket", "battle", "beach" - , "bean", "beauty", "because", "become", "beef", "before" - , "begin", "behave", "behind", "believe", "below", "belt" - , "bench", "benefit", "best", "betray", "better", "between" - , "beyond", "bicycle", "bid", "bike", "bind", "biology" - , "bird", "birth", "bitter", "black", "blade", "blame" - , "blanket", "blast", "bleak", "bless", "blind", "blood" - , "blossom", "blouse", "blue", "blur", "blush", "board" - , "boat", "body", "boil", "bomb", "bone", "bonus" - , "book", "boost", "border", "boring", "borrow", "boss" - , "bottom", "bounce", "box", "boy", "bracket", "brain" - , "brand", "brass", "brave", "bread", "breeze", "brick" - , "bridge", "brief", "bright", "bring", "brisk", "broccoli" - , "broken", "bronze", "broom", "brother", "brown", "brush" - , "bubble", "buddy", "budget", "buffalo", "build", "bulb" - , "bulk", "bullet", "bundle", "bunker", "burden", "burger" - , "burst", "bus", "business", "busy", "butter", "buyer" - , "buzz", "cabbage", "cabin", "cable", "cactus", "cage" - , "cake", "call", "calm", "camera", "camp", "can" - , "canal", "cancel", "candy", "cannon", "canoe", "canvas" - , "canyon", "capable", "capital", "captain", "car", "carbon" - , "card", "cargo", "carpet", "carry", "cart", "case" - , "cash", "casino", "castle", "casual", "cat", "catalog" - , "catch", "category", "cattle", "caught", "cause", "caution" - , "cave", "ceiling", "celery", "cement", "census", "century" - , "cereal", "certain", "chair", "chalk", "champion", "change" - , "chaos", "chapter", "charge", "chase", "chat", "cheap" - , "check", "cheese", "chef", "cherry", "chest", "chicken" - , "chief", "child", "chimney", "choice", "choose", "chronic" - , "chuckle", "chunk", "churn", "cigar", "cinnamon", "circle" - , "citizen", "city", "civil", "claim", "clap", "clarify" - , "claw", "clay", "clean", "clerk", "clever", "click" - , "client", "cliff", "climb", "clinic", "clip", "clock" - , "clog", "close", "cloth", "cloud", "clown", "club" - , "clump", "cluster", "clutch", "coach", "coast", "coconut" - , "code", "coffee", "coil", "coin", "collect", "color" - , "column", "combine", "come", "comfort", "comic", "common" - , "company", "concert", "conduct", "confirm", "congress", "connect" - , "consider", "control", "convince", "cook", "cool", "copper" - , "copy", "coral", "core", "corn", "correct", "cost" - , "cotton", "couch", "country", "couple", "course", "cousin" - , "cover", "coyote", "crack", "cradle", "craft", "cram" - , "crane", "crash", "crater", "crawl", "crazy", "cream" - , "credit", "creek", "crew", "cricket", "crime", "crisp" - , "critic", "crop", "cross", "crouch", "crowd", "crucial" - , "cruel", "cruise", "crumble", "crunch", "crush", "cry" - , "crystal", "cube", "culture", "cup", "cupboard", "curious" - , "current", "curtain", "curve", "cushion", "custom", "cute" - , "cycle", "dad", "damage", "damp", "dance", "danger" - , "daring", "dash", "daughter", "dawn", "day", "deal" - , "debate", "debris", "decade", "december", "decide", "decline" - , "decorate", "decrease", "deer", "defense", "define", "defy" - , "degree", "delay", "deliver", "demand", "demise", "denial" - , "dentist", "deny", "depart", "depend", "deposit", "depth" - , "deputy", "derive", "describe", "desert", "design", "desk" - , "despair", "destroy", "detail", "detect", "develop", "device" - , "devote", "diagram", "dial", "diamond", "diary", "dice" - , "diesel", "diet", "differ", "digital", "dignity", "dilemma" - , "dinner", "dinosaur", "direct", "dirt", "disagree", "discover" - , "disease", "dish", "dismiss", "disorder", "display", "distance" - , "divert", "divide", "divorce", "dizzy", "doctor", "document" - , "dog", "doll", "dolphin", "domain", "donate", "donkey" - , "donor", "door", "dose", "double", "dove", "draft" - , "dragon", "drama", "drastic", "draw", "dream", "dress" - , "drift", "drill", "drink", "drip", "drive", "drop" - , "drum", "dry", "duck", "dumb", "dune", "during" - , "dust", "dutch", "duty", "dwarf", "dynamic", "eager" - , "eagle", "early", "earn", "earth", "easily", "east" - , "easy", "echo", "ecology", "economy", "edge", "edit" - , "educate", "effort", "egg", "eight", "either", "elbow" - , "elder", "electric", "elegant", "element", "elephant", "elevator" - , "elite", "else", "embark", "embody", "embrace", "emerge" - , "emotion", "employ", "empower", "empty", "enable", "enact" - , "end", "endless", "endorse", "enemy", "energy", "enforce" - , "engage", "engine", "enhance", "enjoy", "enlist", "enough" - , "enrich", "enroll", "ensure", "enter", "entire", "entry" - , "envelope", "episode", "equal", "equip", "era", "erase" - , "erode", "erosion", "error", "erupt", "escape", "essay" - , "essence", "estate", "eternal", "ethics", "evidence", "evil" - , "evoke", "evolve", "exact", "example", "excess", "exchange" - , "excite", "exclude", "excuse", "execute", "exercise", "exhaust" - , "exhibit", "exile", "exist", "exit", "exotic", "expand" - , "expect", "expire", "explain", "expose", "express", "extend" - , "extra", "eye", "eyebrow", "fabric", "face", "faculty" - , "fade", "faint", "faith", "fall", "false", "fame" - , "family", "famous", "fan", "fancy", "fantasy", "farm" - , "fashion", "fat", "fatal", "father", "fatigue", "fault" - , "favorite", "feature", "february", "federal", "fee", "feed" - , "feel", "female", "fence", "festival", "fetch", "fever" - , "few", "fiber", "fiction", "field", "figure", "file" - , "film", "filter", "final", "find", "fine", "finger" - , "finish", "fire", "firm", "first", "fiscal", "fish" - , "fit", "fitness", "fix", "flag", "flame", "flash" - , "flat", "flavor", "flee", "flight", "flip", "float" - , "flock", "floor", "flower", "fluid", "flush", "fly" - , "foam", "focus", "fog", "foil", "fold", "follow" - , "food", "foot", "force", "forest", "forget", "fork" - , "fortune", "forum", "forward", "fossil", "foster", "found" - , "fox", "fragile", "frame", "frequent", "fresh", "friend" - , "fringe", "frog", "front", "frost", "frown", "frozen" - , "fruit", "fuel", "fun", "funny", "furnace", "fury" - , "future", "gadget", "gain", "galaxy", "gallery", "game" - , "gap", "garage", "garbage", "garden", "garlic", "garment" - , "gas", "gasp", "gate", "gather", "gauge", "gaze" - , "general", "genius", "genre", "gentle", "genuine", "gesture" - , "ghost", "giant", "gift", "giggle", "ginger", "giraffe" - , "girl", "give", "glad", "glance", "glare", "glass" - , "glide", "glimpse", "globe", "gloom", "glory", "glove" - , "glow", "glue", "goat", "goddess", "gold", "good" - , "goose", "gorilla", "gospel", "gossip", "govern", "gown" - , "grab", "grace", "grain", "grant", "grape", "grass" - , "gravity", "great", "green", "grid", "grief", "grit" - , "grocery", "group", "grow", "grunt", "guard", "guess" - , "guide", "guilt", "guitar", "gun", "gym", "habit" - , "hair", "half", "hammer", "hamster", "hand", "happy" - , "harbor", "hard", "harsh", "harvest", "hat", "have" - , "hawk", "hazard", "head", "health", "heart", "heavy" - , "hedgehog", "height", "hello", "helmet", "help", "hen" - , "hero", "hidden", "high", "hill", "hint", "hip" - , "hire", "history", "hobby", "hockey", "hold", "hole" - , "holiday", "hollow", "home", "honey", "hood", "hope" - , "horn", "horror", "horse", "hospital", "host", "hotel" - , "hour", "hover", "hub", "huge", "human", "humble" - , "humor", "hundred", "hungry", "hunt", "hurdle", "hurry" - , "hurt", "husband", "hybrid", "ice", "icon", "idea" - , "identify", "idle", "ignore", "ill", "illegal", "illness" - , "image", "imitate", "immense", "immune", "impact", "impose" - , "improve", "impulse", "inch", "include", "income", "increase" - , "index", "indicate", "indoor", "industry", "infant", "inflict" - , "inform", "inhale", "inherit", "initial", "inject", "injury" - , "inmate", "inner", "innocent", "input", "inquiry", "insane" - , "insect", "inside", "inspire", "install", "intact", "interest" - , "into", "invest", "invite", "involve", "iron", "island" - , "isolate", "issue", "item", "ivory", "jacket", "jaguar" - , "jar", "jazz", "jealous", "jeans", "jelly", "jewel" - , "job", "join", "joke", "journey", "joy", "judge" - , "juice", "jump", "jungle", "junior", "junk", "just" - , "kangaroo", "keen", "keep", "ketchup", "key", "kick" - , "kid", "kidney", "kind", "kingdom", "kiss", "kit" - , "kitchen", "kite", "kitten", "kiwi", "knee", "knife" - , "knock", "know", "lab", "label", "labor", "ladder" - , "lady", "lake", "lamp", "language", "laptop", "large" - , "later", "latin", "laugh", "laundry", "lava", "law" - , "lawn", "lawsuit", "layer", "lazy", "leader", "leaf" - , "learn", "leave", "lecture", "left", "leg", "legal" - , "legend", "leisure", "lemon", "lend", "length", "lens" - , "leopard", "lesson", "letter", "level", "liar", "liberty" - , "library", "license", "life", "lift", "light", "like" - , "limb", "limit", "link", "lion", "liquid", "list" - , "little", "live", "lizard", "load", "loan", "lobster" - , "local", "lock", "logic", "lonely", "long", "loop" - , "lottery", "loud", "lounge", "love", "loyal", "lucky" - , "luggage", "lumber", "lunar", "lunch", "luxury", "lyrics" - , "machine", "mad", "magic", "magnet", "maid", "mail" - , "main", "major", "make", "mammal", "man", "manage" - , "mandate", "mango", "mansion", "manual", "maple", "marble" - , "march", "margin", "marine", "market", "marriage", "mask" - , "mass", "master", "match", "material", "math", "matrix" - , "matter", "maximum", "maze", "meadow", "mean", "measure" - , "meat", "mechanic", "medal", "media", "melody", "melt" - , "member", "memory", "mention", "menu", "mercy", "merge" - , "merit", "merry", "mesh", "message", "metal", "method" - , "middle", "midnight", "milk", "million", "mimic", "mind" - , "minimum", "minor", "minute", "miracle", "mirror", "misery" - , "miss", "mistake", "mix", "mixed", "mixture", "mobile" - , "model", "modify", "mom", "moment", "monitor", "monkey" - , "monster", "month", "moon", "moral", "more", "morning" - , "mosquito", "mother", "motion", "motor", "mountain", "mouse" - , "move", "movie", "much", "muffin", "mule", "multiply" - , "muscle", "museum", "mushroom", "music", "must", "mutual" - , "myself", "mystery", "myth", "naive", "name", "napkin" - , "narrow", "nasty", "nation", "nature", "near", "neck" - , "need", "negative", "neglect", "neither", "nephew", "nerve" - , "nest", "net", "network", "neutral", "never", "news" - , "next", "nice", "night", "noble", "noise", "nominee" - , "noodle", "normal", "north", "nose", "notable", "note" - , "nothing", "notice", "novel", "now", "nuclear", "number" - , "nurse", "nut", "oak", "obey", "object", "oblige" - , "obscure", "observe", "obtain", "obvious", "occur", "ocean" - , "october", "odor", "off", "offer", "office", "often" - , "oil", "okay", "old", "olive", "olympic", "omit" - , "once", "one", "onion", "online", "only", "open" - , "opera", "opinion", "oppose", "option", "orange", "orbit" - , "orchard", "order", "ordinary", "organ", "orient", "original" - , "orphan", "ostrich", "other", "outdoor", "outer", "output" - , "outside", "oval", "oven", "over", "own", "owner" - , "oxygen", "oyster", "ozone", "pact", "paddle", "page" - , "pair", "palace", "palm", "panda", "panel", "panic" - , "panther", "paper", "parade", "parent", "park", "parrot" - , "party", "pass", "patch", "path", "patient", "patrol" - , "pattern", "pause", "pave", "payment", "peace", "peanut" - , "pear", "peasant", "pelican", "pen", "penalty", "pencil" - , "people", "pepper", "perfect", "permit", "person", "pet" - , "phone", "photo", "phrase", "physical", "piano", "picnic" - , "picture", "piece", "pig", "pigeon", "pill", "pilot" - , "pink", "pioneer", "pipe", "pistol", "pitch", "pizza" - , "place", "planet", "plastic", "plate", "play", "please" - , "pledge", "pluck", "plug", "plunge", "poem", "poet" - , "point", "polar", "pole", "police", "pond", "pony" - , "pool", "popular", "portion", "position", "possible", "post" - , "potato", "pottery", "poverty", "powder", "power", "practice" - , "praise", "predict", "prefer", "prepare", "present", "pretty" - , "prevent", "price", "pride", "primary", "print", "priority" - , "prison", "private", "prize", "problem", "process", "produce" - , "profit", "program", "project", "promote", "proof", "property" - , "prosper", "protect", "proud", "provide", "public", "pudding" - , "pull", "pulp", "pulse", "pumpkin", "punch", "pupil" - , "puppy", "purchase", "purity", "purpose", "purse", "push" - , "put", "puzzle", "pyramid", "quality", "quantum", "quarter" - , "question", "quick", "quit", "quiz", "quote", "rabbit" - , "raccoon", "race", "rack", "radar", "radio", "rail" - , "rain", "raise", "rally", "ramp", "ranch", "random" - , "range", "rapid", "rare", "rate", "rather", "raven" - , "raw", "razor", "ready", "real", "reason", "rebel" - , "rebuild", "recall", "receive", "recipe", "record", "recycle" - , "reduce", "reflect", "reform", "refuse", "region", "regret" - , "regular", "reject", "relax", "release", "relief", "rely" - , "remain", "remember", "remind", "remove", "render", "renew" - , "rent", "reopen", "repair", "repeat", "replace", "report" - , "require", "rescue", "resemble", "resist", "resource", "response" - , "result", "retire", "retreat", "return", "reunion", "reveal" - , "review", "reward", "rhythm", "rib", "ribbon", "rice" - , "rich", "ride", "ridge", "rifle", "right", "rigid" - , "ring", "riot", "ripple", "risk", "ritual", "rival" - , "river", "road", "roast", "robot", "robust", "rocket" - , "romance", "roof", "rookie", "room", "rose", "rotate" - , "rough", "round", "route", "royal", "rubber", "rude" - , "rug", "rule", "run", "runway", "rural", "sad" - , "saddle", "sadness", "safe", "sail", "salad", "salmon" - , "salon", "salt", "salute", "same", "sample", "sand" - , "satisfy", "satoshi", "sauce", "sausage", "save", "say" - , "scale", "scan", "scare", "scatter", "scene", "scheme" - , "school", "science", "scissors", "scorpion", "scout", "scrap" - , "screen", "script", "scrub", "sea", "search", "season" - , "seat", "second", "secret", "section", "security", "seed" - , "seek", "segment", "select", "sell", "seminar", "senior" - , "sense", "sentence", "series", "service", "session", "settle" - , "setup", "seven", "shadow", "shaft", "shallow", "share" - , "shed", "shell", "sheriff", "shield", "shift", "shine" - , "ship", "shiver", "shock", "shoe", "shoot", "shop" - , "short", "shoulder", "shove", "shrimp", "shrug", "shuffle" - , "shy", "sibling", "sick", "side", "siege", "sight" - , "sign", "silent", "silk", "silly", "silver", "similar" - , "simple", "since", "sing", "siren", "sister", "situate" - , "six", "size", "skate", "sketch", "ski", "skill" - , "skin", "skirt", "skull", "slab", "slam", "sleep" - , "slender", "slice", "slide", "slight", "slim", "slogan" - , "slot", "slow", "slush", "small", "smart", "smile" - , "smoke", "smooth", "snack", "snake", "snap", "sniff" - , "snow", "soap", "soccer", "social", "sock", "soda" - , "soft", "solar", "soldier", "solid", "solution", "solve" - , "someone", "song", "soon", "sorry", "sort", "soul" - , "sound", "soup", "source", "south", "space", "spare" - , "spatial", "spawn", "speak", "special", "speed", "spell" - , "spend", "sphere", "spice", "spider", "spike", "spin" - , "spirit", "split", "spoil", "sponsor", "spoon", "sport" - , "spot", "spray", "spread", "spring", "spy", "square" - , "squeeze", "squirrel", "stable", "stadium", "staff", "stage" - , "stairs", "stamp", "stand", "start", "state", "stay" - , "steak", "steel", "stem", "step", "stereo", "stick" - , "still", "sting", "stock", "stomach", "stone", "stool" - , "story", "stove", "strategy", "street", "strike", "strong" - , "struggle", "student", "stuff", "stumble", "style", "subject" - , "submit", "subway", "success", "such", "sudden", "suffer" - , "sugar", "suggest", "suit", "summer", "sun", "sunny" - , "sunset", "super", "supply", "supreme", "sure", "surface" - , "surge", "surprise", "surround", "survey", "suspect", "sustain" - , "swallow", "swamp", "swap", "swarm", "swear", "sweet" - , "swift", "swim", "swing", "switch", "sword", "symbol" - , "symptom", "syrup", "system", "table", "tackle", "tag" - , "tail", "talent", "talk", "tank", "tape", "target" - , "task", "taste", "tattoo", "taxi", "teach", "team" - , "tell", "ten", "tenant", "tennis", "tent", "term" - , "test", "text", "thank", "that", "theme", "then" - , "theory", "there", "they", "thing", "this", "thought" - , "three", "thrive", "throw", "thumb", "thunder", "ticket" - , "tide", "tiger", "tilt", "timber", "time", "tiny" - , "tip", "tired", "tissue", "title", "toast", "tobacco" - , "today", "toddler", "toe", "together", "toilet", "token" - , "tomato", "tomorrow", "tone", "tongue", "tonight", "tool" - , "tooth", "top", "topic", "topple", "torch", "tornado" - , "tortoise", "toss", "total", "tourist", "toward", "tower" - , "town", "toy", "track", "trade", "traffic", "tragic" - , "train", "transfer", "trap", "trash", "travel", "tray" - , "treat", "tree", "trend", "trial", "tribe", "trick" - , "trigger", "trim", "trip", "trophy", "trouble", "truck" - , "true", "truly", "trumpet", "trust", "truth", "try" - , "tube", "tuition", "tumble", "tuna", "tunnel", "turkey" - , "turn", "turtle", "twelve", "twenty", "twice", "twin" - , "twist", "two", "type", "typical", "ugly", "umbrella" - , "unable", "unaware", "uncle", "uncover", "under", "undo" - , "unfair", "unfold", "unhappy", "uniform", "unique", "unit" - , "universe", "unknown", "unlock", "until", "unusual", "unveil" - , "update", "upgrade", "uphold", "upon", "upper", "upset" - , "urban", "urge", "usage", "use", "used", "useful" - , "useless", "usual", "utility", "vacant", "vacuum", "vague" - , "valid", "valley", "valve", "van", "vanish", "vapor" - , "various", "vast", "vault", "vehicle", "velvet", "vendor" - , "venture", "venue", "verb", "verify", "version", "very" - , "vessel", "veteran", "viable", "vibrant", "vicious", "victory" - , "video", "view", "village", "vintage", "violin", "virtual" - , "virus", "visa", "visit", "visual", "vital", "vivid" - , "vocal", "voice", "void", "volcano", "volume", "vote" - , "voyage", "wage", "wagon", "wait", "walk", "wall" - , "walnut", "want", "warfare", "warm", "warrior", "wash" - , "wasp", "waste", "water", "wave", "way", "wealth" - , "weapon", "wear", "weasel", "weather", "web", "wedding" - , "weekend", "weird", "welcome", "west", "wet", "whale" - , "what", "wheat", "wheel", "when", "where", "whip" - , "whisper", "wide", "width", "wife", "wild", "will" - , "win", "window", "wine", "wing", "wink", "winner" - , "winter", "wire", "wisdom", "wise", "wish", "witness" - , "wolf", "woman", "wonder", "wood", "wool", "word" - , "work", "world", "worry", "worth", "wrap", "wreck" - , "wrestle", "wrist", "write", "wrong", "yard", "year" - , "yellow", "you", "young", "youth", "zebra", "zero" - , "zone", "zoo" - ] + +{- | +Module : Haskoin.Keys.Mnemonic +Copyright : No rights reserved +License : MIT +Maintainer : jprupp@protonmail.ch +Stability : experimental +Portability : POSIX + +Mnemonic keys (BIP-39). Only English dictionary. +-} +module Haskoin.Keys.Mnemonic ( + -- * Mnemonic Sentences + Entropy, + Mnemonic, + Passphrase, + Seed, + toMnemonic, + fromMnemonic, + mnemonicToSeed, +) where + +import Control.Monad (when) +import Crypto.Hash (SHA256 (..), hashWith) +import Crypto.KDF.PBKDF2 (Parameters (..), fastPBKDF2_SHA512) +import Data.Bits (shiftL, shiftR) +import qualified Data.ByteArray as BA +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.List +import qualified Data.Map.Strict as M +import Data.Maybe +import Data.String.Conversions (cs) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as E +import Data.Vector (Vector, (!)) +import qualified Data.Vector as V +import Haskoin.Util + +{- | Random data used to create a mnemonic sentence. Use a good entropy source. + You will get your coins stolen if you don't. You have been warned. +-} +type Entropy = ByteString + +-- | Human-readable mnemonic sentence. +type Mnemonic = Text + +-- | Optional passphrase for mnemnoic sentence. +type Passphrase = Text + +-- | Seed for a private key from a mnemonic sentence. +type Seed = ByteString + +-- | Mnemonic key checksum. +type Checksum = ByteString + +-- | Paremeters for PBKDF2 function. +pbkdfParams :: Parameters +pbkdfParams = Parameters{iterCounts = 2048, outputLength = 64} + +{- | Provide intial 'Entropy' as a 'ByteString' of length multiple of 4 bytes. + Output a 'Mnemonic' sentence. +-} +toMnemonic :: Entropy -> Either String Mnemonic +toMnemonic ent = do + when (BS.null ent) $ + Left "toMnemonic: entropy can not be empty" + when (remainder /= 0) $ + Left "toMnemonic: entropy must be multiples of 4 bytes" + when (cs_len > 16) $ + Left "toMnemonic: maximum entropy is 64 bytes (512 bits)" + return ms + where + (cs_len, remainder) = BS.length ent `quotRem` 4 + c = calcCS cs_len ent + indices = bsToIndices $ ent `BS.append` c + ms = T.unwords $ map (wl !) indices + +{- | Revert 'toMnemonic'. Do not use this to generate a 'Seed'. Instead use + 'mnemonicToSeed'. This outputs the original 'Entropy' used to generate a + 'Mnemonic' sentence. +-} +fromMnemonic :: Mnemonic -> Either String Entropy +fromMnemonic ms = do + when (T.null ms) $ + Left "fromMnemonic: empty mnemonic" + when (word_count > 48) $ + Left $ "fromMnemonic: too many words: " ++ show word_count + when (word_count `mod` 3 /= 0) $ + Left $ "fromMnemonic: wrong number of words:" ++ show word_count + ms_bs <- indicesToBS =<< getIndices ms_words + let (ms_ent, ms_cs) = BS.splitAt (ent_len * 4) ms_bs + ms_cs_num = numCS cs_len ms_cs + ent_cs_num = numCS cs_len $ calcCS cs_len ms_ent + when (ent_cs_num /= ms_cs_num) $ + Left $ "fromMnemonic: checksum failed: " ++ sh ent_cs_num ms_cs_num + return ms_ent + where + ms_words = T.words ms + word_count = length ms_words + (ent_len, cs_len) = (word_count * 11) `quotRem` 32 + sh cs_a cs_b = show cs_a ++ " /= " ++ show cs_b + +-- | Compute 'Checksum'. +calcCS :: Int -> Entropy -> Checksum +calcCS len = getBits len . BA.convert . hashWith SHA256 + +numCS :: Int -> Entropy -> Integer +numCS len = + shiftCS . bsToInteger + where + shiftCS = case 8 - len `mod` 8 of + 8 -> id + x -> flip shiftR x + +{- | Turn an arbitrary sequence of characters into a 512-bit 'Seed'. Use + 'mnemonicToSeed' to get a seed from a 'Mnemonic' sentence. Warning: Does not + perform NFKD normalization. +-} +anyToSeed :: Passphrase -> Mnemonic -> Seed +anyToSeed pf ms = + fastPBKDF2_SHA512 + pbkdfParams + (E.encodeUtf8 ms) + ("mnemonic" `mappend` E.encodeUtf8 pf) + +{- | Get a 512-bit 'Seed' from a 'Mnemonic' sentence. Will validate checksum. + 'Passphrase' can be used to protect the 'Mnemonic'. Use an empty string as + 'Passphrase' if none is required. +-} +mnemonicToSeed :: Passphrase -> Mnemonic -> Either String Seed +mnemonicToSeed pf ms = do + ent <- fromMnemonic ms + mnm <- toMnemonic ent + return $ anyToSeed pf mnm + +-- | Get indices of words in word list. +getIndices :: [Text] -> Either String [Int] +getIndices ws + | null n = return $ catMaybes i + | otherwise = Left $ "getIndices: words not found: " ++ cs w + where + i = map (`M.lookup` wl') ws + n = elemIndices Nothing i + w = T.unwords $ map (ws !!) n + +-- | Turn a list of 11-bit numbers into a 'ByteString' +indicesToBS :: [Int] -> Either String ByteString +indicesToBS is = do + when lrg $ Left "indicesToBS: index larger or equal than 2048" + return . pad . integerToBS $ foldl' f 0 is `shiftL` shift_width + where + lrg = isJust $ find (>= 2048) is + (q, r) = (length is * 11) `quotRem` 8 + shift_width = + if r == 0 + then 0 + else 8 - r + bl = + if r == 0 + then q + else q + 1 -- length of resulting ByteString + pad bs = BS.append (BS.replicate (bl - BS.length bs) 0x00) bs + f acc x = (acc `shiftL` 11) + fromIntegral x + +-- | Turn a 'ByteString' into a list of 11-bit numbers. +bsToIndices :: ByteString -> [Int] +bsToIndices bs = + reverse . go q $ bsToInteger bs `shiftR` r + where + (q, r) = (BS.length bs * 8) `quotRem` 11 + go 0 _ = [] + go n i = fromIntegral (i `mod` 2048) : go (n - 1) (i `shiftR` 11) + +wl' :: M.Map Text Int +wl' = V.ifoldr' (flip M.insert) M.empty wl + +-- | Standard English dictionary from BIP-39 specification. +wl :: Vector Text +wl = + V.fromListN + 2048 + [ "abandon" + , "ability" + , "able" + , "about" + , "above" + , "absent" + , "absorb" + , "abstract" + , "absurd" + , "abuse" + , "access" + , "accident" + , "account" + , "accuse" + , "achieve" + , "acid" + , "acoustic" + , "acquire" + , "across" + , "act" + , "action" + , "actor" + , "actress" + , "actual" + , "adapt" + , "add" + , "addict" + , "address" + , "adjust" + , "admit" + , "adult" + , "advance" + , "advice" + , "aerobic" + , "affair" + , "afford" + , "afraid" + , "again" + , "age" + , "agent" + , "agree" + , "ahead" + , "aim" + , "air" + , "airport" + , "aisle" + , "alarm" + , "album" + , "alcohol" + , "alert" + , "alien" + , "all" + , "alley" + , "allow" + , "almost" + , "alone" + , "alpha" + , "already" + , "also" + , "alter" + , "always" + , "amateur" + , "amazing" + , "among" + , "amount" + , "amused" + , "analyst" + , "anchor" + , "ancient" + , "anger" + , "angle" + , "angry" + , "animal" + , "ankle" + , "announce" + , "annual" + , "another" + , "answer" + , "antenna" + , "antique" + , "anxiety" + , "any" + , "apart" + , "apology" + , "appear" + , "apple" + , "approve" + , "april" + , "arch" + , "arctic" + , "area" + , "arena" + , "argue" + , "arm" + , "armed" + , "armor" + , "army" + , "around" + , "arrange" + , "arrest" + , "arrive" + , "arrow" + , "art" + , "artefact" + , "artist" + , "artwork" + , "ask" + , "aspect" + , "assault" + , "asset" + , "assist" + , "assume" + , "asthma" + , "athlete" + , "atom" + , "attack" + , "attend" + , "attitude" + , "attract" + , "auction" + , "audit" + , "august" + , "aunt" + , "author" + , "auto" + , "autumn" + , "average" + , "avocado" + , "avoid" + , "awake" + , "aware" + , "away" + , "awesome" + , "awful" + , "awkward" + , "axis" + , "baby" + , "bachelor" + , "bacon" + , "badge" + , "bag" + , "balance" + , "balcony" + , "ball" + , "bamboo" + , "banana" + , "banner" + , "bar" + , "barely" + , "bargain" + , "barrel" + , "base" + , "basic" + , "basket" + , "battle" + , "beach" + , "bean" + , "beauty" + , "because" + , "become" + , "beef" + , "before" + , "begin" + , "behave" + , "behind" + , "believe" + , "below" + , "belt" + , "bench" + , "benefit" + , "best" + , "betray" + , "better" + , "between" + , "beyond" + , "bicycle" + , "bid" + , "bike" + , "bind" + , "biology" + , "bird" + , "birth" + , "bitter" + , "black" + , "blade" + , "blame" + , "blanket" + , "blast" + , "bleak" + , "bless" + , "blind" + , "blood" + , "blossom" + , "blouse" + , "blue" + , "blur" + , "blush" + , "board" + , "boat" + , "body" + , "boil" + , "bomb" + , "bone" + , "bonus" + , "book" + , "boost" + , "border" + , "boring" + , "borrow" + , "boss" + , "bottom" + , "bounce" + , "box" + , "boy" + , "bracket" + , "brain" + , "brand" + , "brass" + , "brave" + , "bread" + , "breeze" + , "brick" + , "bridge" + , "brief" + , "bright" + , "bring" + , "brisk" + , "broccoli" + , "broken" + , "bronze" + , "broom" + , "brother" + , "brown" + , "brush" + , "bubble" + , "buddy" + , "budget" + , "buffalo" + , "build" + , "bulb" + , "bulk" + , "bullet" + , "bundle" + , "bunker" + , "burden" + , "burger" + , "burst" + , "bus" + , "business" + , "busy" + , "butter" + , "buyer" + , "buzz" + , "cabbage" + , "cabin" + , "cable" + , "cactus" + , "cage" + , "cake" + , "call" + , "calm" + , "camera" + , "camp" + , "can" + , "canal" + , "cancel" + , "candy" + , "cannon" + , "canoe" + , "canvas" + , "canyon" + , "capable" + , "capital" + , "captain" + , "car" + , "carbon" + , "card" + , "cargo" + , "carpet" + , "carry" + , "cart" + , "case" + , "cash" + , "casino" + , "castle" + , "casual" + , "cat" + , "catalog" + , "catch" + , "category" + , "cattle" + , "caught" + , "cause" + , "caution" + , "cave" + , "ceiling" + , "celery" + , "cement" + , "census" + , "century" + , "cereal" + , "certain" + , "chair" + , "chalk" + , "champion" + , "change" + , "chaos" + , "chapter" + , "charge" + , "chase" + , "chat" + , "cheap" + , "check" + , "cheese" + , "chef" + , "cherry" + , "chest" + , "chicken" + , "chief" + , "child" + , "chimney" + , "choice" + , "choose" + , "chronic" + , "chuckle" + , "chunk" + , "churn" + , "cigar" + , "cinnamon" + , "circle" + , "citizen" + , "city" + , "civil" + , "claim" + , "clap" + , "clarify" + , "claw" + , "clay" + , "clean" + , "clerk" + , "clever" + , "click" + , "client" + , "cliff" + , "climb" + , "clinic" + , "clip" + , "clock" + , "clog" + , "close" + , "cloth" + , "cloud" + , "clown" + , "club" + , "clump" + , "cluster" + , "clutch" + , "coach" + , "coast" + , "coconut" + , "code" + , "coffee" + , "coil" + , "coin" + , "collect" + , "color" + , "column" + , "combine" + , "come" + , "comfort" + , "comic" + , "common" + , "company" + , "concert" + , "conduct" + , "confirm" + , "congress" + , "connect" + , "consider" + , "control" + , "convince" + , "cook" + , "cool" + , "copper" + , "copy" + , "coral" + , "core" + , "corn" + , "correct" + , "cost" + , "cotton" + , "couch" + , "country" + , "couple" + , "course" + , "cousin" + , "cover" + , "coyote" + , "crack" + , "cradle" + , "craft" + , "cram" + , "crane" + , "crash" + , "crater" + , "crawl" + , "crazy" + , "cream" + , "credit" + , "creek" + , "crew" + , "cricket" + , "crime" + , "crisp" + , "critic" + , "crop" + , "cross" + , "crouch" + , "crowd" + , "crucial" + , "cruel" + , "cruise" + , "crumble" + , "crunch" + , "crush" + , "cry" + , "crystal" + , "cube" + , "culture" + , "cup" + , "cupboard" + , "curious" + , "current" + , "curtain" + , "curve" + , "cushion" + , "custom" + , "cute" + , "cycle" + , "dad" + , "damage" + , "damp" + , "dance" + , "danger" + , "daring" + , "dash" + , "daughter" + , "dawn" + , "day" + , "deal" + , "debate" + , "debris" + , "decade" + , "december" + , "decide" + , "decline" + , "decorate" + , "decrease" + , "deer" + , "defense" + , "define" + , "defy" + , "degree" + , "delay" + , "deliver" + , "demand" + , "demise" + , "denial" + , "dentist" + , "deny" + , "depart" + , "depend" + , "deposit" + , "depth" + , "deputy" + , "derive" + , "describe" + , "desert" + , "design" + , "desk" + , "despair" + , "destroy" + , "detail" + , "detect" + , "develop" + , "device" + , "devote" + , "diagram" + , "dial" + , "diamond" + , "diary" + , "dice" + , "diesel" + , "diet" + , "differ" + , "digital" + , "dignity" + , "dilemma" + , "dinner" + , "dinosaur" + , "direct" + , "dirt" + , "disagree" + , "discover" + , "disease" + , "dish" + , "dismiss" + , "disorder" + , "display" + , "distance" + , "divert" + , "divide" + , "divorce" + , "dizzy" + , "doctor" + , "document" + , "dog" + , "doll" + , "dolphin" + , "domain" + , "donate" + , "donkey" + , "donor" + , "door" + , "dose" + , "double" + , "dove" + , "draft" + , "dragon" + , "drama" + , "drastic" + , "draw" + , "dream" + , "dress" + , "drift" + , "drill" + , "drink" + , "drip" + , "drive" + , "drop" + , "drum" + , "dry" + , "duck" + , "dumb" + , "dune" + , "during" + , "dust" + , "dutch" + , "duty" + , "dwarf" + , "dynamic" + , "eager" + , "eagle" + , "early" + , "earn" + , "earth" + , "easily" + , "east" + , "easy" + , "echo" + , "ecology" + , "economy" + , "edge" + , "edit" + , "educate" + , "effort" + , "egg" + , "eight" + , "either" + , "elbow" + , "elder" + , "electric" + , "elegant" + , "element" + , "elephant" + , "elevator" + , "elite" + , "else" + , "embark" + , "embody" + , "embrace" + , "emerge" + , "emotion" + , "employ" + , "empower" + , "empty" + , "enable" + , "enact" + , "end" + , "endless" + , "endorse" + , "enemy" + , "energy" + , "enforce" + , "engage" + , "engine" + , "enhance" + , "enjoy" + , "enlist" + , "enough" + , "enrich" + , "enroll" + , "ensure" + , "enter" + , "entire" + , "entry" + , "envelope" + , "episode" + , "equal" + , "equip" + , "era" + , "erase" + , "erode" + , "erosion" + , "error" + , "erupt" + , "escape" + , "essay" + , "essence" + , "estate" + , "eternal" + , "ethics" + , "evidence" + , "evil" + , "evoke" + , "evolve" + , "exact" + , "example" + , "excess" + , "exchange" + , "excite" + , "exclude" + , "excuse" + , "execute" + , "exercise" + , "exhaust" + , "exhibit" + , "exile" + , "exist" + , "exit" + , "exotic" + , "expand" + , "expect" + , "expire" + , "explain" + , "expose" + , "express" + , "extend" + , "extra" + , "eye" + , "eyebrow" + , "fabric" + , "face" + , "faculty" + , "fade" + , "faint" + , "faith" + , "fall" + , "false" + , "fame" + , "family" + , "famous" + , "fan" + , "fancy" + , "fantasy" + , "farm" + , "fashion" + , "fat" + , "fatal" + , "father" + , "fatigue" + , "fault" + , "favorite" + , "feature" + , "february" + , "federal" + , "fee" + , "feed" + , "feel" + , "female" + , "fence" + , "festival" + , "fetch" + , "fever" + , "few" + , "fiber" + , "fiction" + , "field" + , "figure" + , "file" + , "film" + , "filter" + , "final" + , "find" + , "fine" + , "finger" + , "finish" + , "fire" + , "firm" + , "first" + , "fiscal" + , "fish" + , "fit" + , "fitness" + , "fix" + , "flag" + , "flame" + , "flash" + , "flat" + , "flavor" + , "flee" + , "flight" + , "flip" + , "float" + , "flock" + , "floor" + , "flower" + , "fluid" + , "flush" + , "fly" + , "foam" + , "focus" + , "fog" + , "foil" + , "fold" + , "follow" + , "food" + , "foot" + , "force" + , "forest" + , "forget" + , "fork" + , "fortune" + , "forum" + , "forward" + , "fossil" + , "foster" + , "found" + , "fox" + , "fragile" + , "frame" + , "frequent" + , "fresh" + , "friend" + , "fringe" + , "frog" + , "front" + , "frost" + , "frown" + , "frozen" + , "fruit" + , "fuel" + , "fun" + , "funny" + , "furnace" + , "fury" + , "future" + , "gadget" + , "gain" + , "galaxy" + , "gallery" + , "game" + , "gap" + , "garage" + , "garbage" + , "garden" + , "garlic" + , "garment" + , "gas" + , "gasp" + , "gate" + , "gather" + , "gauge" + , "gaze" + , "general" + , "genius" + , "genre" + , "gentle" + , "genuine" + , "gesture" + , "ghost" + , "giant" + , "gift" + , "giggle" + , "ginger" + , "giraffe" + , "girl" + , "give" + , "glad" + , "glance" + , "glare" + , "glass" + , "glide" + , "glimpse" + , "globe" + , "gloom" + , "glory" + , "glove" + , "glow" + , "glue" + , "goat" + , "goddess" + , "gold" + , "good" + , "goose" + , "gorilla" + , "gospel" + , "gossip" + , "govern" + , "gown" + , "grab" + , "grace" + , "grain" + , "grant" + , "grape" + , "grass" + , "gravity" + , "great" + , "green" + , "grid" + , "grief" + , "grit" + , "grocery" + , "group" + , "grow" + , "grunt" + , "guard" + , "guess" + , "guide" + , "guilt" + , "guitar" + , "gun" + , "gym" + , "habit" + , "hair" + , "half" + , "hammer" + , "hamster" + , "hand" + , "happy" + , "harbor" + , "hard" + , "harsh" + , "harvest" + , "hat" + , "have" + , "hawk" + , "hazard" + , "head" + , "health" + , "heart" + , "heavy" + , "hedgehog" + , "height" + , "hello" + , "helmet" + , "help" + , "hen" + , "hero" + , "hidden" + , "high" + , "hill" + , "hint" + , "hip" + , "hire" + , "history" + , "hobby" + , "hockey" + , "hold" + , "hole" + , "holiday" + , "hollow" + , "home" + , "honey" + , "hood" + , "hope" + , "horn" + , "horror" + , "horse" + , "hospital" + , "host" + , "hotel" + , "hour" + , "hover" + , "hub" + , "huge" + , "human" + , "humble" + , "humor" + , "hundred" + , "hungry" + , "hunt" + , "hurdle" + , "hurry" + , "hurt" + , "husband" + , "hybrid" + , "ice" + , "icon" + , "idea" + , "identify" + , "idle" + , "ignore" + , "ill" + , "illegal" + , "illness" + , "image" + , "imitate" + , "immense" + , "immune" + , "impact" + , "impose" + , "improve" + , "impulse" + , "inch" + , "include" + , "income" + , "increase" + , "index" + , "indicate" + , "indoor" + , "industry" + , "infant" + , "inflict" + , "inform" + , "inhale" + , "inherit" + , "initial" + , "inject" + , "injury" + , "inmate" + , "inner" + , "innocent" + , "input" + , "inquiry" + , "insane" + , "insect" + , "inside" + , "inspire" + , "install" + , "intact" + , "interest" + , "into" + , "invest" + , "invite" + , "involve" + , "iron" + , "island" + , "isolate" + , "issue" + , "item" + , "ivory" + , "jacket" + , "jaguar" + , "jar" + , "jazz" + , "jealous" + , "jeans" + , "jelly" + , "jewel" + , "job" + , "join" + , "joke" + , "journey" + , "joy" + , "judge" + , "juice" + , "jump" + , "jungle" + , "junior" + , "junk" + , "just" + , "kangaroo" + , "keen" + , "keep" + , "ketchup" + , "key" + , "kick" + , "kid" + , "kidney" + , "kind" + , "kingdom" + , "kiss" + , "kit" + , "kitchen" + , "kite" + , "kitten" + , "kiwi" + , "knee" + , "knife" + , "knock" + , "know" + , "lab" + , "label" + , "labor" + , "ladder" + , "lady" + , "lake" + , "lamp" + , "language" + , "laptop" + , "large" + , "later" + , "latin" + , "laugh" + , "laundry" + , "lava" + , "law" + , "lawn" + , "lawsuit" + , "layer" + , "lazy" + , "leader" + , "leaf" + , "learn" + , "leave" + , "lecture" + , "left" + , "leg" + , "legal" + , "legend" + , "leisure" + , "lemon" + , "lend" + , "length" + , "lens" + , "leopard" + , "lesson" + , "letter" + , "level" + , "liar" + , "liberty" + , "library" + , "license" + , "life" + , "lift" + , "light" + , "like" + , "limb" + , "limit" + , "link" + , "lion" + , "liquid" + , "list" + , "little" + , "live" + , "lizard" + , "load" + , "loan" + , "lobster" + , "local" + , "lock" + , "logic" + , "lonely" + , "long" + , "loop" + , "lottery" + , "loud" + , "lounge" + , "love" + , "loyal" + , "lucky" + , "luggage" + , "lumber" + , "lunar" + , "lunch" + , "luxury" + , "lyrics" + , "machine" + , "mad" + , "magic" + , "magnet" + , "maid" + , "mail" + , "main" + , "major" + , "make" + , "mammal" + , "man" + , "manage" + , "mandate" + , "mango" + , "mansion" + , "manual" + , "maple" + , "marble" + , "march" + , "margin" + , "marine" + , "market" + , "marriage" + , "mask" + , "mass" + , "master" + , "match" + , "material" + , "math" + , "matrix" + , "matter" + , "maximum" + , "maze" + , "meadow" + , "mean" + , "measure" + , "meat" + , "mechanic" + , "medal" + , "media" + , "melody" + , "melt" + , "member" + , "memory" + , "mention" + , "menu" + , "mercy" + , "merge" + , "merit" + , "merry" + , "mesh" + , "message" + , "metal" + , "method" + , "middle" + , "midnight" + , "milk" + , "million" + , "mimic" + , "mind" + , "minimum" + , "minor" + , "minute" + , "miracle" + , "mirror" + , "misery" + , "miss" + , "mistake" + , "mix" + , "mixed" + , "mixture" + , "mobile" + , "model" + , "modify" + , "mom" + , "moment" + , "monitor" + , "monkey" + , "monster" + , "month" + , "moon" + , "moral" + , "more" + , "morning" + , "mosquito" + , "mother" + , "motion" + , "motor" + , "mountain" + , "mouse" + , "move" + , "movie" + , "much" + , "muffin" + , "mule" + , "multiply" + , "muscle" + , "museum" + , "mushroom" + , "music" + , "must" + , "mutual" + , "myself" + , "mystery" + , "myth" + , "naive" + , "name" + , "napkin" + , "narrow" + , "nasty" + , "nation" + , "nature" + , "near" + , "neck" + , "need" + , "negative" + , "neglect" + , "neither" + , "nephew" + , "nerve" + , "nest" + , "net" + , "network" + , "neutral" + , "never" + , "news" + , "next" + , "nice" + , "night" + , "noble" + , "noise" + , "nominee" + , "noodle" + , "normal" + , "north" + , "nose" + , "notable" + , "note" + , "nothing" + , "notice" + , "novel" + , "now" + , "nuclear" + , "number" + , "nurse" + , "nut" + , "oak" + , "obey" + , "object" + , "oblige" + , "obscure" + , "observe" + , "obtain" + , "obvious" + , "occur" + , "ocean" + , "october" + , "odor" + , "off" + , "offer" + , "office" + , "often" + , "oil" + , "okay" + , "old" + , "olive" + , "olympic" + , "omit" + , "once" + , "one" + , "onion" + , "online" + , "only" + , "open" + , "opera" + , "opinion" + , "oppose" + , "option" + , "orange" + , "orbit" + , "orchard" + , "order" + , "ordinary" + , "organ" + , "orient" + , "original" + , "orphan" + , "ostrich" + , "other" + , "outdoor" + , "outer" + , "output" + , "outside" + , "oval" + , "oven" + , "over" + , "own" + , "owner" + , "oxygen" + , "oyster" + , "ozone" + , "pact" + , "paddle" + , "page" + , "pair" + , "palace" + , "palm" + , "panda" + , "panel" + , "panic" + , "panther" + , "paper" + , "parade" + , "parent" + , "park" + , "parrot" + , "party" + , "pass" + , "patch" + , "path" + , "patient" + , "patrol" + , "pattern" + , "pause" + , "pave" + , "payment" + , "peace" + , "peanut" + , "pear" + , "peasant" + , "pelican" + , "pen" + , "penalty" + , "pencil" + , "people" + , "pepper" + , "perfect" + , "permit" + , "person" + , "pet" + , "phone" + , "photo" + , "phrase" + , "physical" + , "piano" + , "picnic" + , "picture" + , "piece" + , "pig" + , "pigeon" + , "pill" + , "pilot" + , "pink" + , "pioneer" + , "pipe" + , "pistol" + , "pitch" + , "pizza" + , "place" + , "planet" + , "plastic" + , "plate" + , "play" + , "please" + , "pledge" + , "pluck" + , "plug" + , "plunge" + , "poem" + , "poet" + , "point" + , "polar" + , "pole" + , "police" + , "pond" + , "pony" + , "pool" + , "popular" + , "portion" + , "position" + , "possible" + , "post" + , "potato" + , "pottery" + , "poverty" + , "powder" + , "power" + , "practice" + , "praise" + , "predict" + , "prefer" + , "prepare" + , "present" + , "pretty" + , "prevent" + , "price" + , "pride" + , "primary" + , "print" + , "priority" + , "prison" + , "private" + , "prize" + , "problem" + , "process" + , "produce" + , "profit" + , "program" + , "project" + , "promote" + , "proof" + , "property" + , "prosper" + , "protect" + , "proud" + , "provide" + , "public" + , "pudding" + , "pull" + , "pulp" + , "pulse" + , "pumpkin" + , "punch" + , "pupil" + , "puppy" + , "purchase" + , "purity" + , "purpose" + , "purse" + , "push" + , "put" + , "puzzle" + , "pyramid" + , "quality" + , "quantum" + , "quarter" + , "question" + , "quick" + , "quit" + , "quiz" + , "quote" + , "rabbit" + , "raccoon" + , "race" + , "rack" + , "radar" + , "radio" + , "rail" + , "rain" + , "raise" + , "rally" + , "ramp" + , "ranch" + , "random" + , "range" + , "rapid" + , "rare" + , "rate" + , "rather" + , "raven" + , "raw" + , "razor" + , "ready" + , "real" + , "reason" + , "rebel" + , "rebuild" + , "recall" + , "receive" + , "recipe" + , "record" + , "recycle" + , "reduce" + , "reflect" + , "reform" + , "refuse" + , "region" + , "regret" + , "regular" + , "reject" + , "relax" + , "release" + , "relief" + , "rely" + , "remain" + , "remember" + , "remind" + , "remove" + , "render" + , "renew" + , "rent" + , "reopen" + , "repair" + , "repeat" + , "replace" + , "report" + , "require" + , "rescue" + , "resemble" + , "resist" + , "resource" + , "response" + , "result" + , "retire" + , "retreat" + , "return" + , "reunion" + , "reveal" + , "review" + , "reward" + , "rhythm" + , "rib" + , "ribbon" + , "rice" + , "rich" + , "ride" + , "ridge" + , "rifle" + , "right" + , "rigid" + , "ring" + , "riot" + , "ripple" + , "risk" + , "ritual" + , "rival" + , "river" + , "road" + , "roast" + , "robot" + , "robust" + , "rocket" + , "romance" + , "roof" + , "rookie" + , "room" + , "rose" + , "rotate" + , "rough" + , "round" + , "route" + , "royal" + , "rubber" + , "rude" + , "rug" + , "rule" + , "run" + , "runway" + , "rural" + , "sad" + , "saddle" + , "sadness" + , "safe" + , "sail" + , "salad" + , "salmon" + , "salon" + , "salt" + , "salute" + , "same" + , "sample" + , "sand" + , "satisfy" + , "satoshi" + , "sauce" + , "sausage" + , "save" + , "say" + , "scale" + , "scan" + , "scare" + , "scatter" + , "scene" + , "scheme" + , "school" + , "science" + , "scissors" + , "scorpion" + , "scout" + , "scrap" + , "screen" + , "script" + , "scrub" + , "sea" + , "search" + , "season" + , "seat" + , "second" + , "secret" + , "section" + , "security" + , "seed" + , "seek" + , "segment" + , "select" + , "sell" + , "seminar" + , "senior" + , "sense" + , "sentence" + , "series" + , "service" + , "session" + , "settle" + , "setup" + , "seven" + , "shadow" + , "shaft" + , "shallow" + , "share" + , "shed" + , "shell" + , "sheriff" + , "shield" + , "shift" + , "shine" + , "ship" + , "shiver" + , "shock" + , "shoe" + , "shoot" + , "shop" + , "short" + , "shoulder" + , "shove" + , "shrimp" + , "shrug" + , "shuffle" + , "shy" + , "sibling" + , "sick" + , "side" + , "siege" + , "sight" + , "sign" + , "silent" + , "silk" + , "silly" + , "silver" + , "similar" + , "simple" + , "since" + , "sing" + , "siren" + , "sister" + , "situate" + , "six" + , "size" + , "skate" + , "sketch" + , "ski" + , "skill" + , "skin" + , "skirt" + , "skull" + , "slab" + , "slam" + , "sleep" + , "slender" + , "slice" + , "slide" + , "slight" + , "slim" + , "slogan" + , "slot" + , "slow" + , "slush" + , "small" + , "smart" + , "smile" + , "smoke" + , "smooth" + , "snack" + , "snake" + , "snap" + , "sniff" + , "snow" + , "soap" + , "soccer" + , "social" + , "sock" + , "soda" + , "soft" + , "solar" + , "soldier" + , "solid" + , "solution" + , "solve" + , "someone" + , "song" + , "soon" + , "sorry" + , "sort" + , "soul" + , "sound" + , "soup" + , "source" + , "south" + , "space" + , "spare" + , "spatial" + , "spawn" + , "speak" + , "special" + , "speed" + , "spell" + , "spend" + , "sphere" + , "spice" + , "spider" + , "spike" + , "spin" + , "spirit" + , "split" + , "spoil" + , "sponsor" + , "spoon" + , "sport" + , "spot" + , "spray" + , "spread" + , "spring" + , "spy" + , "square" + , "squeeze" + , "squirrel" + , "stable" + , "stadium" + , "staff" + , "stage" + , "stairs" + , "stamp" + , "stand" + , "start" + , "state" + , "stay" + , "steak" + , "steel" + , "stem" + , "step" + , "stereo" + , "stick" + , "still" + , "sting" + , "stock" + , "stomach" + , "stone" + , "stool" + , "story" + , "stove" + , "strategy" + , "street" + , "strike" + , "strong" + , "struggle" + , "student" + , "stuff" + , "stumble" + , "style" + , "subject" + , "submit" + , "subway" + , "success" + , "such" + , "sudden" + , "suffer" + , "sugar" + , "suggest" + , "suit" + , "summer" + , "sun" + , "sunny" + , "sunset" + , "super" + , "supply" + , "supreme" + , "sure" + , "surface" + , "surge" + , "surprise" + , "surround" + , "survey" + , "suspect" + , "sustain" + , "swallow" + , "swamp" + , "swap" + , "swarm" + , "swear" + , "sweet" + , "swift" + , "swim" + , "swing" + , "switch" + , "sword" + , "symbol" + , "symptom" + , "syrup" + , "system" + , "table" + , "tackle" + , "tag" + , "tail" + , "talent" + , "talk" + , "tank" + , "tape" + , "target" + , "task" + , "taste" + , "tattoo" + , "taxi" + , "teach" + , "team" + , "tell" + , "ten" + , "tenant" + , "tennis" + , "tent" + , "term" + , "test" + , "text" + , "thank" + , "that" + , "theme" + , "then" + , "theory" + , "there" + , "they" + , "thing" + , "this" + , "thought" + , "three" + , "thrive" + , "throw" + , "thumb" + , "thunder" + , "ticket" + , "tide" + , "tiger" + , "tilt" + , "timber" + , "time" + , "tiny" + , "tip" + , "tired" + , "tissue" + , "title" + , "toast" + , "tobacco" + , "today" + , "toddler" + , "toe" + , "together" + , "toilet" + , "token" + , "tomato" + , "tomorrow" + , "tone" + , "tongue" + , "tonight" + , "tool" + , "tooth" + , "top" + , "topic" + , "topple" + , "torch" + , "tornado" + , "tortoise" + , "toss" + , "total" + , "tourist" + , "toward" + , "tower" + , "town" + , "toy" + , "track" + , "trade" + , "traffic" + , "tragic" + , "train" + , "transfer" + , "trap" + , "trash" + , "travel" + , "tray" + , "treat" + , "tree" + , "trend" + , "trial" + , "tribe" + , "trick" + , "trigger" + , "trim" + , "trip" + , "trophy" + , "trouble" + , "truck" + , "true" + , "truly" + , "trumpet" + , "trust" + , "truth" + , "try" + , "tube" + , "tuition" + , "tumble" + , "tuna" + , "tunnel" + , "turkey" + , "turn" + , "turtle" + , "twelve" + , "twenty" + , "twice" + , "twin" + , "twist" + , "two" + , "type" + , "typical" + , "ugly" + , "umbrella" + , "unable" + , "unaware" + , "uncle" + , "uncover" + , "under" + , "undo" + , "unfair" + , "unfold" + , "unhappy" + , "uniform" + , "unique" + , "unit" + , "universe" + , "unknown" + , "unlock" + , "until" + , "unusual" + , "unveil" + , "update" + , "upgrade" + , "uphold" + , "upon" + , "upper" + , "upset" + , "urban" + , "urge" + , "usage" + , "use" + , "used" + , "useful" + , "useless" + , "usual" + , "utility" + , "vacant" + , "vacuum" + , "vague" + , "valid" + , "valley" + , "valve" + , "van" + , "vanish" + , "vapor" + , "various" + , "vast" + , "vault" + , "vehicle" + , "velvet" + , "vendor" + , "venture" + , "venue" + , "verb" + , "verify" + , "version" + , "very" + , "vessel" + , "veteran" + , "viable" + , "vibrant" + , "vicious" + , "victory" + , "video" + , "view" + , "village" + , "vintage" + , "violin" + , "virtual" + , "virus" + , "visa" + , "visit" + , "visual" + , "vital" + , "vivid" + , "vocal" + , "voice" + , "void" + , "volcano" + , "volume" + , "vote" + , "voyage" + , "wage" + , "wagon" + , "wait" + , "walk" + , "wall" + , "walnut" + , "want" + , "warfare" + , "warm" + , "warrior" + , "wash" + , "wasp" + , "waste" + , "water" + , "wave" + , "way" + , "wealth" + , "weapon" + , "wear" + , "weasel" + , "weather" + , "web" + , "wedding" + , "weekend" + , "weird" + , "welcome" + , "west" + , "wet" + , "whale" + , "what" + , "wheat" + , "wheel" + , "when" + , "where" + , "whip" + , "whisper" + , "wide" + , "width" + , "wife" + , "wild" + , "will" + , "win" + , "window" + , "wine" + , "wing" + , "wink" + , "winner" + , "winter" + , "wire" + , "wisdom" + , "wise" + , "wish" + , "witness" + , "wolf" + , "woman" + , "wonder" + , "wood" + , "wool" + , "word" + , "work" + , "world" + , "worry" + , "worth" + , "wrap" + , "wreck" + , "wrestle" + , "wrist" + , "write" + , "wrong" + , "yard" + , "year" + , "yellow" + , "you" + , "young" + , "youth" + , "zebra" + , "zero" + , "zone" + , "zoo" + ] diff --git a/src/Haskoin/Network.hs b/src/Haskoin/Network.hs --- a/src/Haskoin/Network.hs +++ b/src/Haskoin/Network.hs @@ -1,4 +1,4 @@ -{-| +{- | Module : Haskoin.Network Copyright : No rights reserved License : MIT @@ -10,12 +10,12 @@ together with 'Data.Serialize' instances for efficiently serializing and de-serializing them. -} -module Haskoin.Network - ( module Common - , module Message - , module Bloom - ) where +module Haskoin.Network ( + module Common, + module Message, + module Bloom, +) where -import Haskoin.Network.Bloom as Bloom -import Haskoin.Network.Common as Common -import Haskoin.Network.Message as Message +import Haskoin.Network.Bloom as Bloom +import Haskoin.Network.Common as Common +import Haskoin.Network.Message as Message diff --git a/src/Haskoin/Network/Bloom.hs b/src/Haskoin/Network/Bloom.hs --- a/src/Haskoin/Network/Bloom.hs +++ b/src/Haskoin/Network/Bloom.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-| +{-# LANGUAGE DeriveGeneric #-} + +{- | Module : Haskoin.Network.Bloom Copyright : No rights reserved License : MIT @@ -13,41 +14,41 @@ contain transactions that pass the bloom filter. Transactions announced via inv messages also pass the filter. -} -module Haskoin.Network.Bloom - ( -- * Bloom Filters - BloomFlags(..) - , BloomFilter(..) - , FilterLoad(..) - , FilterAdd(..) - , bloomCreate - , bloomInsert - , bloomContains - , isBloomValid - , isBloomEmpty - , isBloomFull - , acceptsFilters - , bloomRelevantUpdate - ) where +module Haskoin.Network.Bloom ( + -- * Bloom Filters + BloomFlags (..), + BloomFilter (..), + FilterLoad (..), + FilterAdd (..), + bloomCreate, + bloomInsert, + bloomContains, + isBloomValid, + isBloomEmpty, + isBloomFull, + acceptsFilters, + bloomRelevantUpdate, +) where -import Control.DeepSeq -import Control.Monad (forM_, replicateM) -import Data.Binary (Binary (..)) -import Data.Bits -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import qualified Data.Foldable as F -import Data.Hash.Murmur (murmur3) -import Data.List (foldl') -import qualified Data.Sequence as S -import Data.Serialize (Serialize (..)) -import Data.Word -import GHC.Generics (Generic) -import Haskoin.Network.Common -import Haskoin.Script.Standard -import Haskoin.Transaction.Common +import Control.DeepSeq +import Control.Monad (forM_, replicateM) +import Data.Binary (Binary (..)) +import Data.Bits +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import qualified Data.Foldable as F +import Data.Hash.Murmur (murmur3) +import Data.List (foldl') +import qualified Data.Sequence as S +import Data.Serialize (Serialize (..)) +import Data.Word +import GHC.Generics (Generic) +import Haskoin.Network.Common +import Haskoin.Script.Standard +import Haskoin.Transaction.Common -- | 20,000 items with fp rate < 0.1% or 10,000 items and <0.0001% maxBloomSize :: Int @@ -65,13 +66,16 @@ bitMask :: [Word8] bitMask = [0x01, 0x02, 0x04, 0x08, 0x10, 0x20, 0x40, 0x80] --- | The bloom flags are used to tell the remote peer how to auto-update --- the provided bloom filter. +{- | The bloom flags are used to tell the remote peer how to auto-update + the provided bloom filter. +-} data BloomFlags - = BloomUpdateNone -- ^ never update - | BloomUpdateAll -- ^ auto-update on all outputs - | BloomUpdateP2PubKeyOnly - -- ^ auto-update on pay-to-pubkey or pay-to-multisig (default) + = -- | never update + BloomUpdateNone + | -- | auto-update on all outputs + BloomUpdateAll + | -- | auto-update on pay-to-pubkey or pay-to-multisig (default) + BloomUpdateP2PubKeyOnly deriving (Eq, Show, Read, Generic, NFData) instance Serial BloomFlags where @@ -83,8 +87,8 @@ go _ = fail "BloomFlags get: Invalid bloom flag" serialize f = putWord8 $ case f of - BloomUpdateNone -> 0 - BloomUpdateAll -> 1 + BloomUpdateNone -> 0 + BloomUpdateAll -> 1 BloomUpdateP2PubKeyOnly -> 2 instance Binary BloomFlags where @@ -95,32 +99,32 @@ get = deserialize put = serialize --- | A bloom filter is a probabilistic data structure that SPV clients send to --- other peers to filter the set of transactions received from them. Bloom --- filters can have false positives but not false negatives. Some transactions --- that pass the filter may not be relevant to the receiving peer. By --- controlling the false positive rate, SPV nodes can trade off bandwidth --- versus privacy. +{- | A bloom filter is a probabilistic data structure that SPV clients send to + other peers to filter the set of transactions received from them. Bloom + filters can have false positives but not false negatives. Some transactions + that pass the filter may not be relevant to the receiving peer. By + controlling the false positive rate, SPV nodes can trade off bandwidth + versus privacy. +-} data BloomFilter = BloomFilter - { bloomData :: !(S.Seq Word8) - -- ^ bloom filter data - , bloomHashFuncs :: !Word32 - -- ^ number of hash functions for this filter - , bloomTweak :: !Word32 - -- ^ hash function random nonce - , bloomFlags :: !BloomFlags - -- ^ bloom filter auto-update flags + { -- | bloom filter data + bloomData :: !(S.Seq Word8) + , -- | number of hash functions for this filter + bloomHashFuncs :: !Word32 + , -- | hash function random nonce + bloomTweak :: !Word32 + , -- | bloom filter auto-update flags + bloomFlags :: !BloomFlags } deriving (Eq, Show, Read, Generic, NFData) instance Serial BloomFilter where - deserialize = BloomFilter - <$> (S.fromList <$> (readDat =<< deserialize)) - <*> getWord32le - <*> getWord32le - <*> deserialize + <$> (S.fromList <$> (readDat =<< deserialize)) + <*> getWord32le + <*> getWord32le + <*> deserialize where readDat (VarInt len) = replicateM (fromIntegral len) getWord8 @@ -140,7 +144,7 @@ get = deserialize -- | Set a new bloom filter on the peer connection. -newtype FilterLoad = FilterLoad { filterLoadBloomFilter :: BloomFilter } +newtype FilterLoad = FilterLoad {filterLoadBloomFilter :: BloomFilter} deriving (Eq, Show, Read, Generic, NFData) instance Serial FilterLoad where @@ -155,9 +159,10 @@ put = serialize get = deserialize --- | Add the given data element to the connections current filter without --- requiring a completely new one to be set. -newtype FilterAdd = FilterAdd { getFilterData :: ByteString } +{- | Add the given data element to the connections current filter without + requiring a completely new one to be set. +-} +newtype FilterAdd = FilterAdd {getFilterData :: ByteString} deriving (Eq, Show, Read, Generic, NFData) instance Serial FilterAdd where @@ -178,26 +183,32 @@ put = serialize get = deserialize - --- | Build a bloom filter that will provide the given false positive rate when --- the given number of elements have been inserted. -bloomCreate :: Int -- ^ number of elements - -> Double -- ^ false positive rate - -> Word32 -- ^ random nonce (tweak) for the hash function - -> BloomFlags -- ^ bloom filter flags - -> BloomFilter -- ^ bloom filter +{- | Build a bloom filter that will provide the given false positive rate when + the given number of elements have been inserted. +-} +bloomCreate :: + -- | number of elements + Int -> + -- | false positive rate + Double -> + -- | random nonce (tweak) for the hash function + Word32 -> + -- | bloom filter flags + BloomFlags -> + -- | bloom filter + BloomFilter bloomCreate numElem fpRate = BloomFilter (S.replicate bloomSize 0) numHashF where -- Bloom filter size in bytes bloomSize = truncate $ min a b / 8 -- Suggested size in bits - a = -1 / ln2Squared * fromIntegral numElem * log fpRate + a = -1 / ln2Squared * fromIntegral numElem * log fpRate -- Maximum size in bits - b = fromIntegral $ maxBloomSize * 8 - numHashF = truncate $ min c (fromIntegral maxHashFuncs) + b = fromIntegral $ maxBloomSize * 8 + numHashF = truncate $ min c (fromIntegral maxHashFuncs) -- Suggested number of hash functions - c = fromIntegral bloomSize * 8 / fromIntegral numElem * ln2 + c = fromIntegral bloomSize * 8 / fromIntegral numElem * ln2 bloomHash :: BloomFilter -> Word32 -> ByteString -> Word32 bloomHash bfilter hashNum bs = @@ -205,74 +216,89 @@ where seed = hashNum * 0xfba4c795 + bloomTweak bfilter --- | Insert arbitrary data into a bloom filter. Returns the new bloom filter --- containing the new data. -bloomInsert :: BloomFilter -- ^ Original bloom filter - -> ByteString -- ^ New data to insert - -> BloomFilter -- ^ Bloom filter containing the new data +{- | Insert arbitrary data into a bloom filter. Returns the new bloom filter + containing the new data. +-} +bloomInsert :: + -- | Original bloom filter + BloomFilter -> + -- | New data to insert + ByteString -> + -- | Bloom filter containing the new data + BloomFilter bloomInsert bfilter bs | isBloomFull bfilter = bfilter - | otherwise = bfilter { bloomData = newData } + | otherwise = bfilter{bloomData = newData} where - idxs = map (\i -> bloomHash bfilter i bs) [0..bloomHashFuncs bfilter - 1] - upd s i = S.adjust (.|. bitMask !! fromIntegral (7 .&. i)) - (fromIntegral $ i `shiftR` 3) s + idxs = map (\i -> bloomHash bfilter i bs) [0 .. bloomHashFuncs bfilter - 1] + upd s i = + S.adjust + (.|. bitMask !! fromIntegral (7 .&. i)) + (fromIntegral $ i `shiftR` 3) + s newData = foldl upd (bloomData bfilter) idxs --- | Tests if some arbitrary data matches the filter. This can be either because --- the data was inserted into the filter or because it is a false positive. -bloomContains :: BloomFilter -- ^ Bloom filter - -> ByteString - -- ^ Data that will be checked against the given bloom filter - -> Bool - -- ^ Returns True if the data matches the filter +{- | Tests if some arbitrary data matches the filter. This can be either because + the data was inserted into the filter or because it is a false positive. +-} +bloomContains :: + -- | Bloom filter + BloomFilter -> + -- | Data that will be checked against the given bloom filter + ByteString -> + -- | Returns True if the data matches the filter + Bool bloomContains bfilter bs - | isBloomFull bfilter = True + | isBloomFull bfilter = True | isBloomEmpty bfilter = False - | otherwise = all isSet idxs + | otherwise = all isSet idxs where - s = bloomData bfilter - idxs = map (\i -> bloomHash bfilter i bs) [0..bloomHashFuncs bfilter - 1] - isSet i = S.index s (fromIntegral $ i `shiftR` 3) - .&. (bitMask !! fromIntegral (7 .&. i)) /= 0 + s = bloomData bfilter + idxs = map (\i -> bloomHash bfilter i bs) [0 .. bloomHashFuncs bfilter - 1] + isSet i = + S.index s (fromIntegral $ i `shiftR` 3) + .&. (bitMask !! fromIntegral (7 .&. i)) /= 0 --- | Checks if any of the outputs of a tx is in the current bloom filter. --- If it is, add the txid and vout as an outpoint (i.e. so that --- a future tx that spends the output won't be missed). -bloomRelevantUpdate :: BloomFilter - -- ^ Bloom filter - -> Tx - -- ^ Tx that may (or may not) have relevant outputs - -> Maybe BloomFilter - -- ^ Returns an updated bloom filter adding relevant output +{- | Checks if any of the outputs of a tx is in the current bloom filter. + If it is, add the txid and vout as an outpoint (i.e. so that + a future tx that spends the output won't be missed). +-} +bloomRelevantUpdate :: + -- | Bloom filter + BloomFilter -> + -- | Tx that may (or may not) have relevant outputs + Tx -> + -- | Returns an updated bloom filter adding relevant output + Maybe BloomFilter bloomRelevantUpdate bfilter tx | isBloomFull bfilter || isBloomEmpty bfilter = Nothing | bloomFlags bfilter == BloomUpdateNone = Nothing | not (null matchOuts) = Just $ foldl' addRelevant bfilter matchOuts | otherwise = Nothing - -- TxHash if we end up inserting an outpoint where + -- TxHash if we end up inserting an outpoint + h = txHash tx - -- Decode the scriptOutpus and add vOuts in case we make them outpoints + -- Decode the scriptOutpus and add vOuts in case we make them outpoints decodedOutputScripts = traverse (decodeOutputBS . scriptOutput) $ txOut tx err = error "Error Decoding output script" idxOutputScripts = either (const err) (zip [0 ..]) decodedOutputScripts - -- Check if any txOuts were contained in the bloom filter + -- Check if any txOuts were contained in the bloom filter matchFilter = filter (\(_, op) -> bloomContains bfilter $ encodeScriptOut op) matchOuts = matchFilter idxOutputScripts addRelevant :: BloomFilter -> (Word32, ScriptOutput) -> BloomFilter addRelevant bf (id', scriptOut) = - case (bloomFlags bfilter, scriptType) + case (bloomFlags bfilter, scriptType) of -- We filtered out BloomUpdateNone so we insert any PayPk or PayMulSig - of + (_, True) -> bloomInsert bf outpoint (BloomUpdateAll, _) -> bloomInsert bf outpoint _ -> error "Error Updating Bloom Filter with relevant outpoint" where - outpoint = runPutS $ serialize $ OutPoint {outPointHash = h, outPointIndex = id'} + outpoint = runPutS $ serialize $ OutPoint{outPointHash = h, outPointIndex = id'} scriptType = (\s -> isPayPK s || isPayMulSig s) scriptOut - -- Encodes a scriptOutput so it can be checked agains the Bloom Filter + -- Encodes a scriptOutput so it can be checked agains the Bloom Filter encodeScriptOut :: ScriptOutput -> ByteString encodeScriptOut (PayMulSig outputMuSig _) = runPutS $ serialize outputMuSig encodeScriptOut (PayWitnessScriptHash scriptHash) = runPutS $ serialize scriptHash @@ -288,11 +314,14 @@ isBloomFull bfilter = all (== 0xff) $ F.toList $ bloomData bfilter -- | Tests if a given bloom filter is valid. -isBloomValid :: BloomFilter -- ^ Bloom filter to test - -> Bool -- ^ True if the given filter is valid +isBloomValid :: + -- | Bloom filter to test + BloomFilter -> + -- | True if the given filter is valid + Bool isBloomValid bfilter = - S.length (bloomData bfilter) <= maxBloomSize && - bloomHashFuncs bfilter <= maxHashFuncs + S.length (bloomData bfilter) <= maxBloomSize + && bloomHashFuncs bfilter <= maxHashFuncs -- | Does the peer with these version services accept bloom filters? acceptsFilters :: Word64 -> Bool diff --git a/src/Haskoin/Network/Common.hs b/src/Haskoin/Network/Common.hs --- a/src/Haskoin/Network/Common.hs +++ b/src/Haskoin/Network/Common.hs @@ -1,7 +1,8 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} -{-| + +{- | Module : Haskoin.Network.Common Copyright : No rights reserved License : MIT @@ -11,80 +12,80 @@ Common functions and data types related to peer-to-peer network. -} -module Haskoin.Network.Common - ( -- * Network Data Types - Addr(..) - , NetworkAddressTime - , Alert(..) - , GetData(..) - , Inv(..) - , InvVector(..) - , InvType(..) - , HostAddress - , hostToSockAddr - , sockToHostAddress - , NetworkAddress(..) - , NotFound(..) - , Ping(..) - , Pong(..) - , Reject(..) - , RejectCode(..) - , VarInt(..) - , VarString(..) - , Version(..) - , MessageCommand(..) - , reject - , nodeNone - , nodeNetwork - , nodeGetUTXO - , nodeBloom - , nodeWitness - , nodeXThin - , commandToString - , stringToCommand - , putVarInt - ) where +module Haskoin.Network.Common ( + -- * Network Data Types + Addr (..), + NetworkAddressTime, + Alert (..), + GetData (..), + Inv (..), + InvVector (..), + InvType (..), + HostAddress, + hostToSockAddr, + sockToHostAddress, + NetworkAddress (..), + NotFound (..), + Ping (..), + Pong (..), + Reject (..), + RejectCode (..), + VarInt (..), + VarString (..), + Version (..), + MessageCommand (..), + reject, + nodeNone, + nodeNetwork, + nodeGetUTXO, + nodeBloom, + nodeWitness, + nodeXThin, + commandToString, + stringToCommand, + putVarInt, +) where -import Control.DeepSeq -import Control.Monad (forM_, liftM2, replicateM, unless) -import Data.Binary (Binary (..)) -import Data.Bits (shiftL) -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import Data.ByteString.Char8 as C (replicate) -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import Data.Serialize (Serialize (..)) -import Data.String -import Data.String.Conversions (cs) -import Data.Word (Word32, Word64) -import GHC.Generics (Generic) -import Haskoin.Crypto.Hash -import Network.Socket (SockAddr (..)) -import Text.Read as R +import Control.DeepSeq +import Control.Monad (forM_, liftM2, replicateM, unless) +import Data.Binary (Binary (..)) +import Data.Bits (shiftL) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.ByteString.Char8 as C (replicate) +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.Serialize (Serialize (..)) +import Data.String +import Data.String.Conversions (cs) +import Data.Word (Word32, Word64) +import GHC.Generics (Generic) +import Haskoin.Crypto.Hash +import Network.Socket (SockAddr (..)) +import Text.Read as R -- | Network address with a timestamp. type NetworkAddressTime = (Word32, NetworkAddress) --- | Provides information about known nodes in the bitcoin network. An 'Addr' --- type is sent inside a 'Message' as a response to a 'GetAddr' message. -newtype Addr = - Addr { -- List of addresses of other nodes on the network with timestamps. - addrList :: [NetworkAddressTime] - } +{- | Provides information about known nodes in the bitcoin network. An 'Addr' + type is sent inside a 'Message' as a response to a 'GetAddr' message. +-} +newtype Addr = Addr + { -- List of addresses of other nodes on the network with timestamps. + addrList :: [NetworkAddressTime] + } deriving (Eq, Show, Generic, NFData) instance Serial Addr where - deserialize = Addr <$> (repList =<< deserialize) where repList (VarInt c) = replicateM (fromIntegral c) action - action = liftM2 (,) getWord32le deserialize + action = liftM2 (,) getWord32le deserialize serialize (Addr xs) = do putVarInt $ length xs - forM_ xs $ \(a,b) -> putWord32le a >> serialize b + forM_ xs $ \(a, b) -> putWord32le a >> serialize b instance Binary Addr where get = deserialize @@ -94,16 +95,17 @@ get = deserialize put = serialize --- | Data type describing signed messages that can be sent between bitcoin --- nodes to display important notifications to end users about the health of --- the network. -data Alert = - Alert { - -- | Alert payload. - alertPayload :: !VarString - -- | ECDSA signature of the payload - , alertSignature :: !VarString - } deriving (Eq, Show, Read, Generic, NFData) +{- | Data type describing signed messages that can be sent between bitcoin + nodes to display important notifications to end users about the health of + the network. +-} +data Alert = Alert + { -- | Alert payload. + alertPayload :: !VarString + , -- | ECDSA signature of the payload + alertSignature :: !VarString + } + deriving (Eq, Show, Read, Generic, NFData) instance Serial Alert where deserialize = Alert <$> deserialize <*> deserialize @@ -117,20 +119,21 @@ put = serialize get = deserialize --- | The 'GetData' type is used to retrieve information on a specific object --- ('Block' or 'Tx') identified by the objects hash. The payload of a 'GetData' --- request is a list of 'InvVector' which represent all the hashes of objects --- that a node wants. The response to a 'GetBlock' message will be either a --- 'Block' or a 'Tx' message depending on the type of the object referenced by --- the hash. Usually, 'GetData' messages are sent after a node receives an 'Inv' --- message that contains unknown object hashes. -newtype GetData = - GetData { -- | list of object hashes - getDataList :: [InvVector] - } deriving (Eq, Show, Generic, NFData) +{- | The 'GetData' type is used to retrieve information on a specific object + ('Block' or 'Tx') identified by the objects hash. The payload of a 'GetData' + request is a list of 'InvVector' which represent all the hashes of objects + that a node wants. The response to a 'GetBlock' message will be either a + 'Block' or a 'Tx' message depending on the type of the object referenced by + the hash. Usually, 'GetData' messages are sent after a node receives an 'Inv' + message that contains unknown object hashes. +-} +newtype GetData = GetData + { -- | list of object hashes + getDataList :: [InvVector] + } + deriving (Eq, Show, Generic, NFData) instance Serial GetData where - deserialize = GetData <$> (repList =<< deserialize) where repList (VarInt c) = replicateM (fromIntegral c) deserialize @@ -147,17 +150,17 @@ get = deserialize put = serialize --- | 'Inv' messages are used by nodes to advertise their knowledge of new --- objects by publishing a list of hashes to a peer. 'Inv' messages can be sent --- unsolicited or in response to a 'GetBlocks' message. -newtype Inv = - Inv { - -- | inventory - invList :: [InvVector] - } deriving (Eq, Show, Generic, NFData) +{- | 'Inv' messages are used by nodes to advertise their knowledge of new + objects by publishing a list of hashes to a peer. 'Inv' messages can be sent + unsolicited or in response to a 'GetBlocks' message. +-} +newtype Inv = Inv + { -- | inventory + invList :: [InvVector] + } + deriving (Eq, Show, Generic, NFData) instance Serial Inv where - deserialize = Inv <$> (repList =<< deserialize) where repList (VarInt c) = replicateM (fromIntegral c) deserialize @@ -174,17 +177,26 @@ get = deserialize put = serialize --- | Data type identifying the type of an inventory vector. SegWit types are --- only used in 'GetData' messages, not 'Inv'. +{- | Data type identifying the type of an inventory vector. SegWit types are + only used in 'GetData' messages, not 'Inv'. +-} data InvType - = InvError -- ^ error - | InvTx -- ^ transaction - | InvBlock -- ^ block - | InvMerkleBlock -- ^ filtered block - | InvWitnessTx -- ^ segwit transaction - | InvWitnessBlock -- ^ segwit block - | InvWitnessMerkleBlock -- ^ segwit filtered block - | InvType Word32 -- ^ unknown inv type + = -- | error + InvError + | -- | transaction + InvTx + | -- | block + InvBlock + | -- | filtered block + InvMerkleBlock + | -- | segwit transaction + InvWitnessTx + | -- | segwit block + InvWitnessBlock + | -- | segwit filtered block + InvWitnessMerkleBlock + | -- | unknown inv type + InvType Word32 deriving (Eq, Show, Read, Generic, NFData) instance Serial InvType where @@ -203,15 +215,15 @@ | otherwise -> return (InvType x) serialize x = putWord32le $ - case x of - InvError -> 0 - InvTx -> 1 - InvBlock -> 2 - InvMerkleBlock -> 3 - InvWitnessTx -> 1 `shiftL` 30 + 1 - InvWitnessBlock -> 1 `shiftL` 30 + 2 - InvWitnessMerkleBlock -> 1 `shiftL` 30 + 3 - InvType w -> w + case x of + InvError -> 0 + InvTx -> 1 + InvBlock -> 2 + InvMerkleBlock -> 3 + InvWitnessTx -> 1 `shiftL` 30 + 1 + InvWitnessBlock -> 1 `shiftL` 30 + 2 + InvWitnessMerkleBlock -> 1 `shiftL` 30 + 3 + InvType w -> w instance Binary InvType where get = deserialize @@ -221,16 +233,17 @@ get = deserialize put = serialize --- | Invectory vectors represent hashes identifying objects such as a 'Block' or --- a 'Tx'. They notify other peers about new data or data they have otherwise --- requested. -data InvVector = - InvVector { - -- | type of object - invType :: !InvType - -- | 256-bit hash of object - , invHash :: !Hash256 - } deriving (Eq, Show, Generic, NFData) +{- | Invectory vectors represent hashes identifying objects such as a 'Block' or + a 'Tx'. They notify other peers about new data or data they have otherwise + requested. +-} +data InvVector = InvVector + { -- | type of object + invType :: !InvType + , -- | 256-bit hash of object + invHash :: !Hash256 + } + deriving (Eq, Show, Generic, NFData) instance Serial InvVector where deserialize = InvVector <$> deserialize <*> deserialize @@ -244,8 +257,8 @@ get = deserialize put = serialize -newtype HostAddress = - HostAddress ByteString +newtype HostAddress + = HostAddress ByteString deriving (Eq, Show, Ord, Generic, NFData) instance Serial HostAddress where @@ -260,20 +273,22 @@ get = deserialize put = serialize --- | Data type describing a bitcoin network address. Addresses are stored in --- IPv6 format. IPv4 addresses are mapped to IPv6 using IPv4 mapped IPv6 --- addresses: . -data NetworkAddress = - NetworkAddress { -- | bitmask of services available for this address - naServices :: !Word64 - -- | address and port information - , naAddress :: !HostAddress - } deriving (Eq, Show, Generic, NFData) +{- | Data type describing a bitcoin network address. Addresses are stored in + IPv6 format. IPv4 addresses are mapped to IPv6 using IPv4 mapped IPv6 + addresses: . +-} +data NetworkAddress = NetworkAddress + { -- | bitmask of services available for this address + naServices :: !Word64 + , -- | address and port information + naAddress :: !HostAddress + } + deriving (Eq, Show, Generic, NFData) hostToSockAddr :: HostAddress -> SockAddr hostToSockAddr (HostAddress bs) = case runGetS getSockAddr bs of - Left e -> error e + Left e -> error e Right x -> x sockToHostAddress :: SockAddr -> HostAddress @@ -286,14 +301,12 @@ putWord32be c putWord32be d putWord16be (fromIntegral p) - putSockAddr (SockAddrInet p a) = do putWord32be 0x00000000 putWord32be 0x00000000 putWord32be 0x0000ffff putWord32host a putWord16be (fromIntegral p) - putSockAddr _ = error "Invalid address type" getSockAddr :: MonadGet m => m SockAddr @@ -323,17 +336,18 @@ get = deserialize put = serialize --- | A 'NotFound' message is returned as a response to a 'GetData' message --- whe one of the requested objects could not be retrieved. This could happen, --- for example, if a tranasaction was requested and was not available in the --- memory pool of the receiving node. -newtype NotFound = - NotFound { -- | Inventory vectors related to this request - notFoundList :: [InvVector] - } deriving (Eq, Show, Generic, NFData) +{- | A 'NotFound' message is returned as a response to a 'GetData' message + whe one of the requested objects could not be retrieved. This could happen, + for example, if a tranasaction was requested and was not available in the + memory pool of the receiving node. +-} +newtype NotFound = NotFound + { -- | Inventory vectors related to this request + notFoundList :: [InvVector] + } + deriving (Eq, Show, Generic, NFData) instance Serial NotFound where - deserialize = NotFound <$> (repList =<< deserialize) where repList (VarInt c) = replicateM (fromIntegral c) deserialize @@ -350,20 +364,22 @@ get = deserialize put = serialize --- | A 'Ping' message is sent to bitcoin peers to check if a connection is still --- open. -newtype Ping = - Ping { -- | A random nonce used to identify the recipient of the ping - -- request once a Pong response is received. - pingNonce :: Word64 - } deriving (Eq, Show, Read, Generic, NFData) +{- | A 'Ping' message is sent to bitcoin peers to check if a connection is still + open. +-} +newtype Ping = Ping + { -- | A random nonce used to identify the recipient of the ping + -- request once a Pong response is received. + pingNonce :: Word64 + } + deriving (Eq, Show, Read, Generic, NFData) -- | A Pong message is sent as a response to a ping message. -newtype Pong = - Pong { - -- | nonce from corresponding 'Ping' - pongNonce :: Word64 - } deriving (Eq, Show, Read, Generic, NFData) +newtype Pong = Pong + { -- | nonce from corresponding 'Ping' + pongNonce :: Word64 + } + deriving (Eq, Show, Read, Generic, NFData) instance Serial Ping where deserialize = Ping <$> getWord64le @@ -390,17 +406,17 @@ put = serialize -- | The 'Reject' message is sent when messages are rejected by a peer. -data Reject = - Reject { - -- | type of message rejected - rejectMessage :: !MessageCommand - -- | rejection code - , rejectCode :: !RejectCode - -- | text reason for rejection - , rejectReason :: !VarString - -- | extra data such as block or tx hash - , rejectData :: !ByteString - } deriving (Eq, Show, Read, Generic, NFData) +data Reject = Reject + { -- | type of message rejected + rejectMessage :: !MessageCommand + , -- | rejection code + rejectCode :: !RejectCode + , -- | text reason for rejection + rejectReason :: !VarString + , -- | extra data such as block or tx hash + rejectData :: !ByteString + } + deriving (Eq, Show, Read, Generic, NFData) -- | Rejection code associated to the 'Reject' message. data RejectCode @@ -415,31 +431,32 @@ deriving (Eq, Show, Read, Generic, NFData) instance Serial RejectCode where - deserialize = getWord8 >>= \code -> case code of - 0x01 -> return RejectMalformed - 0x10 -> return RejectInvalid - 0x11 -> return RejectObsolete - 0x12 -> return RejectDuplicate - 0x40 -> return RejectNonStandard - 0x41 -> return RejectDust - 0x42 -> return RejectInsufficientFee - 0x43 -> return RejectCheckpoint - _ -> fail $ unwords - [ "Reject get: Invalid code" - , show code - ] + 0x01 -> return RejectMalformed + 0x10 -> return RejectInvalid + 0x11 -> return RejectObsolete + 0x12 -> return RejectDuplicate + 0x40 -> return RejectNonStandard + 0x41 -> return RejectDust + 0x42 -> return RejectInsufficientFee + 0x43 -> return RejectCheckpoint + _ -> + fail $ + unwords + [ "Reject get: Invalid code" + , show code + ] serialize code = putWord8 $ case code of - RejectMalformed -> 0x01 - RejectInvalid -> 0x10 - RejectObsolete -> 0x11 - RejectDuplicate -> 0x12 - RejectNonStandard -> 0x40 - RejectDust -> 0x41 + RejectMalformed -> 0x01 + RejectInvalid -> 0x10 + RejectObsolete -> 0x11 + RejectDuplicate -> 0x12 + RejectNonStandard -> 0x40 + RejectDust -> 0x41 RejectInsufficientFee -> 0x42 - RejectCheckpoint -> 0x43 + RejectCheckpoint -> 0x43 instance Binary RejectCode where put = serialize @@ -458,9 +475,9 @@ deserialize = deserialize >>= \(VarString bs) -> Reject (stringToCommand bs) - <$> deserialize - <*> deserialize - <*> maybeData + <$> deserialize + <*> deserialize + <*> maybeData where maybeData = isEmpty >>= \done -> @@ -481,19 +498,19 @@ put = serialize get = deserialize --- | Data type representing a variable-length integer. The 'VarInt' type --- usually precedes an array or a string that can vary in length. -newtype VarInt = VarInt { getVarInt :: Word64 } +{- | Data type representing a variable-length integer. The 'VarInt' type + usually precedes an array or a string that can vary in length. +-} +newtype VarInt = VarInt {getVarInt :: Word64} deriving (Eq, Show, Read, Generic, NFData) instance Serial VarInt where - - deserialize = VarInt <$> ( getWord8 >>= go ) + deserialize = VarInt <$> (getWord8 >>= go) where go 0xff = getWord64le go 0xfe = fromIntegral <$> getWord32le go 0xfd = fromIntegral <$> getWord16le - go x = return $ fromIntegral x + go x = return $ fromIntegral x serialize (VarInt x) | x < 0xfd = @@ -520,11 +537,10 @@ putVarInt = serialize . VarInt . fromIntegral -- | Data type for serialization of variable-length strings. -newtype VarString = VarString { getVarString :: ByteString } +newtype VarString = VarString {getVarString :: ByteString} deriving (Eq, Show, Read, Generic, NFData) instance Serial VarString where - deserialize = VarString <$> (readBS =<< deserialize) where readBS (VarInt len) = getByteString (fromIntegral len) @@ -541,56 +557,57 @@ put = serialize get = deserialize --- | When a bitcoin node creates an outgoing connection to another node, --- the first message it will send is a 'Version' message. The other node --- will similarly respond with it's own 'Version' message. -data Version = - Version { - -- | protocol version - version :: !Word32 - -- | features supported by this connection - , services :: !Word64 - -- | unix timestamp - , timestamp :: !Word64 - -- | network address of remote node - , addrRecv :: !NetworkAddress - -- | network address of sending node - , addrSend :: !NetworkAddress - -- | random nonce to detect connection to self - , verNonce :: !Word64 - -- | user agent string - , userAgent :: !VarString - -- | height of the last block in sending node - , startHeight :: !Word32 - -- | relay transactions flag (BIP-37) - , relay :: !Bool - } deriving (Eq, Show, Generic, NFData) +{- | When a bitcoin node creates an outgoing connection to another node, + the first message it will send is a 'Version' message. The other node + will similarly respond with it's own 'Version' message. +-} +data Version = Version + { -- | protocol version + version :: !Word32 + , -- | features supported by this connection + services :: !Word64 + , -- | unix timestamp + timestamp :: !Word64 + , -- | network address of remote node + addrRecv :: !NetworkAddress + , -- | network address of sending node + addrSend :: !NetworkAddress + , -- | random nonce to detect connection to self + verNonce :: !Word64 + , -- | user agent string + userAgent :: !VarString + , -- | height of the last block in sending node + startHeight :: !Word32 + , -- | relay transactions flag (BIP-37) + relay :: !Bool + } + deriving (Eq, Show, Generic, NFData) instance Serial Version where - - deserialize = Version <$> getWord32le - <*> getWord64le - <*> getWord64le - <*> deserialize - <*> deserialize - <*> getWord64le - <*> deserialize - <*> getWord32le - <*> (go =<< isEmpty) + deserialize = + Version <$> getWord32le + <*> getWord64le + <*> getWord64le + <*> deserialize + <*> deserialize + <*> getWord64le + <*> deserialize + <*> getWord32le + <*> (go =<< isEmpty) where - go True = return True + go True = return True go False = getBool serialize (Version v s t ar as n ua sh r) = do putWord32le v putWord64le s putWord64le t - serialize ar - serialize as + serialize ar + serialize as putWord64le n - serialize ua + serialize ua putWord32le sh - putBool r + putBool r instance Binary Version where put = serialize @@ -608,14 +625,15 @@ go _ = return True putBool :: MonadPut m => Bool -> m () -putBool True = putWord8 1 +putBool True = putWord8 1 putBool False = putWord8 0 --- | A 'MessageCommand' is included in a 'MessageHeader' in order to identify --- the type of message present in the payload. This allows the message --- de-serialization code to know how to decode a particular message payload. --- Every valid 'Message' constructor has a corresponding 'MessageCommand' --- constructor. +{- | A 'MessageCommand' is included in a 'MessageHeader' in order to identify + the type of message present in the payload. This allows the message + de-serialization code to know how to decode a particular message payload. + Every valid 'Message' constructor has a corresponding 'MessageCommand' + constructor. +-} data MessageCommand = MCVersion | MCVerAck @@ -672,61 +690,62 @@ -- | Read a 'MessageCommand' from its string representation. stringToCommand :: ByteString -> MessageCommand stringToCommand str = case str of - "version" -> MCVersion - "verack" -> MCVerAck - "addr" -> MCAddr - "inv" -> MCInv - "getdata" -> MCGetData - "notfound" -> MCNotFound - "getblocks" -> MCGetBlocks - "getheaders" -> MCGetHeaders - "tx" -> MCTx - "block" -> MCBlock + "version" -> MCVersion + "verack" -> MCVerAck + "addr" -> MCAddr + "inv" -> MCInv + "getdata" -> MCGetData + "notfound" -> MCNotFound + "getblocks" -> MCGetBlocks + "getheaders" -> MCGetHeaders + "tx" -> MCTx + "block" -> MCBlock "merkleblock" -> MCMerkleBlock - "headers" -> MCHeaders - "getaddr" -> MCGetAddr - "filterload" -> MCFilterLoad - "filteradd" -> MCFilterAdd + "headers" -> MCHeaders + "getaddr" -> MCGetAddr + "filterload" -> MCFilterLoad + "filteradd" -> MCFilterAdd "filterclear" -> MCFilterClear - "ping" -> MCPing - "pong" -> MCPong - "alert" -> MCAlert - "mempool" -> MCMempool - "reject" -> MCReject + "ping" -> MCPing + "pong" -> MCPong + "alert" -> MCAlert + "mempool" -> MCMempool + "reject" -> MCReject "sendheaders" -> MCSendHeaders - _ -> MCOther str + _ -> MCOther str -- | Convert a 'MessageCommand' to its string representation. commandToString :: MessageCommand -> ByteString commandToString mc = case mc of - MCVersion -> "version" - MCVerAck -> "verack" - MCAddr -> "addr" - MCInv -> "inv" - MCGetData -> "getdata" - MCNotFound -> "notfound" - MCGetBlocks -> "getblocks" - MCGetHeaders -> "getheaders" - MCTx -> "tx" - MCBlock -> "block" + MCVersion -> "version" + MCVerAck -> "verack" + MCAddr -> "addr" + MCInv -> "inv" + MCGetData -> "getdata" + MCNotFound -> "notfound" + MCGetBlocks -> "getblocks" + MCGetHeaders -> "getheaders" + MCTx -> "tx" + MCBlock -> "block" MCMerkleBlock -> "merkleblock" - MCHeaders -> "headers" - MCGetAddr -> "getaddr" - MCFilterLoad -> "filterload" - MCFilterAdd -> "filteradd" + MCHeaders -> "headers" + MCGetAddr -> "getaddr" + MCFilterLoad -> "filterload" + MCFilterAdd -> "filteradd" MCFilterClear -> "filterclear" - MCPing -> "ping" - MCPong -> "pong" - MCAlert -> "alert" - MCMempool -> "mempool" - MCReject -> "reject" + MCPing -> "ping" + MCPong -> "pong" + MCAlert -> "alert" + MCMempool -> "mempool" + MCReject -> "reject" MCSendHeaders -> "sendheaders" - MCOther c -> c + MCOther c -> c -- | Pack a string 'MessageCommand' so that it is exactly 12-bytes long. packCommand :: ByteString -> ByteString -packCommand s = B.take 12 $ - s `mappend` C.replicate 12 '\NUL' +packCommand s = + B.take 12 $ + s `mappend` C.replicate 12 '\NUL' -- | Undo packing done by 'packCommand'. unpackCommand :: ByteString -> ByteString diff --git a/src/Haskoin/Network/Message.hs b/src/Haskoin/Network/Message.hs --- a/src/Haskoin/Network/Message.hs +++ b/src/Haskoin/Network/Message.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-| +{-# LANGUAGE DeriveGeneric #-} + +{- | Module : Haskoin.Network.Message Copyright : No rights reserved License : MIT @@ -10,61 +11,62 @@ Peer-to-peer network message serialization. -} -module Haskoin.Network.Message - ( -- * Network Message - Message(..) - , MessageHeader(..) - , msgType - , putMessage - , getMessage - ) where +module Haskoin.Network.Message ( + -- * Network Message + Message (..), + MessageHeader (..), + msgType, + putMessage, + getMessage, +) where -import Control.DeepSeq -import Control.Monad (unless) -import Data.Binary (Binary (..)) -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import Data.Serialize (Serialize (..)) -import Data.Word (Word32) -import GHC.Generics (Generic) -import Haskoin.Block.Common -import Haskoin.Block.Merkle -import Haskoin.Constants -import Haskoin.Crypto.Hash -import Haskoin.Network.Bloom -import Haskoin.Network.Common -import Haskoin.Transaction.Common +import Control.DeepSeq +import Control.Monad (unless) +import Data.Binary (Binary (..)) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.Serialize (Serialize (..)) +import Data.Word (Word32) +import GHC.Generics (Generic) +import Haskoin.Block.Common +import Haskoin.Block.Merkle +import Haskoin.Crypto.Hash +import Haskoin.Data +import Haskoin.Network.Bloom +import Haskoin.Network.Common +import Haskoin.Transaction.Common --- | Data type representing the header of a 'Message'. All messages sent between --- nodes contain a message header. +{- | Data type representing the header of a 'Message'. All messages sent between + nodes contain a message header. +-} data MessageHeader = MessageHeader { -- | magic bytes identify network - headMagic :: !Word32 - -- | message type - , headCmd :: !MessageCommand - -- | length of payload - , headPayloadSize :: !Word32 - -- | checksum of payload - , headChecksum :: !CheckSum32 - } deriving (Eq, Show, Generic, NFData) + headMagic :: !Word32 + , -- | message type + headCmd :: !MessageCommand + , -- | length of payload + headPayloadSize :: !Word32 + , -- | checksum of payload + headChecksum :: !CheckSum32 + } + deriving (Eq, Show, Generic, NFData) instance Serial MessageHeader where - deserialize = MessageHeader - <$> getWord32be - <*> deserialize - <*> getWord32le - <*> deserialize + <$> getWord32be + <*> deserialize + <*> getWord32le + <*> deserialize serialize (MessageHeader m c l chk) = do putWord32be m - serialize c + serialize c putWord32le l - serialize chk + serialize chk instance Binary MessageHeader where put = serialize @@ -74,12 +76,13 @@ put = serialize get = deserialize --- | The 'Message' type is used to identify all the valid messages that can be --- sent between bitcoin peers. Only values of type 'Message' will be accepted --- by other bitcoin peers as bitcoin protocol messages need to be correctly --- serialized with message headers. Serializing a 'Message' value will --- include the 'MessageHeader' with the correct checksum value automatically. --- No need to add the 'MessageHeader' separately. +{- | The 'Message' type is used to identify all the valid messages that can be + sent between bitcoin peers. Only values of type 'Message' will be accepted + by other bitcoin peers as bitcoin protocol messages need to be correctly + serialized with message headers. Serializing a 'Message' value will + include the 'MessageHeader' with the correct checksum value automatically. + No need to add the 'MessageHeader' separately. +-} data Message = MVersion !Version | MVerAck @@ -108,30 +111,29 @@ -- | Get 'MessageCommand' assocated with a message. msgType :: Message -> MessageCommand -msgType (MVersion _) = MCVersion -msgType MVerAck = MCVerAck -msgType (MAddr _) = MCAddr -msgType (MInv _) = MCInv -msgType (MGetData _) = MCGetData -msgType (MNotFound _) = MCNotFound -msgType (MGetBlocks _) = MCGetBlocks -msgType (MGetHeaders _) = MCGetHeaders -msgType (MTx _) = MCTx -msgType (MBlock _) = MCBlock +msgType (MVersion _) = MCVersion +msgType MVerAck = MCVerAck +msgType (MAddr _) = MCAddr +msgType (MInv _) = MCInv +msgType (MGetData _) = MCGetData +msgType (MNotFound _) = MCNotFound +msgType (MGetBlocks _) = MCGetBlocks +msgType (MGetHeaders _) = MCGetHeaders +msgType (MTx _) = MCTx +msgType (MBlock _) = MCBlock msgType (MMerkleBlock _) = MCMerkleBlock -msgType (MHeaders _) = MCHeaders - -msgType (MFilterLoad _) = MCFilterLoad -msgType (MFilterAdd _) = MCFilterAdd -msgType MFilterClear = MCFilterClear -msgType (MPing _) = MCPing -msgType (MPong _) = MCPong -msgType (MAlert _) = MCAlert -msgType MMempool = MCMempool -msgType (MReject _) = MCReject -msgType MSendHeaders = MCSendHeaders -msgType MGetAddr = MCGetAddr -msgType (MOther c _) = MCOther c +msgType (MHeaders _) = MCHeaders +msgType (MFilterLoad _) = MCFilterLoad +msgType (MFilterAdd _) = MCFilterAdd +msgType MFilterClear = MCFilterClear +msgType (MPing _) = MCPing +msgType (MPong _) = MCPong +msgType (MAlert _) = MCAlert +msgType MMempool = MCMempool +msgType (MReject _) = MCReject +msgType MSendHeaders = MCSendHeaders +msgType MGetAddr = MCGetAddr +msgType (MOther c _) = MCOther c -- | Deserializer for network messages. getMessage :: MonadGet m => Network -> m Message @@ -146,67 +148,71 @@ (fail $ "get: Invalid message checksum: " ++ show chk) if len > 0 then do - bs <- ensure (fromIntegral len) - let f = case cmd of - MCVersion -> MVersion <$> deserialize - MCAddr -> MAddr <$> deserialize - MCInv -> MInv <$> deserialize - MCGetData -> MGetData <$> deserialize - MCNotFound -> MNotFound <$> deserialize - MCGetBlocks -> MGetBlocks <$> deserialize - MCGetHeaders -> MGetHeaders <$> deserialize - MCTx -> MTx <$> deserialize - MCBlock -> MBlock <$> deserialize - MCMerkleBlock -> MMerkleBlock <$> deserialize - MCHeaders -> MHeaders <$> deserialize - MCFilterLoad -> MFilterLoad <$> deserialize - MCFilterAdd -> MFilterAdd <$> deserialize - MCPing -> MPing <$> deserialize - MCPong -> MPong <$> deserialize - MCAlert -> MAlert <$> deserialize - MCReject -> MReject <$> deserialize - MCOther c -> MOther c <$> getByteString (fromIntegral len) - _ -> fail $ "get: command " ++ show cmd ++ - " should not carry a payload" - either fail return (runGetS f bs) + bs <- ensure (fromIntegral len) + let f = case cmd of + MCVersion -> MVersion <$> deserialize + MCAddr -> MAddr <$> deserialize + MCInv -> MInv <$> deserialize + MCGetData -> MGetData <$> deserialize + MCNotFound -> MNotFound <$> deserialize + MCGetBlocks -> MGetBlocks <$> deserialize + MCGetHeaders -> MGetHeaders <$> deserialize + MCTx -> MTx <$> deserialize + MCBlock -> MBlock <$> deserialize + MCMerkleBlock -> MMerkleBlock <$> deserialize + MCHeaders -> MHeaders <$> deserialize + MCFilterLoad -> MFilterLoad <$> deserialize + MCFilterAdd -> MFilterAdd <$> deserialize + MCPing -> MPing <$> deserialize + MCPong -> MPong <$> deserialize + MCAlert -> MAlert <$> deserialize + MCReject -> MReject <$> deserialize + MCOther c -> MOther c <$> getByteString (fromIntegral len) + _ -> + fail $ + "get: command " ++ show cmd + ++ " should not carry a payload" + either fail return (runGetS f bs) else case cmd of - MCGetAddr -> return MGetAddr - MCVerAck -> return MVerAck - MCFilterClear -> return MFilterClear - MCMempool -> return MMempool - MCSendHeaders -> return MSendHeaders - MCOther c -> return (MOther c BS.empty) - _ -> fail $ "get: command " ++ show cmd ++ - " is expected to carry a payload" + MCGetAddr -> return MGetAddr + MCVerAck -> return MVerAck + MCFilterClear -> return MFilterClear + MCMempool -> return MMempool + MCSendHeaders -> return MSendHeaders + MCOther c -> return (MOther c BS.empty) + _ -> + fail $ + "get: command " ++ show cmd + ++ " is expected to carry a payload" -- | Serializer for network messages. putMessage :: MonadPut m => Network -> Message -> m () putMessage net msg = do let (cmd, payload) = case msg of - MVersion m -> (MCVersion, runPutS $ serialize m) - MVerAck -> (MCVerAck, BS.empty) - MAddr m -> (MCAddr, runPutS $ serialize m) - MInv m -> (MCInv, runPutS $ serialize m) - MGetData m -> (MCGetData, runPutS $ serialize m) - MNotFound m -> (MCNotFound, runPutS $ serialize m) - MGetBlocks m -> (MCGetBlocks, runPutS $ serialize m) - MGetHeaders m -> (MCGetHeaders, runPutS $ serialize m) - MTx m -> (MCTx, runPutS $ serialize m) - MBlock m -> (MCBlock, runPutS $ serialize m) - MMerkleBlock m -> (MCMerkleBlock, runPutS $ serialize m) - MHeaders m -> (MCHeaders, runPutS $ serialize m) - MGetAddr -> (MCGetAddr, BS.empty) - MFilterLoad m -> (MCFilterLoad, runPutS $ serialize m) - MFilterAdd m -> (MCFilterAdd, runPutS $ serialize m) - MFilterClear -> (MCFilterClear, BS.empty) - MPing m -> (MCPing, runPutS $ serialize m) - MPong m -> (MCPong, runPutS $ serialize m) - MAlert m -> (MCAlert, runPutS $ serialize m) - MMempool -> (MCMempool, BS.empty) - MReject m -> (MCReject, runPutS $ serialize m) - MSendHeaders -> (MCSendHeaders, BS.empty) - MOther c p -> (MCOther c, p) + MVersion m -> (MCVersion, runPutS $ serialize m) + MVerAck -> (MCVerAck, BS.empty) + MAddr m -> (MCAddr, runPutS $ serialize m) + MInv m -> (MCInv, runPutS $ serialize m) + MGetData m -> (MCGetData, runPutS $ serialize m) + MNotFound m -> (MCNotFound, runPutS $ serialize m) + MGetBlocks m -> (MCGetBlocks, runPutS $ serialize m) + MGetHeaders m -> (MCGetHeaders, runPutS $ serialize m) + MTx m -> (MCTx, runPutS $ serialize m) + MBlock m -> (MCBlock, runPutS $ serialize m) + MMerkleBlock m -> (MCMerkleBlock, runPutS $ serialize m) + MHeaders m -> (MCHeaders, runPutS $ serialize m) + MGetAddr -> (MCGetAddr, BS.empty) + MFilterLoad m -> (MCFilterLoad, runPutS $ serialize m) + MFilterAdd m -> (MCFilterAdd, runPutS $ serialize m) + MFilterClear -> (MCFilterClear, BS.empty) + MPing m -> (MCPing, runPutS $ serialize m) + MPong m -> (MCPong, runPutS $ serialize m) + MAlert m -> (MCAlert, runPutS $ serialize m) + MMempool -> (MCMempool, BS.empty) + MReject m -> (MCReject, runPutS $ serialize m) + MSendHeaders -> (MCSendHeaders, BS.empty) + MOther c p -> (MCOther c, p) chk = checkSum32 payload len = fromIntegral $ BS.length payload header = MessageHeader (getNetworkMagic net) cmd len chk diff --git a/src/Haskoin/Script.hs b/src/Haskoin/Script.hs --- a/src/Haskoin/Script.hs +++ b/src/Haskoin/Script.hs @@ -1,4 +1,4 @@ -{-| +{- | Module : Haskoin.Script Copyright : No rights reserved License : MIT @@ -10,12 +10,12 @@ transaction scripts. Data types are provided for building and deconstructing all of the standard input and output script types. -} -module Haskoin.Script - ( module Common - , module Standard - , module SigHash - ) where +module Haskoin.Script ( + module Common, + module Standard, + module SigHash, +) where -import Haskoin.Script.Common as Common -import Haskoin.Script.SigHash as SigHash -import Haskoin.Script.Standard as Standard +import Haskoin.Script.Common as Common +import Haskoin.Script.SigHash as SigHash +import Haskoin.Script.Standard as Standard diff --git a/src/Haskoin/Script/Common.hs b/src/Haskoin/Script/Common.hs --- a/src/Haskoin/Script/Common.hs +++ b/src/Haskoin/Script/Common.hs @@ -1,7 +1,8 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} -{-| + +{- | Module : Haskoin.Script.Common Copyright : No rights reserved License : MIT @@ -11,44 +12,45 @@ Common script-related functions and data types. -} -module Haskoin.Script.Common - ( -- * Scripts - ScriptOp(..) - , Script(..) - , PushDataType(..) - , isPushOp - , opPushData - , intToScriptOp - , scriptOpToInt - ) where +module Haskoin.Script.Common ( + -- * Scripts + ScriptOp (..), + Script (..), + PushDataType (..), + isPushOp, + opPushData, + intToScriptOp, + scriptOpToInt, +) where -import Control.DeepSeq -import Control.Monad -import Data.Binary (Binary (..)) -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import Data.Hashable -import Data.Serialize (Serialize (..)) -import Data.Word (Word8) -import GHC.Generics (Generic) +import Control.DeepSeq +import Control.Monad +import Data.Binary (Binary (..)) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.Either (fromRight) +import Data.Hashable +import Data.Serialize (Serialize (..)) +import Data.Word (Word8) +import GHC.Generics (Generic) --- | Data type representing a transaction script. Scripts are defined as lists --- of script operators 'ScriptOp'. Scripts are used to: --- --- * Define the spending conditions in the output of a transaction. --- * Provide signatures in the input of a transaction (except SegWit). --- --- SigWit only: the segregated witness data structure, and not the input script, --- contains signatures and redeem script for pay-to-witness-script and --- pay-to-witness-public-key-hash transactions. -newtype Script = - Script { - -- | script operators defining this script - scriptOps :: [ScriptOp] - } +{- | Data type representing a transaction script. Scripts are defined as lists + of script operators 'ScriptOp'. Scripts are used to: + + * Define the spending conditions in the output of a transaction. + * Provide signatures in the input of a transaction (except SegWit). + + SigWit only: the segregated witness data structure, and not the input script, + contains signatures and redeem script for pay-to-witness-script and + pay-to-witness-public-key-hash transactions. +-} +newtype Script = Script + { -- | script operators defining this script + scriptOps :: [ScriptOp] + } deriving (Eq, Show, Read, Generic, Hashable, NFData) instance Serial Script where @@ -73,22 +75,22 @@ -- | Data type representing the type of an OP_PUSHDATA opcode. data PushDataType - = - -- | next opcode bytes is data to be pushed + = -- | next opcode bytes is data to be pushed OPCODE - -- | next byte contains number of bytes of data to be pushed - | OPDATA1 - -- | next two bytes contains number of bytes to be pushed - | OPDATA2 - -- | next four bytes contains the number of bytes to be pushed - | OPDATA4 + | -- | next byte contains number of bytes of data to be pushed + OPDATA1 + | -- | next two bytes contains number of bytes to be pushed + OPDATA2 + | -- | next four bytes contains the number of bytes to be pushed + OPDATA4 deriving (Show, Read, Eq, Generic, Hashable, NFData) -- | Data type representing an operator allowed inside a 'Script'. data ScriptOp - -- Pushing Data - = OP_PUSHDATA !ByteString - !PushDataType + = -- Pushing Data + OP_PUSHDATA + !ByteString + !PushDataType | OP_0 | OP_1NEGATE | OP_RESERVED @@ -108,8 +110,8 @@ | OP_14 | OP_15 | OP_16 - -- Flow control - | OP_NOP + | -- Flow control + OP_NOP | OP_VER -- reserved | OP_IF | OP_NOTIF @@ -119,8 +121,8 @@ | OP_ENDIF | OP_VERIFY | OP_RETURN - -- Stack operations - | OP_TOALTSTACK + | -- Stack operations + OP_TOALTSTACK | OP_FROMALTSTACK | OP_IFDUP | OP_DEPTH @@ -139,14 +141,14 @@ | OP_2OVER | OP_2ROT | OP_2SWAP - -- Splice - | OP_CAT + | -- Splice + OP_CAT | OP_SUBSTR | OP_LEFT | OP_RIGHT | OP_SIZE - -- Bitwise logic - | OP_INVERT + | -- Bitwise logic + OP_INVERT | OP_AND | OP_OR | OP_XOR @@ -154,8 +156,8 @@ | OP_EQUALVERIFY | OP_RESERVED1 | OP_RESERVED2 - -- Arithmetic - | OP_1ADD + | -- Arithmetic + OP_1ADD | OP_1SUB | OP_2MUL | OP_2DIV @@ -182,8 +184,8 @@ | OP_MIN | OP_MAX | OP_WITHIN - -- Crypto - | OP_RIPEMD160 + | -- Crypto + OP_RIPEMD160 | OP_SHA1 | OP_SHA256 | OP_HASH160 @@ -193,8 +195,8 @@ | OP_CHECKSIGVERIFY | OP_CHECKMULTISIG | OP_CHECKMULTISIGVERIFY - -- Expansion - | OP_NOP1 + | -- Expansion + OP_NOP1 | OP_CHECKLOCKTIMEVERIFY | OP_CHECKSEQUENCEVERIFY | OP_NOP4 @@ -204,19 +206,19 @@ | OP_NOP8 | OP_NOP9 | OP_NOP10 - -- Bitcoin Cash Nov 2018 hard fork - | OP_CHECKDATASIG + | -- Bitcoin Cash Nov 2018 hard fork + OP_CHECKDATASIG | OP_CHECKDATASIGVERIFY - -- Bitcoin Cash May 2020 hard fork - | OP_REVERSEBYTES - -- Other - | OP_PUBKEYHASH + | -- Bitcoin Cash May 2020 hard fork + OP_REVERSEBYTES + | -- Other + OP_PUBKEYHASH | OP_PUBKEY | OP_INVALIDOPCODE !Word8 deriving (Show, Read, Eq, Generic, Hashable, NFData) instance Serial ScriptOp where - deserialize = go =<< (fromIntegral <$> getWord8) + deserialize = go . fromIntegral =<< getWord8 where go op | op == 0x00 = return OP_0 @@ -224,18 +226,17 @@ payload <- getByteString (fromIntegral op) return $ OP_PUSHDATA payload OPCODE | op == 0x4c = do - len <- getWord8 + len <- getWord8 payload <- getByteString (fromIntegral len) return $ OP_PUSHDATA payload OPDATA1 | op == 0x4d = do - len <- getWord16le + len <- getWord16le payload <- getByteString (fromIntegral len) return $ OP_PUSHDATA payload OPDATA2 | op == 0x4e = do - len <- getWord32le + len <- getWord32le payload <- getByteString (fromIntegral len) return $ OP_PUSHDATA payload OPDATA4 - | op == 0x4f = return OP_1NEGATE | op == 0x50 = return OP_RESERVED | op == 0x51 = return OP_1 @@ -254,19 +255,17 @@ | op == 0x5e = return OP_14 | op == 0x5f = return OP_15 | op == 0x60 = return OP_16 - -- Flow control | op == 0x61 = return OP_NOP - | op == 0x62 = return OP_VER -- reserved + | op == 0x62 = return OP_VER -- reserved | op == 0x63 = return OP_IF | op == 0x64 = return OP_NOTIF - | op == 0x65 = return OP_VERIF -- reserved - | op == 0x66 = return OP_VERNOTIF -- reserved + | op == 0x65 = return OP_VERIF -- reserved + | op == 0x66 = return OP_VERNOTIF -- reserved | op == 0x67 = return OP_ELSE | op == 0x68 = return OP_ENDIF | op == 0x69 = return OP_VERIFY | op == 0x6a = return OP_RETURN - -- Stack | op == 0x6b = return OP_TOALTSTACK | op == 0x6c = return OP_FROMALTSTACK @@ -287,14 +286,12 @@ | op == 0x7b = return OP_ROT | op == 0x7c = return OP_SWAP | op == 0x7d = return OP_TUCK - -- Splice | op == 0x7e = return OP_CAT | op == 0x7f = return OP_SUBSTR | op == 0x80 = return OP_LEFT | op == 0x81 = return OP_RIGHT | op == 0x82 = return OP_SIZE - -- Bitwise logic | op == 0x83 = return OP_INVERT | op == 0x84 = return OP_AND @@ -304,7 +301,6 @@ | op == 0x88 = return OP_EQUALVERIFY | op == 0x89 = return OP_RESERVED1 | op == 0x8a = return OP_RESERVED2 - -- Arithmetic | op == 0x8b = return OP_1ADD | op == 0x8c = return OP_1SUB @@ -333,7 +329,6 @@ | op == 0xa3 = return OP_MIN | op == 0xa4 = return OP_MAX | op == 0xa5 = return OP_WITHIN - -- Crypto | op == 0xa6 = return OP_RIPEMD160 | op == 0xa7 = return OP_SHA1 @@ -345,7 +340,6 @@ | op == 0xad = return OP_CHECKSIGVERIFY | op == 0xae = return OP_CHECKMULTISIG | op == 0xaf = return OP_CHECKMULTISIGVERIFY - -- More NOPs | op == 0xb0 = return OP_NOP1 | op == 0xb1 = return OP_CHECKLOCKTIMEVERIFY @@ -357,23 +351,18 @@ | op == 0xb7 = return OP_NOP8 | op == 0xb8 = return OP_NOP9 | op == 0xb9 = return OP_NOP10 - -- Bitcoin Cash Nov 2018 hard fork | op == 0xba = return OP_CHECKDATASIG | op == 0xbb = return OP_CHECKDATASIGVERIFY - -- Bitcoin Cash May 2020 hard fork | op == 0xbc = return OP_REVERSEBYTES - -- Constants | op == 0xfd = return OP_PUBKEYHASH | op == 0xfe = return OP_PUBKEY - | otherwise = return $ OP_INVALIDOPCODE op serialize op = case op of - - (OP_PUSHDATA payload optype)-> do + (OP_PUSHDATA payload optype) -> do let len = B.length payload case optype of OPCODE -> do @@ -398,142 +387,131 @@ putByteString payload -- Constants - OP_0 -> putWord8 0x00 - OP_1NEGATE -> putWord8 0x4f - OP_RESERVED -> putWord8 0x50 - OP_1 -> putWord8 0x51 - OP_2 -> putWord8 0x52 - OP_3 -> putWord8 0x53 - OP_4 -> putWord8 0x54 - OP_5 -> putWord8 0x55 - OP_6 -> putWord8 0x56 - OP_7 -> putWord8 0x57 - OP_8 -> putWord8 0x58 - OP_9 -> putWord8 0x59 - OP_10 -> putWord8 0x5a - OP_11 -> putWord8 0x5b - OP_12 -> putWord8 0x5c - OP_13 -> putWord8 0x5d - OP_14 -> putWord8 0x5e - OP_15 -> putWord8 0x5f - OP_16 -> putWord8 0x60 - + OP_0 -> putWord8 0x00 + OP_1NEGATE -> putWord8 0x4f + OP_RESERVED -> putWord8 0x50 + OP_1 -> putWord8 0x51 + OP_2 -> putWord8 0x52 + OP_3 -> putWord8 0x53 + OP_4 -> putWord8 0x54 + OP_5 -> putWord8 0x55 + OP_6 -> putWord8 0x56 + OP_7 -> putWord8 0x57 + OP_8 -> putWord8 0x58 + OP_9 -> putWord8 0x59 + OP_10 -> putWord8 0x5a + OP_11 -> putWord8 0x5b + OP_12 -> putWord8 0x5c + OP_13 -> putWord8 0x5d + OP_14 -> putWord8 0x5e + OP_15 -> putWord8 0x5f + OP_16 -> putWord8 0x60 -- Crypto Constants - OP_PUBKEY -> putWord8 0xfe - OP_PUBKEYHASH -> putWord8 0xfd - + OP_PUBKEY -> putWord8 0xfe + OP_PUBKEYHASH -> putWord8 0xfd -- Invalid Opcodes (OP_INVALIDOPCODE x) -> putWord8 x - -- Flow Control - OP_NOP -> putWord8 0x61 - OP_VER -> putWord8 0x62 - OP_IF -> putWord8 0x63 - OP_NOTIF -> putWord8 0x64 - OP_VERIF -> putWord8 0x65 - OP_VERNOTIF -> putWord8 0x66 - OP_ELSE -> putWord8 0x67 - OP_ENDIF -> putWord8 0x68 - OP_VERIFY -> putWord8 0x69 - OP_RETURN -> putWord8 0x6a - + OP_NOP -> putWord8 0x61 + OP_VER -> putWord8 0x62 + OP_IF -> putWord8 0x63 + OP_NOTIF -> putWord8 0x64 + OP_VERIF -> putWord8 0x65 + OP_VERNOTIF -> putWord8 0x66 + OP_ELSE -> putWord8 0x67 + OP_ENDIF -> putWord8 0x68 + OP_VERIFY -> putWord8 0x69 + OP_RETURN -> putWord8 0x6a -- Stack Operations - OP_TOALTSTACK -> putWord8 0x6b - OP_FROMALTSTACK -> putWord8 0x6c - OP_2DROP -> putWord8 0x6d - OP_2DUP -> putWord8 0x6e - OP_3DUP -> putWord8 0x6f - OP_2OVER -> putWord8 0x70 - OP_2ROT -> putWord8 0x71 - OP_2SWAP -> putWord8 0x72 - OP_IFDUP -> putWord8 0x73 - OP_DEPTH -> putWord8 0x74 - OP_DROP -> putWord8 0x75 - OP_DUP -> putWord8 0x76 - OP_NIP -> putWord8 0x77 - OP_OVER -> putWord8 0x78 - OP_PICK -> putWord8 0x79 - OP_ROLL -> putWord8 0x7a - OP_ROT -> putWord8 0x7b - OP_SWAP -> putWord8 0x7c - OP_TUCK -> putWord8 0x7d - + OP_TOALTSTACK -> putWord8 0x6b + OP_FROMALTSTACK -> putWord8 0x6c + OP_2DROP -> putWord8 0x6d + OP_2DUP -> putWord8 0x6e + OP_3DUP -> putWord8 0x6f + OP_2OVER -> putWord8 0x70 + OP_2ROT -> putWord8 0x71 + OP_2SWAP -> putWord8 0x72 + OP_IFDUP -> putWord8 0x73 + OP_DEPTH -> putWord8 0x74 + OP_DROP -> putWord8 0x75 + OP_DUP -> putWord8 0x76 + OP_NIP -> putWord8 0x77 + OP_OVER -> putWord8 0x78 + OP_PICK -> putWord8 0x79 + OP_ROLL -> putWord8 0x7a + OP_ROT -> putWord8 0x7b + OP_SWAP -> putWord8 0x7c + OP_TUCK -> putWord8 0x7d -- Splice - OP_CAT -> putWord8 0x7e - OP_SUBSTR -> putWord8 0x7f - OP_LEFT -> putWord8 0x80 - OP_RIGHT -> putWord8 0x81 - OP_SIZE -> putWord8 0x82 - + OP_CAT -> putWord8 0x7e + OP_SUBSTR -> putWord8 0x7f + OP_LEFT -> putWord8 0x80 + OP_RIGHT -> putWord8 0x81 + OP_SIZE -> putWord8 0x82 -- Bitwise Logic - OP_INVERT -> putWord8 0x83 - OP_AND -> putWord8 0x84 - OP_OR -> putWord8 0x85 - OP_XOR -> putWord8 0x86 - OP_EQUAL -> putWord8 0x87 - OP_EQUALVERIFY -> putWord8 0x88 - OP_RESERVED1 -> putWord8 0x89 - OP_RESERVED2 -> putWord8 0x8a - + OP_INVERT -> putWord8 0x83 + OP_AND -> putWord8 0x84 + OP_OR -> putWord8 0x85 + OP_XOR -> putWord8 0x86 + OP_EQUAL -> putWord8 0x87 + OP_EQUALVERIFY -> putWord8 0x88 + OP_RESERVED1 -> putWord8 0x89 + OP_RESERVED2 -> putWord8 0x8a -- Arithmetic - OP_1ADD -> putWord8 0x8b - OP_1SUB -> putWord8 0x8c - OP_2MUL -> putWord8 0x8d - OP_2DIV -> putWord8 0x8e - OP_NEGATE -> putWord8 0x8f - OP_ABS -> putWord8 0x90 - OP_NOT -> putWord8 0x91 - OP_0NOTEQUAL -> putWord8 0x92 - OP_ADD -> putWord8 0x93 - OP_SUB -> putWord8 0x94 - OP_MUL -> putWord8 0x95 - OP_DIV -> putWord8 0x96 - OP_MOD -> putWord8 0x97 - OP_LSHIFT -> putWord8 0x98 - OP_RSHIFT -> putWord8 0x99 - OP_BOOLAND -> putWord8 0x9a - OP_BOOLOR -> putWord8 0x9b - OP_NUMEQUAL -> putWord8 0x9c - OP_NUMEQUALVERIFY -> putWord8 0x9d - OP_NUMNOTEQUAL -> putWord8 0x9e - OP_LESSTHAN -> putWord8 0x9f - OP_GREATERTHAN -> putWord8 0xa0 - OP_LESSTHANOREQUAL -> putWord8 0xa1 - OP_GREATERTHANOREQUAL-> putWord8 0xa2 - OP_MIN -> putWord8 0xa3 - OP_MAX -> putWord8 0xa4 - OP_WITHIN -> putWord8 0xa5 - + OP_1ADD -> putWord8 0x8b + OP_1SUB -> putWord8 0x8c + OP_2MUL -> putWord8 0x8d + OP_2DIV -> putWord8 0x8e + OP_NEGATE -> putWord8 0x8f + OP_ABS -> putWord8 0x90 + OP_NOT -> putWord8 0x91 + OP_0NOTEQUAL -> putWord8 0x92 + OP_ADD -> putWord8 0x93 + OP_SUB -> putWord8 0x94 + OP_MUL -> putWord8 0x95 + OP_DIV -> putWord8 0x96 + OP_MOD -> putWord8 0x97 + OP_LSHIFT -> putWord8 0x98 + OP_RSHIFT -> putWord8 0x99 + OP_BOOLAND -> putWord8 0x9a + OP_BOOLOR -> putWord8 0x9b + OP_NUMEQUAL -> putWord8 0x9c + OP_NUMEQUALVERIFY -> putWord8 0x9d + OP_NUMNOTEQUAL -> putWord8 0x9e + OP_LESSTHAN -> putWord8 0x9f + OP_GREATERTHAN -> putWord8 0xa0 + OP_LESSTHANOREQUAL -> putWord8 0xa1 + OP_GREATERTHANOREQUAL -> putWord8 0xa2 + OP_MIN -> putWord8 0xa3 + OP_MAX -> putWord8 0xa4 + OP_WITHIN -> putWord8 0xa5 -- Crypto - OP_RIPEMD160 -> putWord8 0xa6 - OP_SHA1 -> putWord8 0xa7 - OP_SHA256 -> putWord8 0xa8 - OP_HASH160 -> putWord8 0xa9 - OP_HASH256 -> putWord8 0xaa - OP_CODESEPARATOR -> putWord8 0xab - OP_CHECKSIG -> putWord8 0xac - OP_CHECKSIGVERIFY -> putWord8 0xad - OP_CHECKMULTISIG -> putWord8 0xae + OP_RIPEMD160 -> putWord8 0xa6 + OP_SHA1 -> putWord8 0xa7 + OP_SHA256 -> putWord8 0xa8 + OP_HASH160 -> putWord8 0xa9 + OP_HASH256 -> putWord8 0xaa + OP_CODESEPARATOR -> putWord8 0xab + OP_CHECKSIG -> putWord8 0xac + OP_CHECKSIGVERIFY -> putWord8 0xad + OP_CHECKMULTISIG -> putWord8 0xae OP_CHECKMULTISIGVERIFY -> putWord8 0xaf - -- More NOPs - OP_NOP1 -> putWord8 0xb0 + OP_NOP1 -> putWord8 0xb0 OP_CHECKLOCKTIMEVERIFY -> putWord8 0xb1 OP_CHECKSEQUENCEVERIFY -> putWord8 0xb2 - OP_NOP4 -> putWord8 0xb3 - OP_NOP5 -> putWord8 0xb4 - OP_NOP6 -> putWord8 0xb5 - OP_NOP7 -> putWord8 0xb6 - OP_NOP8 -> putWord8 0xb7 - OP_NOP9 -> putWord8 0xb8 - OP_NOP10 -> putWord8 0xb9 - + OP_NOP4 -> putWord8 0xb3 + OP_NOP5 -> putWord8 0xb4 + OP_NOP6 -> putWord8 0xb5 + OP_NOP7 -> putWord8 0xb6 + OP_NOP8 -> putWord8 0xb7 + OP_NOP9 -> putWord8 0xb8 + OP_NOP10 -> putWord8 0xb9 -- Bitcoin Cash Nov 2018 hard fork - OP_CHECKDATASIG -> putWord8 0xba + OP_CHECKDATASIG -> putWord8 0xba OP_CHECKDATASIGVERIFY -> putWord8 0xbb - -- Bitcoin Cash May 2020 hard fork - OP_REVERSEBYTES -> putWord8 0xbc + OP_REVERSEBYTES -> putWord8 0xbc instance Binary ScriptOp where put = serialize @@ -547,34 +525,34 @@ isPushOp :: ScriptOp -> Bool isPushOp op = case op of OP_PUSHDATA _ _ -> True - OP_0 -> True - OP_1NEGATE -> True - OP_1 -> True - OP_2 -> True - OP_3 -> True - OP_4 -> True - OP_5 -> True - OP_6 -> True - OP_7 -> True - OP_8 -> True - OP_9 -> True - OP_10 -> True - OP_11 -> True - OP_12 -> True - OP_13 -> True - OP_14 -> True - OP_15 -> True - OP_16 -> True - _ -> False + OP_0 -> True + OP_1NEGATE -> True + OP_1 -> True + OP_2 -> True + OP_3 -> True + OP_4 -> True + OP_5 -> True + OP_6 -> True + OP_7 -> True + OP_8 -> True + OP_9 -> True + OP_10 -> True + OP_11 -> True + OP_12 -> True + OP_13 -> True + OP_14 -> True + OP_15 -> True + OP_16 -> True + _ -> False -- | Optimally encode data using one of the 4 types of data pushing opcodes. opPushData :: ByteString -> ScriptOp opPushData bs - | len <= 0x4b = OP_PUSHDATA bs OPCODE - | len <= 0xff = OP_PUSHDATA bs OPDATA1 - | len <= 0xffff = OP_PUSHDATA bs OPDATA2 + | len <= 0x4b = OP_PUSHDATA bs OPCODE + | len <= 0xff = OP_PUSHDATA bs OPDATA1 + | len <= 0xffff = OP_PUSHDATA bs OPDATA2 | len <= 0xffffffff = OP_PUSHDATA bs OPDATA4 - | otherwise = error "opPushData: payload size too big" + | otherwise = error "opPushData: payload size too big" where len = B.length bs @@ -584,20 +562,20 @@ | i `elem` [1 .. 16] = op | otherwise = err where - op = either - (const err) - id . - runGetS deserialize . - B.singleton . - fromIntegral $ - i + 0x50 + op = + fromRight err + . runGetS deserialize + . B.singleton + . fromIntegral + $ i + 0x50 err = error $ "intToScriptOp: Invalid integer " ++ show i --- | Decode 'ScriptOp' @[OP_1 .. OP_16]@ to integers @[1 .. 16]@. This functions --- fails for other values of 'ScriptOp' +{- | Decode 'ScriptOp' @[OP_1 .. OP_16]@ to integers @[1 .. 16]@. This functions + fails for other values of 'ScriptOp' +-} scriptOpToInt :: ScriptOp -> Either String Int scriptOpToInt s - | res `elem` [1..16] = return res - | otherwise = Left $ "scriptOpToInt: invalid opcode " ++ show s + | res `elem` [1 .. 16] = return res + | otherwise = Left $ "scriptOpToInt: invalid opcode " ++ show s where res = fromIntegral (B.head $ runPutS $ serialize s) - 0x50 diff --git a/src/Haskoin/Script/SigHash.hs b/src/Haskoin/Script/SigHash.hs --- a/src/Haskoin/Script/SigHash.hs +++ b/src/Haskoin/Script/SigHash.hs @@ -1,7 +1,8 @@ -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} -{-| +{-# LANGUAGE OverloadedStrings #-} + +{- | Module : Haskoin.Script.SigHash Copyright : No rights reserved License : MIT @@ -11,64 +12,64 @@ Transaction signatures and related functions. -} -module Haskoin.Script.SigHash - ( -- * Script Signatures - SigHash(..) - , SigHashFlag(..) - , sigHashAll - , sigHashNone - , sigHashSingle - , hasAnyoneCanPayFlag - , hasForkIdFlag - , setAnyoneCanPayFlag - , setForkIdFlag - , isSigHashAll - , isSigHashNone - , isSigHashSingle - , isSigHashUnknown - , sigHashAddForkId - , sigHashGetForkId - , sigHashAddNetworkId - , txSigHash - , txSigHashForkId - , TxSignature(..) - , encodeTxSig - , decodeTxSig - ) where +module Haskoin.Script.SigHash ( + -- * Script Signatures + SigHash (..), + SigHashFlag (..), + sigHashAll, + sigHashNone, + sigHashSingle, + hasAnyoneCanPayFlag, + hasForkIdFlag, + setAnyoneCanPayFlag, + setForkIdFlag, + isSigHashAll, + isSigHashNone, + isSigHashSingle, + isSigHashUnknown, + sigHashAddForkId, + sigHashGetForkId, + sigHashAddNetworkId, + txSigHash, + txSigHashForkId, + TxSignature (..), + encodeTxSig, + decodeTxSig, +) where -import Control.DeepSeq -import Control.Monad -import qualified Data.Aeson as J -import Data.Bits -import qualified Data.ByteString as BS -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import Data.Hashable -import Data.Maybe -import Data.Scientific -import Data.Word -import GHC.Generics (Generic) -import Haskoin.Constants -import Haskoin.Crypto -import Haskoin.Crypto.Hash -import Haskoin.Network.Common -import Haskoin.Script.Common -import Haskoin.Transaction.Common -import Haskoin.Util +import Control.DeepSeq +import Control.Monad +import qualified Data.Aeson as J +import Data.Bits +import qualified Data.ByteString as BS +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.Hashable +import Data.Maybe +import Data.Scientific +import Data.Word +import GHC.Generics (Generic) +import Haskoin.Crypto +import Haskoin.Crypto.Hash +import Haskoin.Data +import Haskoin.Network.Common +import Haskoin.Script.Common +import Haskoin.Transaction.Common +import Haskoin.Util -- | Constant representing a SIGHASH flag that controls what is being signed. data SigHashFlag - = SIGHASH_ALL - -- ^ sign all outputs - | SIGHASH_NONE - -- ^ sign no outputs - | SIGHASH_SINGLE - -- ^ sign the output index corresponding to the input - | SIGHASH_FORKID - -- ^ replay protection for Bitcoin Cash transactions - | SIGHASH_ANYONECANPAY - -- ^ new inputs can be added + = -- | sign all outputs + SIGHASH_ALL + | -- | sign no outputs + SIGHASH_NONE + | -- | sign the output index corresponding to the input + SIGHASH_SINGLE + | -- | replay protection for Bitcoin Cash transactions + SIGHASH_FORKID + | -- | new inputs can be added + SIGHASH_ANYONECANPAY deriving (Eq, Ord, Show, Read, Generic) instance NFData SigHashFlag @@ -76,49 +77,51 @@ instance Hashable SigHashFlag instance Enum SigHashFlag where - fromEnum SIGHASH_ALL = 0x01 - fromEnum SIGHASH_NONE = 0x02 - fromEnum SIGHASH_SINGLE = 0x03 - fromEnum SIGHASH_FORKID = 0x40 + fromEnum SIGHASH_ALL = 0x01 + fromEnum SIGHASH_NONE = 0x02 + fromEnum SIGHASH_SINGLE = 0x03 + fromEnum SIGHASH_FORKID = 0x40 fromEnum SIGHASH_ANYONECANPAY = 0x80 toEnum 0x01 = SIGHASH_ALL toEnum 0x02 = SIGHASH_NONE toEnum 0x03 = SIGHASH_SINGLE toEnum 0x40 = SIGHASH_FORKID toEnum 0x80 = SIGHASH_ANYONECANPAY - toEnum _ = error "Not a valid sighash flag" + toEnum _ = error "Not a valid sighash flag" --- | Data type representing the different ways a transaction can be signed. --- When producing a signature, a hash of the transaction is used as the message --- to be signed. The 'SigHash' parameter controls which parts of the --- transaction are used or ignored to produce the transaction hash. The idea is --- that if some part of a transaction is not used to produce the transaction --- hash, then you can change that part of the transaction after producing a --- signature without invalidating that signature. --- --- If the 'SIGHASH_ANYONECANPAY' flag is set (true), then only the current input --- is signed. Otherwise, all of the inputs of a transaction are signed. The --- default value for 'SIGHASH_ANYONECANPAY' is unset (false). -newtype SigHash = - SigHash Word32 - deriving ( Eq - , Ord - , Bits - , Enum - , Integral - , Num - , Real - , Show - , Read - , Generic - , Hashable - , NFData - ) +{- | Data type representing the different ways a transaction can be signed. + When producing a signature, a hash of the transaction is used as the message + to be signed. The 'SigHash' parameter controls which parts of the + transaction are used or ignored to produce the transaction hash. The idea is + that if some part of a transaction is not used to produce the transaction + hash, then you can change that part of the transaction after producing a + signature without invalidating that signature. + If the 'SIGHASH_ANYONECANPAY' flag is set (true), then only the current input + is signed. Otherwise, all of the inputs of a transaction are signed. The + default value for 'SIGHASH_ANYONECANPAY' is unset (false). +-} +newtype SigHash + = SigHash Word32 + deriving + ( Eq + , Ord + , Bits + , Enum + , Integral + , Num + , Real + , Show + , Read + , Generic + , Hashable + , NFData + ) + instance J.FromJSON SigHash where parseJSON = J.withScientific "sighash" $ - maybe mzero (return . SigHash) . toBoundedInteger + maybe mzero (return . SigHash) . toBoundedInteger instance J.ToJSON SigHash where toJSON = J.Number . fromIntegral @@ -191,13 +194,20 @@ sigHashGetForkId (SigHash n) = fromIntegral $ n `shiftR` 8 -- | Computes the hash that will be used for signing a transaction. -txSigHash :: Network - -> Tx -- ^ transaction to sign - -> Script -- ^ script from output being spent - -> Word64 -- ^ value of output being spent - -> Int -- ^ index of input being signed - -> SigHash -- ^ what to sign - -> Hash256 -- ^ hash to be signed +txSigHash :: + Network -> + -- | transaction to sign + Tx -> + -- | script from output being spent + Script -> + -- | value of output being spent + Word64 -> + -- | index of input being signed + Int -> + -- | what to sign + SigHash -> + -- | hash to be signed + Hash256 txSigHash net tx out v i sh | hasForkIdFlag sh && isJust (getSigHashForkId net) = txSigHashForkId net tx out v i sh @@ -209,9 +219,9 @@ let newTx = Tx (txVersion tx) newIn newOut [] (txLockTime tx) return $ doubleSHA256 $ - runPutS $ do - serialize newTx - putWord32le $ fromIntegral sh + runPutS $ do + serialize newTx + putWord32le $ fromIntegral sh where fout = Script $ filter (/= OP_CODESEPARATOR) $ scriptOps out one = "0100000000000000000000000000000000000000000000000000000000000000" @@ -220,17 +230,17 @@ buildInputs :: [TxIn] -> Script -> Int -> SigHash -> [TxIn] buildInputs txins out i sh | hasAnyoneCanPayFlag sh = - [ (txins !! i) { scriptInput = runPutS $ serialize out } ] + [(txins !! i){scriptInput = runPutS $ serialize out}] | isSigHashAll sh || isSigHashUnknown sh = single | otherwise = zipWith noSeq single [0 ..] where - emptyIn = map (\ti -> ti { scriptInput = BS.empty }) txins + emptyIn = map (\ti -> ti{scriptInput = BS.empty}) txins single = - updateIndex i emptyIn $ \ti -> ti { scriptInput = runPutS $ serialize out } + updateIndex i emptyIn $ \ti -> ti{scriptInput = runPutS $ serialize out} noSeq ti j = if i == j - then ti - else ti { txInSequence = 0 } + then ti + else ti{txInSequence = 0} -- | Build transaction outputs for computing sighashes. buildOutputs :: [TxOut] -> Int -> SigHash -> Maybe [TxOut] @@ -242,16 +252,23 @@ where buffer = replicate i $ TxOut maxBound BS.empty --- | Compute the hash that will be used for signing a transaction. This --- function is used when the 'SIGHASH_FORKID' flag is set. -txSigHashForkId - :: Network - -> Tx -- ^ transaction to sign - -> Script -- ^ script from output being spent - -> Word64 -- ^ value of output being spent - -> Int -- ^ index of input being signed - -> SigHash -- ^ what to sign - -> Hash256 -- ^ hash to be signed +{- | Compute the hash that will be used for signing a transaction. This + function is used when the 'SIGHASH_FORKID' flag is set. +-} +txSigHashForkId :: + Network -> + -- | transaction to sign + Tx -> + -- | script from output being spent + Script -> + -- | value of output being spent + Word64 -> + -- | index of input being signed + Int -> + -- | what to sign + SigHash -> + -- | hash to be signed + Hash256 txSigHashForkId net tx out v i sh = doubleSHA256 . runPutS $ do putWord32le $ txVersion tx @@ -270,8 +287,9 @@ doubleSHA256 $ runPutS $ mapM_ (serialize . prevOutput) $ txIn tx | otherwise = zeros hashSequence - | not (hasAnyoneCanPayFlag sh) && - not (isSigHashSingle sh) && not (isSigHashNone sh) = + | not (hasAnyoneCanPayFlag sh) + && not (isSigHashSingle sh) + && not (isSigHashNone sh) = doubleSHA256 $ runPutS $ mapM_ (putWord32le . txInSequence) $ txIn tx | otherwise = zeros hashOutputs @@ -287,14 +305,15 @@ zeros :: Hash256 zeros = "0000000000000000000000000000000000000000000000000000000000000000" --- | Data type representing a signature together with a 'SigHash'. The 'SigHash' --- is serialized as one byte at the end of an ECDSA 'Sig'. All signatures in --- transaction inputs are of type 'TxSignature'. +{- | Data type representing a signature together with a 'SigHash'. The 'SigHash' + is serialized as one byte at the end of an ECDSA 'Sig'. All signatures in + transaction inputs are of type 'TxSignature'. +-} data TxSignature = TxSignature - { txSignature :: !Sig - , txSignatureSigHash :: !SigHash - } + { txSignature :: !Sig + , txSignatureSigHash :: !SigHash + } | TxSignatureEmpty deriving (Eq, Show, Generic) @@ -308,7 +327,7 @@ -- | Deserialize a 'TxSignature'. decodeTxSig :: Network -> BS.ByteString -> Either String TxSignature -decodeTxSig _ bs | BS.null bs = Left "Empty signature candidate" +decodeTxSig _ bs | BS.null bs = Left "Empty signature candidate" decodeTxSig net bs = case decodeStrictSig $ BS.init bs of Just sig -> do diff --git a/src/Haskoin/Script/Standard.hs b/src/Haskoin/Script/Standard.hs --- a/src/Haskoin/Script/Standard.hs +++ b/src/Haskoin/Script/Standard.hs @@ -1,7 +1,8 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} -{-| + +{- | Module : Haskoin.Script.Standard Copyright : No rights reserved License : MIT @@ -12,92 +13,97 @@ Standard scripts like pay-to-public-key, pay-to-public-key-hash, pay-to-script-hash, pay-to-multisig and corresponding SegWit variants. -} -module Haskoin.Script.Standard - ( -- * Standard Script Outputs - ScriptOutput(..) - , RedeemScript - , isPayPK - , isPayPKHash - , isPayMulSig - , isPayScriptHash - , isPayWitness - , isPayWitnessPKHash - , isPayWitnessScriptHash - , isDataCarrier - , encodeOutput - , encodeOutputBS - , decodeOutput - , decodeOutputBS - , toP2SH - , toP2WSH - , sortMulSig +module Haskoin.Script.Standard ( + -- * Standard Script Outputs + ScriptOutput (..), + RedeemScript, + isPayPK, + isPayPKHash, + isPayMulSig, + isPayScriptHash, + isPayWitness, + isPayWitnessPKHash, + isPayWitnessScriptHash, + isDataCarrier, + encodeOutput, + encodeOutputBS, + decodeOutput, + decodeOutputBS, + toP2SH, + toP2WSH, + sortMulSig, + -- * Standard Script Inputs - , ScriptInput(..) - , SimpleInput(..) - , encodeInput - , encodeInputBS - , decodeInput - , decodeInputBS - , isSpendPK - , isSpendPKHash - , isSpendMulSig - , isScriptHashInput - ) where + ScriptInput (..), + SimpleInput (..), + encodeInput, + encodeInputBS, + decodeInput, + decodeInputBS, + isSpendPK, + isSpendPKHash, + isSpendMulSig, + isScriptHashInput, +) where -import Control.Applicative ((<|>)) -import Control.DeepSeq -import Control.Monad (guard, liftM2, (<=<)) -import qualified Data.Aeson as A -import qualified Data.Aeson.Encoding as A -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import Data.Function (on) -import Data.Hashable -import Data.List (sortBy) -import Data.Maybe (fromJust, isJust) -import Data.Word (Word8) -import GHC.Generics (Generic) -import Haskoin.Constants -import Haskoin.Crypto -import Haskoin.Keys.Common -import Haskoin.Script.Common -import Haskoin.Script.SigHash -import Haskoin.Util +import Control.Applicative ((<|>)) +import Control.DeepSeq +import Control.Monad (guard, liftM2, (<=<)) +import qualified Data.Aeson as A +import qualified Data.Aeson.Encoding as A +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.Function (on) +import Data.Hashable +import Data.List (sortBy) +import Data.Maybe (fromJust, isJust) +import Data.Word (Word8) +import GHC.Generics (Generic) +import Haskoin.Crypto +import Haskoin.Data +import Haskoin.Keys.Common +import Haskoin.Script.Common +import Haskoin.Script.SigHash +import Haskoin.Util --- | Data type describing standard transaction output scripts. Output scripts --- provide the conditions that must be fulfilled for someone to spend the funds --- in a transaction output. +{- | Data type describing standard transaction output scripts. Output scripts + provide the conditions that must be fulfilled for someone to spend the funds + in a transaction output. +-} data ScriptOutput - -- | pay to public key - = PayPK { getOutputPubKey :: !PubKeyI } - -- | pay to public key hash - | PayPKHash { getOutputHash :: !Hash160 } - -- | multisig - | PayMulSig { getOutputMulSigKeys :: ![PubKeyI] - , getOutputMulSigRequired :: !Int } - -- | pay to a script hash - | PayScriptHash { getOutputHash :: !Hash160 } - -- | pay to witness public key hash - | PayWitnessPKHash { getOutputHash :: !Hash160 } - -- | pay to witness script hash - | PayWitnessScriptHash { getScriptHash :: !Hash256 } - -- | another pay to witness address - | PayWitness { getWitnessVersion :: !Word8 - , getWitnessData :: !ByteString - } - -- | provably unspendable data carrier - | DataCarrier { getOutputData :: !ByteString } + = -- | pay to public key + PayPK {getOutputPubKey :: !PubKeyI} + | -- | pay to public key hash + PayPKHash {getOutputHash :: !Hash160} + | -- | multisig + PayMulSig + { getOutputMulSigKeys :: ![PubKeyI] + , getOutputMulSigRequired :: !Int + } + | -- | pay to a script hash + PayScriptHash {getOutputHash :: !Hash160} + | -- | pay to witness public key hash + PayWitnessPKHash {getOutputHash :: !Hash160} + | -- | pay to witness script hash + PayWitnessScriptHash {getScriptHash :: !Hash256} + | -- | another pay to witness address + PayWitness + { getWitnessVersion :: !Word8 + , getWitnessData :: !ByteString + } + | -- | provably unspendable data carrier + DataCarrier {getOutputData :: !ByteString} deriving (Eq, Show, Read, Generic, Hashable, NFData) instance A.FromJSON ScriptOutput where parseJSON = A.withText "scriptoutput" $ \t -> either fail return $ - maybeToEither "scriptoutput not hex" (decodeHex t) >>= - decodeOutputBS + maybeToEither "scriptoutput not hex" (decodeHex t) + >>= decodeOutputBS instance A.ToJSON ScriptOutput where toJSON = A.String . encodeHex . encodeOutputBS @@ -106,45 +112,46 @@ -- | Is script a pay-to-public-key output? isPayPK :: ScriptOutput -> Bool isPayPK (PayPK _) = True -isPayPK _ = False +isPayPK _ = False -- | Is script a pay-to-pub-key-hash output? isPayPKHash :: ScriptOutput -> Bool isPayPKHash (PayPKHash _) = True -isPayPKHash _ = False +isPayPKHash _ = False -- | Is script a pay-to-multi-sig output? isPayMulSig :: ScriptOutput -> Bool isPayMulSig (PayMulSig _ _) = True -isPayMulSig _ = False +isPayMulSig _ = False -- | Is script a pay-to-script-hash output? isPayScriptHash :: ScriptOutput -> Bool isPayScriptHash (PayScriptHash _) = True -isPayScriptHash _ = False +isPayScriptHash _ = False -- | Is script a pay-to-witness-pub-key-hash output? isPayWitnessPKHash :: ScriptOutput -> Bool isPayWitnessPKHash (PayWitnessPKHash _) = True -isPayWitnessPKHash _ = False +isPayWitnessPKHash _ = False -- | Is script a pay-to-witness-script-hash output? isPayWitnessScriptHash :: ScriptOutput -> Bool isPayWitnessScriptHash (PayWitnessScriptHash _) = True -isPayWitnessScriptHash _ = False +isPayWitnessScriptHash _ = False -- | Is script paying to a different type of witness address? isPayWitness :: ScriptOutput -> Bool isPayWitness (PayWitness _ _) = True -isPayWitness _ = False +isPayWitness _ = False -- | Is script a data carrier output? isDataCarrier :: ScriptOutput -> Bool isDataCarrier (DataCarrier _) = True -isDataCarrier _ = False +isDataCarrier _ = False --- | Tries to decode a 'ScriptOutput' from a 'Script'. This can fail if the --- script is not recognized as any of the standard output types. +{- | Tries to decode a 'ScriptOutput' from a 'Script'. This can fail if the + script is not recognized as any of the standard output types. +-} decodeOutput :: Script -> Either String ScriptOutput decodeOutput s = case scriptOps s of -- Pay to PubKey @@ -154,18 +161,18 @@ PayPKHash <$> runGetS deserialize bs -- Pay to Script Hash [OP_HASH160, OP_PUSHDATA bs _, OP_EQUAL] -> - PayScriptHash <$> runGetS deserialize bs + PayScriptHash <$> runGetS deserialize bs -- Pay to Witness [OP_0, OP_PUSHDATA bs OPCODE] - | BS.length bs == 20 -> PayWitnessPKHash <$> runGetS deserialize bs - | BS.length bs == 32 -> PayWitnessScriptHash <$> runGetS deserialize bs - | BS.length bs /= 20 && BS.length bs /= 32 -> + | BS.length bs == 20 -> PayWitnessPKHash <$> runGetS deserialize bs + | BS.length bs == 32 -> PayWitnessScriptHash <$> runGetS deserialize bs + | BS.length bs /= 20 && BS.length bs /= 32 -> Left "Version 0 segwit program must be 20 or 32 bytes long" -- Other Witness [ver, OP_PUSHDATA bs _] - | isJust (opWitnessVersion ver) - && BS.length bs >= 2 - && BS.length bs <= 40 -> + | isJust (opWitnessVersion ver) + && BS.length bs >= 2 + && BS.length bs <= 40 -> Right $ PayWitness (fromJust (opWitnessVersion ver)) bs -- Provably unspendable data carrier output [OP_RETURN, OP_PUSHDATA bs _] -> Right $ DataCarrier bs @@ -173,16 +180,16 @@ _ -> matchPayMulSig s witnessVersionOp :: Word8 -> Maybe ScriptOp -witnessVersionOp 0 = Just OP_0 -witnessVersionOp 1 = Just OP_1 -witnessVersionOp 2 = Just OP_2 -witnessVersionOp 3 = Just OP_3 -witnessVersionOp 4 = Just OP_4 -witnessVersionOp 5 = Just OP_5 -witnessVersionOp 6 = Just OP_6 -witnessVersionOp 7 = Just OP_7 -witnessVersionOp 8 = Just OP_8 -witnessVersionOp 9 = Just OP_9 +witnessVersionOp 0 = Just OP_0 +witnessVersionOp 1 = Just OP_1 +witnessVersionOp 2 = Just OP_2 +witnessVersionOp 3 = Just OP_3 +witnessVersionOp 4 = Just OP_4 +witnessVersionOp 5 = Just OP_5 +witnessVersionOp 6 = Just OP_6 +witnessVersionOp 7 = Just OP_7 +witnessVersionOp 8 = Just OP_8 +witnessVersionOp 9 = Just OP_9 witnessVersionOp 10 = Just OP_10 witnessVersionOp 11 = Just OP_11 witnessVersionOp 12 = Just OP_12 @@ -193,16 +200,16 @@ witnessVersionOp _ = Nothing opWitnessVersion :: ScriptOp -> Maybe Word8 -opWitnessVersion OP_0 = Just 0 -opWitnessVersion OP_1 = Just 1 -opWitnessVersion OP_2 = Just 2 -opWitnessVersion OP_3 = Just 3 -opWitnessVersion OP_4 = Just 4 -opWitnessVersion OP_5 = Just 5 -opWitnessVersion OP_6 = Just 6 -opWitnessVersion OP_7 = Just 7 -opWitnessVersion OP_8 = Just 8 -opWitnessVersion OP_9 = Just 9 +opWitnessVersion OP_0 = Just 0 +opWitnessVersion OP_1 = Just 1 +opWitnessVersion OP_2 = Just 2 +opWitnessVersion OP_3 = Just 3 +opWitnessVersion OP_4 = Just 4 +opWitnessVersion OP_5 = Just 5 +opWitnessVersion OP_6 = Just 6 +opWitnessVersion OP_7 = Just 7 +opWitnessVersion OP_8 = Just 8 +opWitnessVersion OP_9 = Just 9 opWitnessVersion OP_10 = Just 10 opWitnessVersion OP_11 = Just 11 opWitnessVersion OP_12 = Just 12 @@ -210,8 +217,7 @@ opWitnessVersion OP_14 = Just 14 opWitnessVersion OP_15 = Just 15 opWitnessVersion OP_16 = Just 16 -opWitnessVersion _ = Nothing - +opWitnessVersion _ = Nothing -- | Similar to 'decodeOutput' but decodes from a 'ByteString'. decodeOutputBS :: ByteString -> Either String ScriptOutput @@ -227,29 +233,31 @@ [ OP_DUP , OP_HASH160 , opPushData $ runPutS $ serialize h - , OP_EQUALVERIFY, OP_CHECKSIG + , OP_EQUALVERIFY + , OP_CHECKSIG ] -- Pay to MultiSig Keys (PayMulSig ps r) - | r <= length ps -> - let opM = intToScriptOp r - opN = intToScriptOp $ length ps - keys = map (opPushData . runPutS . serialize) ps - in opM : keys ++ [opN, OP_CHECKMULTISIG] - | otherwise -> error "encodeOutput: PayMulSig r must be <= than pkeys" + | r <= length ps -> + let opM = intToScriptOp r + opN = intToScriptOp $ length ps + keys = map (opPushData . runPutS . serialize) ps + in opM : keys ++ [opN, OP_CHECKMULTISIG] + | otherwise -> error "encodeOutput: PayMulSig r must be <= than pkeys" -- Pay to Script Hash Address (PayScriptHash h) -> - [ OP_HASH160, opPushData $ runPutS $ serialize h, OP_EQUAL] + [OP_HASH160, opPushData $ runPutS $ serialize h, OP_EQUAL] -- Pay to Witness PubKey Hash Address (PayWitnessPKHash h) -> - [ OP_0, opPushData $ runPutS $ serialize h ] + [OP_0, opPushData $ runPutS $ serialize h] (PayWitnessScriptHash h) -> - [ OP_0, opPushData $ runPutS $ serialize h ] + [OP_0, opPushData $ runPutS $ serialize h] (PayWitness v h) -> [ case witnessVersionOp v of - Nothing -> error "encodeOutput: invalid witness version" - Just c -> c - , opPushData h ] + Nothing -> error "encodeOutput: invalid witness version" + Just c -> c + , opPushData h + ] -- Provably unspendable output (DataCarrier d) -> [OP_RETURN, opPushData d] @@ -268,81 +276,88 @@ -- | Match @[OP_N, PubKey1, ..., PubKeyM, OP_M, OP_CHECKMULTISIG]@ matchPayMulSig :: Script -> Either String ScriptOutput matchPayMulSig (Script ops) = case splitAt (length ops - 2) ops of - (m:xs,[n,OP_CHECKMULTISIG]) -> do - (intM,intN) <- liftM2 (,) (scriptOpToInt m) (scriptOpToInt n) + (m : xs, [n, OP_CHECKMULTISIG]) -> do + (intM, intN) <- liftM2 (,) (scriptOpToInt m) (scriptOpToInt n) if intM <= intN && length xs == intN then liftM2 PayMulSig (go xs) (return intM) else Left "matchPayMulSig: Invalid M or N parameters" _ -> Left "matchPayMulSig: script did not match output template" where - go (OP_PUSHDATA bs _:xs) = liftM2 (:) (runGetS deserialize bs) (go xs) - go [] = return [] - go _ = Left "matchPayMulSig: invalid multisig opcode" + go (OP_PUSHDATA bs _ : xs) = liftM2 (:) (runGetS deserialize bs) (go xs) + go [] = return [] + go _ = Left "matchPayMulSig: invalid multisig opcode" --- | Sort the public keys of a multisig output in ascending order by comparing --- their compressed serialized representations. Refer to BIP-67. +{- | Sort the public keys of a multisig output in ascending order by comparing + their compressed serialized representations. Refer to BIP-67. +-} sortMulSig :: ScriptOutput -> ScriptOutput sortMulSig out = case out of PayMulSig keys r -> PayMulSig (sortBy (compare `on` (runPutS . serialize)) keys) r - _ -> error "Can only call orderMulSig on PayMulSig scripts" + _ -> error "Can only call orderMulSig on PayMulSig scripts" --- | Data type describing standard transaction input scripts. Input scripts --- provide the signing data required to unlock the coins of the output they are --- trying to spend, except in pay-to-witness-public-key-hash and --- pay-to-script-hash transactions. -data SimpleInput = SpendPK - { getInputSig :: !TxSignature - -- ^ transaction signature - } +{- | Data type describing standard transaction input scripts. Input scripts + provide the signing data required to unlock the coins of the output they are + trying to spend, except in pay-to-witness-public-key-hash and + pay-to-script-hash transactions. +-} +data SimpleInput + = SpendPK + { -- | transaction signature + getInputSig :: !TxSignature + } | SpendPKHash - { getInputSig :: !TxSignature - -- ^ embedded signature - , getInputKey :: !PubKeyI - -- ^ public key - } + { -- | embedded signature + getInputSig :: !TxSignature + , -- | public key + getInputKey :: !PubKeyI + } | SpendMulSig - { getInputMulSigKeys :: ![TxSignature] - -- ^ list of signatures - } + { -- | list of signatures + getInputMulSigKeys :: ![TxSignature] + } deriving (Eq, Show, Generic, NFData) --- | Returns true if the input script is spending from a pay-to-public-key --- output. +{- | Returns true if the input script is spending from a pay-to-public-key + output. +-} isSpendPK :: ScriptInput -> Bool isSpendPK (RegularInput (SpendPK _)) = True -isSpendPK _ = False +isSpendPK _ = False --- | Returns true if the input script is spending from a pay-to-public-key-hash --- output. +{- | Returns true if the input script is spending from a pay-to-public-key-hash + output. +-} isSpendPKHash :: ScriptInput -> Bool isSpendPKHash (RegularInput (SpendPKHash _ _)) = True -isSpendPKHash _ = False +isSpendPKHash _ = False -- | Returns true if the input script is spending a multisig output. isSpendMulSig :: ScriptInput -> Bool isSpendMulSig (RegularInput (SpendMulSig _)) = True -isSpendMulSig _ = False +isSpendMulSig _ = False -- | Returns true if the input script is spending a pay-to-script-hash output. isScriptHashInput :: ScriptInput -> Bool isScriptHashInput (ScriptHashInput _ _) = True -isScriptHashInput _ = False +isScriptHashInput _ = False --- | A redeem script is the output script serialized into the spending input --- script. It must be included in inputs that spend pay-to-script-hash outputs. +{- | A redeem script is the output script serialized into the spending input + script. It must be included in inputs that spend pay-to-script-hash outputs. +-} type RedeemScript = ScriptOutput -- | Standard input script high-level representation. -data ScriptInput = RegularInput - { getRegularInput :: !SimpleInput - -- ^ get wrapped simple input - } +data ScriptInput + = RegularInput + { -- | get wrapped simple input + getRegularInput :: !SimpleInput + } | ScriptHashInput - { getScriptHashInput :: !SimpleInput - -- ^ get simple input associated with redeem script - , getScriptHashRedeem :: !RedeemScript - -- ^ redeem script - } + { -- | get simple input associated with redeem script + getScriptHashInput :: !SimpleInput + , -- | redeem script + getScriptHashRedeem :: !RedeemScript + } deriving (Eq, Show, Generic, NFData) -- | Heuristic to decode an input script into one of the standard types. @@ -351,22 +366,23 @@ maybeToEither errMsg $ matchPK ops <|> matchPKHash ops <|> matchMulSig ops where matchPK [op] = SpendPK <$> f op - matchPK _ = Nothing + matchPK _ = Nothing matchPKHash [op, OP_PUSHDATA pub _] = SpendPKHash <$> f op <*> eitherToMaybe (runGetS deserialize pub) matchPKHash _ = Nothing - matchMulSig (x:xs) = do + matchMulSig (x : xs) = do guard $ x == OP_0 SpendMulSig <$> mapM f xs matchMulSig _ = Nothing - f OP_0 = return TxSignatureEmpty + f OP_0 = return TxSignatureEmpty f (OP_PUSHDATA "" OPCODE) = f OP_0 - f (OP_PUSHDATA bs _) = eitherToMaybe $ decodeTxSig net bs - f _ = Nothing + f (OP_PUSHDATA bs _) = eitherToMaybe $ decodeTxSig net bs + f _ = Nothing errMsg = "decodeInput: Could not decode script input" --- | Heuristic to decode a 'ScriptInput' from a 'Script'. This function fails if --- the script can not be parsed as a standard script input. +{- | Heuristic to decode a 'ScriptInput' from a 'Script'. This function fails if + the script can not be parsed as a standard script input. +-} decodeInput :: Network -> Script -> Either String ScriptInput decodeInput net s@(Script ops) = maybeToEither errMsg $ matchSimpleInput <|> matchPayScriptHash @@ -382,8 +398,9 @@ _ -> Nothing errMsg = "decodeInput: Could not decode script input" --- | Like 'decodeInput' but decodes directly from a serialized script --- 'ByteString'. +{- | Like 'decodeInput' but decodes directly from a serialized script + 'ByteString'. +-} decodeInputBS :: Network -> ByteString -> Either String ScriptInput decodeInputBS net = decodeInput net <=< runGetS deserialize @@ -391,11 +408,13 @@ encodeInput :: ScriptInput -> Script encodeInput s = case s of RegularInput ri -> encodeSimpleInput ri - ScriptHashInput i o -> Script $ - scriptOps (encodeSimpleInput i) ++ [opPushData $ encodeOutputBS o] + ScriptHashInput i o -> + Script $ + scriptOps (encodeSimpleInput i) ++ [opPushData $ encodeOutputBS o] --- | Similar to 'encodeInput' but encodes directly to a serialized script --- 'ByteString'. +{- | Similar to 'encodeInput' but encodes directly to a serialized script + 'ByteString'. +-} encodeInputBS :: ScriptInput -> ByteString encodeInputBS = runPutS . serialize . encodeInput @@ -403,11 +422,10 @@ encodeSimpleInput :: SimpleInput -> Script encodeSimpleInput s = Script $ - case s of - SpendPK ts -> [f ts] - SpendPKHash ts p -> [f ts, opPushData $ runPutS $ serialize p] - SpendMulSig xs -> OP_0 : map f xs + case s of + SpendPK ts -> [f ts] + SpendPKHash ts p -> [f ts, opPushData $ runPutS $ serialize p] + SpendMulSig xs -> OP_0 : map f xs where f TxSignatureEmpty = OP_0 - f ts = opPushData $ encodeTxSig ts - + f ts = opPushData $ encodeTxSig ts diff --git a/src/Haskoin/Transaction.hs b/src/Haskoin/Transaction.hs --- a/src/Haskoin/Transaction.hs +++ b/src/Haskoin/Transaction.hs @@ -1,4 +1,4 @@ -{-| +{- | Module : Haskoin.Transaction Copyright : No rights reserved License : MIT @@ -8,14 +8,18 @@ Transactions and related code. -} -module Haskoin.Transaction - ( module Common - , module Builder - , module Segwit - , module Partial - ) where +module Haskoin.Transaction ( + module Common, + module Builder, + module Segwit, + module Taproot, + module Partial, + module Genesis, +) where -import Haskoin.Transaction.Builder as Builder -import Haskoin.Transaction.Common as Common -import Haskoin.Transaction.Partial as Partial -import Haskoin.Transaction.Segwit as Segwit +import Haskoin.Transaction.Builder as Builder +import Haskoin.Transaction.Common as Common +import Haskoin.Transaction.Genesis as Genesis +import Haskoin.Transaction.Partial as Partial +import Haskoin.Transaction.Segwit as Segwit +import Haskoin.Transaction.Taproot as Taproot diff --git a/src/Haskoin/Transaction/Builder.hs b/src/Haskoin/Transaction/Builder.hs --- a/src/Haskoin/Transaction/Builder.hs +++ b/src/Haskoin/Transaction/Builder.hs @@ -1,7 +1,8 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-| + +{- | Module : Haskoin.Transaction.Builder Copyright : No rights reserved License : MIT @@ -12,195 +13,246 @@ Code to simplify transaction creation, signing, fee calculation and coin selection. -} -module Haskoin.Transaction.Builder - ( -- * Transaction Builder - buildAddrTx - , buildTx - , buildInput - , SigInput(..) - , signTx - , signNestedWitnessTx - , makeSignature - , signInput - , signNestedInput - , verifyStdTx - , mergeTxs - , sigKeys - , mergeTxInput - , findSigInput - , verifyStdInput - -- * Coin Selection - , Coin(..) - , chooseCoins - , chooseCoinsSink - , chooseMSCoins - , chooseMSCoinsSink - , countMulSig - , greedyAddSink - , guessTxFee - , guessMSTxFee - , guessTxSize - , guessMSSize - ) where +module Haskoin.Transaction.Builder ( + -- * Transaction Builder + buildAddrTx, + buildTx, + buildInput, + SigInput (..), + signTx, + signNestedWitnessTx, + makeSignature, + signInput, + signNestedInput, + verifyStdTx, + mergeTxs, + sigKeys, + mergeTxInput, + findSigInput, + verifyStdInput, -import Control.Applicative ((<|>)) -import Control.Arrow (first) -import Control.Monad (foldM, unless) -import Control.Monad.Identity (runIdentity) -import Crypto.Secp256k1 -import qualified Data.ByteString as B -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import Data.Conduit (ConduitT, Void, await, - runConduit, (.|)) -import Data.Conduit.List (sourceList) -import Data.Either (fromRight) -import Data.List (nub) -import Data.Maybe (catMaybes, fromJust, isJust) -import Data.String.Conversions (cs) -import Data.Text (Text) -import Data.Word (Word64) -import Haskoin.Address -import Haskoin.Constants -import Haskoin.Crypto.Hash (Hash256, addressHash) -import Haskoin.Crypto.Signature -import Haskoin.Keys.Common -import Haskoin.Network.Common -import Haskoin.Script -import Haskoin.Transaction.Builder.Sign (SigInput (..), buildInput, - makeSignature, sigKeys) + -- * Coin Selection + Coin (..), + chooseCoins, + chooseCoinsSink, + chooseMSCoins, + chooseMSCoinsSink, + countMulSig, + greedyAddSink, + guessTxFee, + guessMSTxFee, + guessTxSize, + guessMSSize, +) where + +import Control.Applicative ((<|>)) +import Control.Arrow (first) +import Control.Monad (foldM, unless) +import Control.Monad.Identity (runIdentity) +import Crypto.Secp256k1 +import qualified Data.ByteString as B +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.Conduit ( + ConduitT, + Void, + await, + runConduit, + (.|), + ) +import Data.Conduit.List (sourceList) +import Data.Either (fromRight) +import Data.List (nub) +import Data.Maybe (catMaybes, fromJust, isJust) +import Data.String.Conversions (cs) +import Data.Text (Text) +import Data.Word (Word64) +import Haskoin.Address +import Haskoin.Crypto.Hash (Hash256, addressHash) +import Haskoin.Crypto.Signature +import Haskoin.Data +import Haskoin.Keys.Common +import Haskoin.Network.Common +import Haskoin.Script +import Haskoin.Transaction.Builder.Sign ( + SigInput (..), + buildInput, + makeSignature, + sigKeys, + ) import qualified Haskoin.Transaction.Builder.Sign as S -import Haskoin.Transaction.Common -import Haskoin.Transaction.Segwit (decodeWitnessInput, isSegwit, - viewWitnessProgram) -import Haskoin.Util +import Haskoin.Transaction.Common +import Haskoin.Transaction.Segwit ( + decodeWitnessInput, + isSegwit, + viewWitnessProgram, + ) +import Haskoin.Util --- | Any type can be used as a Coin if it can provide a value in Satoshi. --- The value is used in coin selection algorithms. +{- | Any type can be used as a Coin if it can provide a value in Satoshi. + The value is used in coin selection algorithms. +-} class Coin c where coinValue :: c -> Word64 --- | Coin selection algorithm for normal (non-multisig) transactions. This --- function returns the selected coins together with the amount of change to --- send back to yourself, taking the fee into account. -chooseCoins :: Coin c - => Word64 -- ^ value to send - -> Word64 -- ^ fee per byte - -> Int -- ^ number of outputs (including change) - -> Bool -- ^ try to find better solutions - -> [c] -- ^ list of ordered coins to choose from - -> Either String ([c], Word64) - -- ^ coin selection and change +{- | Coin selection algorithm for normal (non-multisig) transactions. This + function returns the selected coins together with the amount of change to + send back to yourself, taking the fee into account. +-} +chooseCoins :: + Coin c => + -- | value to send + Word64 -> + -- | fee per byte + Word64 -> + -- | number of outputs (including change) + Int -> + -- | try to find better solutions + Bool -> + -- | list of ordered coins to choose from + [c] -> + -- | coin selection and change + Either String ([c], Word64) chooseCoins target fee nOut continue coins = runIdentity . runConduit $ - sourceList coins .| chooseCoinsSink target fee nOut continue + sourceList coins .| chooseCoinsSink target fee nOut continue --- | Coin selection algorithm for normal (non-multisig) transactions. This --- function returns the selected coins together with the amount of change to --- send back to yourself, taking the fee into account. This version uses a Sink --- for conduit-based coin selection. -chooseCoinsSink :: (Monad m, Coin c) - => Word64 -- ^ value to send - -> Word64 -- ^ fee per byte - -> Int -- ^ number of outputs (including change) - -> Bool -- ^ try to find better solution - -> ConduitT c Void m (Either String ([c], Word64)) - -- ^ coin selection and change +{- | Coin selection algorithm for normal (non-multisig) transactions. This + function returns the selected coins together with the amount of change to + send back to yourself, taking the fee into account. This version uses a Sink + for conduit-based coin selection. +-} +chooseCoinsSink :: + (Monad m, Coin c) => + -- | value to send + Word64 -> + -- | fee per byte + Word64 -> + -- | number of outputs (including change) + Int -> + -- | try to find better solution + Bool -> + -- | coin selection and change + ConduitT c Void m (Either String ([c], Word64)) chooseCoinsSink target fee nOut continue | target > 0 = - maybeToEither err <$> - greedyAddSink target (guessTxFee fee nOut) continue + maybeToEither err + <$> greedyAddSink target (guessTxFee fee nOut) continue | otherwise = return $ Left "chooseCoins: Target must be > 0" where err = "chooseCoins: No solution found" --- | Coin selection algorithm for multisig transactions. This function returns --- the selected coins together with the amount of change to send back to --- yourself, taking the fee into account. This function assumes all the coins --- are script hash outputs that send funds to a multisignature address. -chooseMSCoins :: Coin c - => Word64 -- ^ value to send - -> Word64 -- ^ fee per byte - -> (Int, Int) -- ^ m of n multisig - -> Int -- ^ number of outputs (including change) - -> Bool -- ^ try to find better solution - -> [c] - -> Either String ([c], Word64) - -- ^ coin selection change amount +{- | Coin selection algorithm for multisig transactions. This function returns + the selected coins together with the amount of change to send back to + yourself, taking the fee into account. This function assumes all the coins + are script hash outputs that send funds to a multisignature address. +-} +chooseMSCoins :: + Coin c => + -- | value to send + Word64 -> + -- | fee per byte + Word64 -> + -- | m of n multisig + (Int, Int) -> + -- | number of outputs (including change) + Int -> + -- | try to find better solution + Bool -> + [c] -> + -- | coin selection change amount + Either String ([c], Word64) chooseMSCoins target fee ms nOut continue coins = runIdentity . runConduit $ sourceList coins .| chooseMSCoinsSink target fee ms nOut continue --- | Coin selection algorithm for multisig transactions. This function returns --- the selected coins together with the amount of change to send back to --- yourself, taking the fee into account. This function assumes all the coins --- are script hash outputs that send funds to a multisignature address. This --- version uses a Sink if you need conduit-based coin selection. -chooseMSCoinsSink :: (Monad m, Coin c) - => Word64 -- ^ value to send - -> Word64 -- ^ fee per byte - -> (Int, Int) -- ^ m of n multisig - -> Int -- ^ number of outputs (including change) - -> Bool -- ^ try to find better solution - -> ConduitT c Void m (Either String ([c], Word64)) - -- ^ coin selection and change +{- | Coin selection algorithm for multisig transactions. This function returns + the selected coins together with the amount of change to send back to + yourself, taking the fee into account. This function assumes all the coins + are script hash outputs that send funds to a multisignature address. This + version uses a Sink if you need conduit-based coin selection. +-} +chooseMSCoinsSink :: + (Monad m, Coin c) => + -- | value to send + Word64 -> + -- | fee per byte + Word64 -> + -- | m of n multisig + (Int, Int) -> + -- | number of outputs (including change) + Int -> + -- | try to find better solution + Bool -> + -- | coin selection and change + ConduitT c Void m (Either String ([c], Word64)) chooseMSCoinsSink target fee ms nOut continue | target > 0 = - maybeToEither err <$> - greedyAddSink target (guessMSTxFee fee ms nOut) continue + maybeToEither err + <$> greedyAddSink target (guessMSTxFee fee ms nOut) continue | otherwise = return $ Left "chooseMSCoins: Target must be > 0" where err = "chooseMSCoins: No solution found" --- | Select coins greedily by starting from an empty solution. If the 'continue' --- flag is set, the algorithm will try to find a better solution in the stream --- after a solution is found. If the next solution found is not strictly better --- than the previously found solution, the algorithm stops and returns the --- previous solution. If the continue flag is not set, the algorithm will return --- the first solution it finds in the stream. -greedyAddSink :: (Monad m, Coin c) - => Word64 -- ^ value to send - -> (Int -> Word64) -- ^ coin count to fee function - -> Bool -- ^ try to find better solutions - -> ConduitT c Void m (Maybe ([c], Word64)) - -- ^ coin selection and change +{- | Select coins greedily by starting from an empty solution. If the 'continue' + flag is set, the algorithm will try to find a better solution in the stream + after a solution is found. If the next solution found is not strictly better + than the previously found solution, the algorithm stops and returns the + previous solution. If the continue flag is not set, the algorithm will return + the first solution it finds in the stream. +-} +greedyAddSink :: + (Monad m, Coin c) => + -- | value to send + Word64 -> + -- | coin count to fee function + (Int -> Word64) -> + -- | try to find better solutions + Bool -> + -- | coin selection and change + ConduitT c Void m (Maybe ([c], Word64)) greedyAddSink target guessFee continue = go [] 0 [] 0 where -- The goal is the value we must reach (including the fee) for a certain -- amount of selected coins. goal c = target + guessFee c - go acc aTot ps pTot = await >>= \case - -- A coin is available in the stream - Just coin -> do - let val = coinValue coin - -- We have reached the goal using this coin - if val + aTot >= goal (length acc + 1) - -- If we want to continue searching for better solutions - then if continue - -- This solution is the first one or - -- This solution is better than the previous one - then if pTot == 0 || val + aTot < pTot - -- Continue searching for better solutions in the stream - then go [] 0 (coin:acc) (val + aTot) - -- Otherwise, we stop here and return the previous - -- solution - else return $ Just (ps, pTot - goal (length ps)) - -- Otherwise, return this solution - else return $ - Just (coin : acc, val + aTot - goal (length acc + 1)) - -- We have not yet reached the goal. Add the coin to the - -- accumulator - else go (coin:acc) (val + aTot) ps pTot - -- We reached the end of the stream - Nothing -> - return $ if null ps - -- If no solution was found, return Nothing - then Nothing - -- If we have a solution, return it - else Just (ps, pTot - goal (length ps)) + go acc aTot ps pTot = + await >>= \case + -- A coin is available in the stream + Just coin -> do + let val = coinValue coin + -- We have reached the goal using this coin + if val + aTot >= goal (length acc + 1) + then -- If we want to continue searching for better solutions + if continue + then -- This solution is the first one or + -- This solution is better than the previous one + + if pTot == 0 || val + aTot < pTot + then -- Continue searching for better solutions in the stream + go [] 0 (coin : acc) (val + aTot) + else -- Otherwise, we stop here and return the previous + -- solution + return $ Just (ps, pTot - goal (length ps)) + else -- Otherwise, return this solution + + return $ + Just (coin : acc, val + aTot - goal (length acc + 1)) + else -- We have not yet reached the goal. Add the coin to the + -- accumulator + go (coin : acc) (val + aTot) ps pTot + -- We reached the end of the stream + Nothing -> + return $ + if null ps + then -- If no solution was found, return Nothing + Nothing + else -- If we have a solution, return it + Just (ps, pTot - goal (length ps)) + -- | Estimate tranasction fee to pay based on transaction size estimation. guessTxFee :: Word64 -> Int -> Int -> Word64 guessTxFee byteFee nOut nIn = @@ -211,58 +263,68 @@ guessMSTxFee byteFee ms nOut nIn = byteFee * fromIntegral (guessTxSize 0 (replicate nIn ms) nOut 0) --- | Computes an upper bound on the size of a transaction based on some known --- properties of the transaction. -guessTxSize :: Int -- ^ number of regular transaction inputs - -> [(Int,Int)] -- ^ multisig m of n for each input - -> Int -- ^ number of P2PKH outputs - -> Int -- ^ number of P2SH outputs - -> Int -- ^ upper bound on transaction size +{- | Computes an upper bound on the size of a transaction based on some known + properties of the transaction. +-} +guessTxSize :: + -- | number of regular transaction inputs + Int -> + -- | multisig m of n for each input + [(Int, Int)] -> + -- | number of P2PKH outputs + Int -> + -- | number of P2SH outputs + Int -> + -- | upper bound on transaction size + Int guessTxSize pki msi pkout msout = 8 + inpLen + inp + outLen + out where inpLen = - B.length . - runPutS . - serialize . - VarInt . - fromIntegral $ - length msi + pki + B.length + . runPutS + . serialize + . VarInt + . fromIntegral + $ length msi + pki outLen = - B.length . - runPutS . - serialize . - VarInt . - fromIntegral $ - pkout + msout + B.length + . runPutS + . serialize + . VarInt + . fromIntegral + $ pkout + msout inp = pki * 148 + sum (map guessMSSize msi) - -- (20: hash160) + (5: opcodes) + - -- (1: script len) + (8: Word64) + -- (20: hash160) + (5: opcodes) + + -- (1: script len) + (8: Word64) out = - pkout * 34 + - -- (20: hash160) + (3: opcodes) + - -- (1: script len) + (8: Word64) - msout * 32 + pkout * 34 + + + -- (20: hash160) + (3: opcodes) + + -- (1: script len) + (8: Word64) + msout * 32 -- | Size of a multisig P2SH input. -guessMSSize :: (Int,Int) -> Int -guessMSSize (m, n) +guessMSSize :: (Int, Int) -> Int +guessMSSize (m, n) = -- OutPoint (36) + Sequence (4) + Script - = 40 + - fromIntegral (B.length $ runPutS . serialize $ VarInt $ fromIntegral scp) + - scp - -- OP_M + n*PubKey + OP_N + OP_CHECKMULTISIG + 40 + + fromIntegral (B.length $ runPutS . serialize $ VarInt $ fromIntegral scp) + + scp where + -- OP_M + n*PubKey + OP_N + OP_CHECKMULTISIG + rdm = fromIntegral $ - B.length $ runPutS $ serialize $ opPushData $ B.replicate (n * 34 + 3) 0 + B.length $ runPutS $ serialize $ opPushData $ B.replicate (n * 34 + 3) 0 -- Redeem + m*sig + OP_0 scp = rdm + m * 73 + 1 {- Build a new Tx -} --- | Build a transaction by providing a list of outpoints as inputs --- and a list of recipient addresses and amounts as outputs. +{- | Build a transaction by providing a list of outpoints as inputs + and a list of recipient addresses and amounts as outputs. +-} buildAddrTx :: Network -> [OutPoint] -> [(Text, Word64)] -> Either String Tx buildAddrTx net ops rcps = buildTx ops <$> mapM f rcps @@ -273,8 +335,9 @@ let o = addressToOutput a return (o, v) --- | Build a transaction by providing a list of outpoints as inputs --- and a list of 'ScriptOutput' and amounts as outputs. +{- | Build a transaction by providing a list of outpoints as inputs + and a list of 'ScriptOutput' and amounts as outputs. +-} buildTx :: [OutPoint] -> [(ScriptOutput, Word64)] -> Tx buildTx ops rcpts = Tx 1 (toIn <$> ops) (toOut <$> rcpts) [] 0 @@ -282,40 +345,52 @@ toIn op = TxIn op B.empty maxBound toOut (o, v) = TxOut v $ encodeOutputBS o --- | Sign a transaction by providing the 'SigInput' signing parameters and a --- list of private keys. The signature is computed deterministically as defined --- in RFC-6979. --- --- Example: P2SH-P2WKH --- --- > sigIn = SigInput (PayWitnessPKHash h) 100000 op sigHashAll Nothing --- > signedTx = signTx btc unsignedTx [sigIn] [key] --- --- Example: P2SH-P2WSH multisig --- --- > sigIn = SigInput (PayWitnessScriptHash h) 100000 op sigHashAll (Just $ PayMulSig [p1,p2,p3] 2) --- > signedTx = signTx btc unsignedTx [sigIn] [k1,k3] -signTx :: Network - -> Tx -- ^ transaction to sign - -> [SigInput] -- ^ signing parameters - -> [SecKey] -- ^ private keys to sign with - -> Either String Tx -- ^ signed transaction +{- | Sign a transaction by providing the 'SigInput' signing parameters and a + list of private keys. The signature is computed deterministically as defined + in RFC-6979. + + Example: P2SH-P2WKH + + > sigIn = SigInput (PayWitnessPKHash h) 100000 op sigHashAll Nothing + > signedTx = signTx btc unsignedTx [sigIn] [key] + + Example: P2SH-P2WSH multisig + + > sigIn = SigInput (PayWitnessScriptHash h) 100000 op sigHashAll (Just $ PayMulSig [p1,p2,p3] 2) + > signedTx = signTx btc unsignedTx [sigIn] [k1,k3] +-} +signTx :: + Network -> + -- | transaction to sign + Tx -> + -- | signing parameters + [SigInput] -> + -- | private keys to sign with + [SecKey] -> + -- | signed transaction + Either String Tx signTx net tx si = S.signTx net tx $ notNested <$> si - where notNested s = (s, False) + where + notNested s = (s, False) --- | This function differs from 'signTx' by assuming all segwit inputs are --- P2SH-nested. Use the same signing parameters for segwit inputs as in 'signTx'. -signNestedWitnessTx :: Network - -> Tx -- ^ transaction to sign - -> [SigInput] -- ^ signing parameters - -> [SecKey] -- ^ private keys to sign with - -> Either String Tx -- ^ signed transaction +{- | This function differs from 'signTx' by assuming all segwit inputs are + P2SH-nested. Use the same signing parameters for segwit inputs as in 'signTx'. +-} +signNestedWitnessTx :: + Network -> + -- | transaction to sign + Tx -> + -- | signing parameters + [SigInput] -> + -- | private keys to sign with + [SecKey] -> + -- | signed transaction + Either String Tx signNestedWitnessTx net tx si = S.signTx net tx $ nested <$> si where -- NOTE: the nesting flag is ignored for non-segwit inputs nested s = (s, True) - -- | Sign a single input in a transaction deterministically (RFC-6979). signInput :: Network -> Tx -> Int -> SigInput -> SecKeyI -> Either String Tx signInput net tx i si = S.signInput net tx i (si, False) @@ -324,19 +399,21 @@ signNestedInput :: Network -> Tx -> Int -> SigInput -> SecKeyI -> Either String Tx signNestedInput net tx i si = S.signInput net tx i (si, True) --- | Order the 'SigInput' with respect to the transaction inputs. This allows --- the user to provide the 'SigInput' in any order. Users can also provide only --- a partial set of 'SigInput' entries. +{- | Order the 'SigInput' with respect to the transaction inputs. This allows + the user to provide the 'SigInput' in any order. Users can also provide only + a partial set of 'SigInput' entries. +-} findSigInput :: [SigInput] -> [TxIn] -> [(SigInput, Int)] findSigInput = S.findInputIndex sigInputOP {- Merge multisig transactions -} --- | Merge partially-signed multisig transactions. This function does not --- support segwit and P2SH-segwit inputs. Use PSBTs to merge transactions with --- segwit inputs. +{- | Merge partially-signed multisig transactions. This function does not + support segwit and P2SH-segwit inputs. Use PSBTs to merge transactions with + segwit inputs. +-} mergeTxs :: - Network -> [Tx] -> [(ScriptOutput, Word64, OutPoint)] -> Either String Tx + Network -> [Tx] -> [(ScriptOutput, Word64, OutPoint)] -> Either String Tx mergeTxs net txs os | null txs = Left "Transaction list is empty" | length (nub emptyTxs) /= 1 = Left "Transactions do not match" @@ -346,21 +423,22 @@ zipOp = zip (matchTemplate os (txIn $ head txs) f) [0 ..] outs = map (first $ (\(o, v, _) -> (o, v)) . fromJust) $ - filter (isJust . fst) zipOp + filter (isJust . fst) zipOp f (_, _, o) txin = o == prevOutput txin emptyTxs = map (\tx -> foldl clearInput tx outs) txs - ins is i = updateIndex i is (\ti -> ti {scriptInput = B.empty}) + ins is i = updateIndex i is (\ti -> ti{scriptInput = B.empty}) clearInput tx (_, i) = Tx (txVersion tx) (ins (txIn tx) i) (txOut tx) [] (txLockTime tx) --- | Merge input from partially-signed multisig transactions. This function --- does not support segwit and P2SH-segwit inputs. +{- | Merge input from partially-signed multisig transactions. This function + does not support segwit and P2SH-segwit inputs. +-} mergeTxInput :: - Network - -> [Tx] - -> Tx - -> ((ScriptOutput, Word64), Int) - -> Either String Tx + Network -> + [Tx] -> + Tx -> + ((ScriptOutput, Word64), Int) -> + Either String Tx mergeTxInput net txs tx ((so, val), i) = do -- Ignore transactions with empty inputs let ins = map (scriptInput . (!! i) . txIn) txs @@ -368,7 +446,7 @@ let rdm = snd $ head sigRes unless (all ((== rdm) . snd) sigRes) $ Left "Redeem scripts do not match" si <- encodeInputBS <$> go (nub $ concatMap fst sigRes) so rdm - let ins' = updateIndex i (txIn tx) (\ti -> ti {scriptInput = si}) + let ins' = updateIndex i (txIn tx) (\ti -> ti{scriptInput = si}) return $ Tx (txVersion tx) ins' (txOut tx) [] (txLockTime tx) where go allSigs out rdmM = @@ -376,7 +454,7 @@ PayMulSig msPubs r -> let sigs = take r $ - catMaybes $ matchTemplate allSigs msPubs $ f out + catMaybes $ matchTemplate allSigs msPubs $ f out in return $ RegularInput $ SpendMulSig sigs PayScriptHash _ -> case rdmM of @@ -407,63 +485,66 @@ where f (_, _, o) txin = o == prevOutput txin go (Just (so, val, _), i) = verifyStdInput net tx i so val - go _ = False + go _ = False -- | Verify if a transaction input is valid and standard. verifyStdInput :: Network -> Tx -> Int -> ScriptOutput -> Word64 -> Bool verifyStdInput net tx i so0 val | isSegwit so0 = - fromRight False $ (inp == mempty &&) . verifySegwitInput so0 <$> wp so0 + fromRight False $ (inp == mempty &&) . verifySegwitInput so0 <$> wp so0 | otherwise = fromRight False $ - (verifyLegacyInput so0 <$> decodeInputBS net inp) <|> - (nestedScriptOutput >>= \so -> verifyNestedInput so0 so <$> wp so) + (verifyLegacyInput so0 <$> decodeInputBS net inp) + <|> (nestedScriptOutput >>= \so -> verifyNestedInput so0 so <$> wp so) where inp = scriptInput $ txIn tx !! i theTxSigHash so = S.makeSigHash net tx i so val ws :: WitnessStack - ws | length (txWitness tx) > i = txWitness tx !! i - | otherwise = [] + ws + | length (txWitness tx) > i = txWitness tx !! i + | otherwise = [] wp :: ScriptOutput -> Either String (Maybe ScriptOutput, SimpleInput) wp so = decodeWitnessInput net =<< viewWitnessProgram net so ws nestedScriptOutput :: Either String ScriptOutput - nestedScriptOutput = scriptOps <$> runGetS deserialize inp >>= \case - [OP_PUSHDATA bs _] -> decodeOutputBS bs - _ -> Left "nestedScriptOutput: not a nested output" + nestedScriptOutput = + scriptOps <$> runGetS deserialize inp >>= \case + [OP_PUSHDATA bs _] -> decodeOutputBS bs + _ -> Left "nestedScriptOutput: not a nested output" verifyLegacyInput :: ScriptOutput -> ScriptInput -> Bool verifyLegacyInput so si = case (so, si) of (PayPK pub, RegularInput (SpendPK (TxSignature sig sh))) -> verifyHashSig (theTxSigHash so sh Nothing) sig (pubKeyPoint pub) (PayPKHash h, RegularInput (SpendPKHash (TxSignature sig sh) pub)) -> - pubKeyAddr pub == p2pkhAddr h && - verifyHashSig (theTxSigHash so sh Nothing) sig (pubKeyPoint pub) + pubKeyAddr pub == p2pkhAddr h + && verifyHashSig (theTxSigHash so sh Nothing) sig (pubKeyPoint pub) (PayMulSig pubs r, RegularInput (SpendMulSig sigs)) -> countMulSig net tx out val i (pubKeyPoint <$> pubs) sigs == r (PayScriptHash h, ScriptHashInput si' rdm) -> payToScriptAddress rdm == p2shAddr h && verifyLegacyInput rdm (RegularInput si') _ -> False - where out = encodeOutput so + where + out = encodeOutput so verifySegwitInput :: ScriptOutput -> (Maybe ScriptOutput, SimpleInput) -> Bool verifySegwitInput so (rdm, si) = case (so, rdm, si) of (PayWitnessPKHash h, Nothing, SpendPKHash (TxSignature sig sh) pub) -> - pubKeyWitnessAddr pub == p2wpkhAddr h && - verifyHashSig (theTxSigHash so sh Nothing) sig (pubKeyPoint pub) + pubKeyWitnessAddr pub == p2wpkhAddr h + && verifyHashSig (theTxSigHash so sh Nothing) sig (pubKeyPoint pub) (PayWitnessScriptHash h, Just rdm'@(PayPK pub), SpendPK (TxSignature sig sh)) -> - payToWitnessScriptAddress rdm' == p2wshAddr h && - verifyHashSig (theTxSigHash so sh $ Just rdm') sig (pubKeyPoint pub) + payToWitnessScriptAddress rdm' == p2wshAddr h + && verifyHashSig (theTxSigHash so sh $ Just rdm') sig (pubKeyPoint pub) (PayWitnessScriptHash h, Just rdm'@(PayPKHash kh), SpendPKHash (TxSignature sig sh) pub) -> - payToWitnessScriptAddress rdm' == p2wshAddr h && - addressHash (runPutS (serialize pub)) == kh && - verifyHashSig (theTxSigHash so sh $ Just rdm') sig (pubKeyPoint pub) + payToWitnessScriptAddress rdm' == p2wshAddr h + && addressHash (runPutS (serialize pub)) == kh + && verifyHashSig (theTxSigHash so sh $ Just rdm') sig (pubKeyPoint pub) (PayWitnessScriptHash h, Just rdm'@(PayMulSig pubs r), SpendMulSig sigs) -> - payToWitnessScriptAddress rdm' == p2wshAddr h && - countMulSig' (\sh -> theTxSigHash so sh $ Just rdm') (pubKeyPoint <$> pubs) sigs == r + payToWitnessScriptAddress rdm' == p2wshAddr h + && countMulSig' (\sh -> theTxSigHash so sh $ Just rdm') (pubKeyPoint <$> pubs) sigs == r _ -> False verifyNestedInput :: @@ -474,14 +555,14 @@ -- | Count the number of valid signatures for a multi-signature transaction. countMulSig :: - Network - -> Tx - -> Script - -> Word64 - -> Int - -> [PubKey] - -> [TxSignature] - -> Int + Network -> + Tx -> + Script -> + Word64 -> + Int -> + [PubKey] -> + [TxSignature] -> + Int countMulSig net tx out val i = countMulSig' h where @@ -490,7 +571,7 @@ countMulSig' :: (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int countMulSig' _ [] _ = 0 countMulSig' _ _ [] = 0 -countMulSig' h (_:pubs) (TxSignatureEmpty:sigs) = countMulSig' h pubs sigs -countMulSig' h (pub:pubs) sigs@(TxSignature sig sh : sigs') +countMulSig' h (_ : pubs) (TxSignatureEmpty : sigs) = countMulSig' h pubs sigs +countMulSig' h (pub : pubs) sigs@(TxSignature sig sh : sigs') | verifyHashSig (h sh) sig pub = 1 + countMulSig' h pubs sigs' - | otherwise = countMulSig' h pubs sigs + | otherwise = countMulSig' h pubs sigs diff --git a/src/Haskoin/Transaction/Builder/Sign.hs b/src/Haskoin/Transaction/Builder/Sign.hs --- a/src/Haskoin/Transaction/Builder/Sign.hs +++ b/src/Haskoin/Transaction/Builder/Sign.hs @@ -1,8 +1,9 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-| + +{- | Module : Haskoin.Transaction.Builder.Sign Copyright : No rights reserved License : MIT @@ -12,57 +13,79 @@ Types and logic for signing transactions. -} -module Haskoin.Transaction.Builder.Sign - ( SigInput (..) - , makeSignature - , makeSigHash - , signTx - , findInputIndex - , signInput - , buildInput - , sigKeys - ) where +module Haskoin.Transaction.Builder.Sign ( + SigInput (..), + makeSignature, + makeSigHash, + signTx, + findInputIndex, + signInput, + buildInput, + sigKeys, +) where -import Control.DeepSeq (NFData) -import Control.Monad (foldM, when) -import Data.Aeson (FromJSON, ToJSON (..), object, - pairs, parseJSON, withObject, (.:), - (.:?), (.=)) -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import Data.Either (rights) -import Data.Hashable (Hashable) -import Data.List (find, nub) -import Data.Maybe (catMaybes, fromMaybe, mapMaybe, - maybeToList) -import Data.Word (Word64) -import GHC.Generics (Generic) -import Haskoin.Address (getAddrHash160, pubKeyAddr) -import Haskoin.Constants (Network) -import Haskoin.Crypto (Hash256, SecKey) -import Haskoin.Crypto.Signature (signHash, verifyHashSig) -import Haskoin.Keys.Common (PubKeyI (..), SecKeyI (..), - derivePubKeyI, wrapSecKey) -import Haskoin.Script -import Haskoin.Transaction.Common -import Haskoin.Transaction.Segwit -import Haskoin.Util (matchTemplate, updateIndex) +import Control.DeepSeq (NFData) +import Control.Monad (foldM, when) +import Data.Aeson ( + FromJSON, + ToJSON (..), + object, + pairs, + parseJSON, + withObject, + (.:), + (.:?), + (.=), + ) +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.Either (rights) +import Data.Hashable (Hashable) +import Data.List (find, nub) +import Data.Maybe ( + catMaybes, + fromMaybe, + mapMaybe, + maybeToList, + ) +import Data.Word (Word64) +import GHC.Generics (Generic) +import Haskoin.Address (getAddrHash160, pubKeyAddr) +import Haskoin.Crypto (Hash256, SecKey) +import Haskoin.Crypto.Signature (signHash, verifyHashSig) +import Haskoin.Data (Network) +import Haskoin.Keys.Common ( + PubKeyI (..), + SecKeyI (..), + derivePubKeyI, + wrapSecKey, + ) +import Haskoin.Script +import Haskoin.Transaction.Common +import Haskoin.Transaction.Segwit +import Haskoin.Util (matchTemplate, updateIndex) --- | Data type used to specify the signing parameters of a transaction input. --- To sign an input, the previous output script, outpoint and sighash are --- required. When signing a pay to script hash output, an additional redeem --- script is required. +{- | Data type used to specify the signing parameters of a transaction input. + To sign an input, the previous output script, outpoint and sighash are + required. When signing a pay to script hash output, an additional redeem + script is required. +-} data SigInput = SigInput - { sigInputScript :: !ScriptOutput -- ^ output script to spend - -- ^ output script value - , sigInputValue :: !Word64 -- ^ output script value - -- ^ outpoint to spend - , sigInputOP :: !OutPoint -- ^ outpoint to spend - -- ^ signature type - , sigInputSH :: !SigHash -- ^ signature type - -- ^ redeem script - , sigInputRedeem :: !(Maybe RedeemScript) -- ^ redeem script + { -- | output script to spend + -- ^ output script value + sigInputScript :: !ScriptOutput + , -- | output script value + -- ^ outpoint to spend + sigInputValue :: !Word64 + , -- | outpoint to spend + -- ^ signature type + sigInputOP :: !OutPoint + , -- | signature type + -- ^ redeem script + sigInputSH :: !SigHash + , -- | redeem script + sigInputRedeem :: !(Maybe RedeemScript) } deriving (Eq, Show, Read, Generic, Hashable, NFData) @@ -70,38 +93,44 @@ toJSON (SigInput so val op sh rdm) = object $ [ "pkscript" .= so - , "value" .= val + , "value" .= val , "outpoint" .= op - , "sighash" .= sh - ] ++ - [ "redeem" .= r | r <- maybeToList rdm ] + , "sighash" .= sh + ] + ++ ["redeem" .= r | r <- maybeToList rdm] toEncoding (SigInput so val op sh rdm) = pairs $ "pkscript" .= so - <> "value" .= val - <> "outpoint" .= op - <> "sighash" .= sh - <> maybe mempty ("redeem" .=) rdm + <> "value" .= val + <> "outpoint" .= op + <> "sighash" .= sh + <> maybe mempty ("redeem" .=) rdm instance FromJSON SigInput where parseJSON = withObject "SigInput" $ \o -> SigInput <$> o .: "pkscript" - <*> o .: "value" - <*> o .: "outpoint" - <*> o .: "sighash" - <*> o .:? "redeem" + <*> o .: "value" + <*> o .: "outpoint" + <*> o .: "sighash" + <*> o .:? "redeem" --- | Sign a transaction by providing the 'SigInput' signing parameters and a --- list of private keys. The signature is computed deterministically as defined --- in RFC-6979. -signTx :: Network - -> Tx -- ^ transaction to sign - -> [(SigInput, Bool)] -- ^ signing parameters, with nesting flag - -> [SecKey] -- ^ private keys to sign with - -> Either String Tx -- ^ signed transaction +{- | Sign a transaction by providing the 'SigInput' signing parameters and a + list of private keys. The signature is computed deterministically as defined + in RFC-6979. +-} +signTx :: + Network -> + -- | transaction to sign + Tx -> + -- | signing parameters, with nesting flag + [(SigInput, Bool)] -> + -- | private keys to sign with + [SecKey] -> + -- | signed transaction + Either String Tx signTx net otx sigis allKeys - | null ti = Left "signTx: Transaction has no inputs" + | null ti = Left "signTx: Transaction has no inputs" | otherwise = foldM go otx $ findInputIndex (sigInputOP . fst) sigis ti where ti = txIn otx @@ -109,66 +138,75 @@ keys <- sigKeys so rdmM allKeys foldM (\t k -> signInput net t i sigi k) tx keys --- | Sign a single input in a transaction deterministically (RFC-6979). The --- nesting flag only affects the behavior of segwit inputs. +{- | Sign a single input in a transaction deterministically (RFC-6979). The + nesting flag only affects the behavior of segwit inputs. +-} signInput :: - Network - -> Tx - -> Int - -> (SigInput, Bool) -- ^ boolean flag: nest input - -> SecKeyI - -> Either String Tx + Network -> + Tx -> + Int -> + -- | boolean flag: nest input + (SigInput, Bool) -> + SecKeyI -> + Either String Tx signInput net tx i (sigIn@(SigInput so val _ _ rdmM), nest) key = do let sig = makeSignature net tx i sigIn key si <- buildInput net tx i so val rdmM sig $ derivePubKeyI key - w <- updatedWitnessData tx i so si - return tx { txIn = nextTxIn so si - , txWitness = w - } + w <- updatedWitnessData tx i so si + return + tx + { txIn = nextTxIn so si + , txWitness = w + } where - f si x = x {scriptInput = encodeInputBS si} - g so' x = x {scriptInput = runPutS . serialize . opPushData $ encodeOutputBS so'} + f si x = x{scriptInput = encodeInputBS si} + g so' x = x{scriptInput = runPutS . serialize . opPushData $ encodeOutputBS so'} txis = txIn tx nextTxIn so' si | isSegwit so' && nest = updateIndex i txis (g so') - | isSegwit so' = txIn tx - | otherwise = updateIndex i txis (f si) + | isSegwit so' = txIn tx + | otherwise = updateIndex i txis (f si) --- | Add the witness data of the transaction given segwit parameters for an input. --- --- @since 0.11.0.0 +{- | Add the witness data of the transaction given segwit parameters for an input. + + @since 0.11.0.0 +-} updatedWitnessData :: Tx -> Int -> ScriptOutput -> ScriptInput -> Either String WitnessData updatedWitnessData tx i so si | isSegwit so = updateWitness . toWitnessStack =<< calcWitnessProgram so si - | otherwise = return $ txWitness tx + | otherwise = return $ txWitness tx where updateWitness w - | null $ txWitness tx = return $ updateIndex i defaultStack (const w) + | null $ txWitness tx = return $ updateIndex i defaultStack (const w) | length (txWitness tx) /= n = Left "Invalid number of witness stacks" - | otherwise = return $ updateIndex i (txWitness tx) (const w) + | otherwise = return $ updateIndex i (txWitness tx) (const w) defaultStack = replicate n $ toWitnessStack EmptyWitnessProgram n = length $ txIn tx -- | Associate an input index to each value in a list findInputIndex :: - (a -> OutPoint) -- ^ extract an outpoint - -> [a] -- ^ input list - -> [TxIn] -- ^ reference list of inputs - -> [(a, Int)] + -- | extract an outpoint + (a -> OutPoint) -> + -- | input list + [a] -> + -- | reference list of inputs + [TxIn] -> + [(a, Int)] findInputIndex getOutPoint as ti = - mapMaybe g $ zip (matchTemplate as ti f) [0..] + mapMaybe g $ zip (matchTemplate as ti f) [0 ..] where f s txin = getOutPoint s == prevOutput txin - g (Just s, i) = Just (s,i) + g (Just s, i) = Just (s, i) g (Nothing, _) = Nothing --- | Find from the list of provided private keys which one is required to sign --- the 'ScriptOutput'. +{- | Find from the list of provided private keys which one is required to sign + the 'ScriptOutput'. +-} sigKeys :: - ScriptOutput - -> Maybe RedeemScript - -> [SecKey] - -> Either String [SecKeyI] + ScriptOutput -> + Maybe RedeemScript -> + [SecKey] -> + Either String [SecKeyI] sigKeys so rdmM keys = case (so, rdmM) of (PayPK p, Nothing) -> @@ -189,34 +227,40 @@ , let pub = derivePubKeyI prv ] keyByHash h = fmap fst . maybeToList . findKey h $ zipKeys - findKey h = find $ (== h) . getAddrHash160 . pubKeyAddr . snd + findKey h = find $ (== h) . getAddrHash160 . pubKeyAddr . snd --- | Construct an input for a transaction given a signature, public key and data --- about the previous output. +{- | Construct an input for a transaction given a signature, public key and data + about the previous output. +-} buildInput :: - Network - -> Tx -- ^ transaction where input will be added - -> Int -- ^ input index where signature will go - -> ScriptOutput -- ^ output script being spent - -> Word64 -- ^ amount of previous output - -> Maybe RedeemScript -- ^ redeem script if pay-to-script-hash - -> TxSignature - -> PubKeyI - -> Either String ScriptInput + Network -> + -- | transaction where input will be added + Tx -> + -- | input index where signature will go + Int -> + -- | output script being spent + ScriptOutput -> + -- | amount of previous output + Word64 -> + -- | redeem script if pay-to-script-hash + Maybe RedeemScript -> + TxSignature -> + PubKeyI -> + Either String ScriptInput buildInput net tx i so val rdmM sig pub = do when (i >= length (txIn tx)) $ Left "buildInput: Invalid input index" case (so, rdmM) of - (PayScriptHash _, Just rdm) -> buildScriptHashInput rdm + (PayScriptHash _, Just rdm) -> buildScriptHashInput rdm (PayWitnessScriptHash _, Just rdm) -> buildScriptHashInput rdm - (PayWitnessPKHash _, Nothing) -> return . RegularInput $ SpendPKHash sig pub - (_, Nothing) -> buildRegularInput so + (PayWitnessPKHash _, Nothing) -> return . RegularInput $ SpendPKHash sig pub + (_, Nothing) -> buildRegularInput so _ -> Left "buildInput: Invalid output/redeem script combination" where buildRegularInput = \case PayPK _ -> return $ RegularInput $ SpendPK sig PayPKHash _ -> return $ RegularInput $ SpendPKHash sig pub PayMulSig msPubs r -> do - let mSigs = take r $ catMaybes $ matchTemplate allSigs msPubs f + let mSigs = take r $ catMaybes $ matchTemplate allSigs msPubs f allSigs = nub $ sig : parseExistingSigs net tx so i return $ RegularInput $ SpendMulSig mSigs _ -> Left "buildInput: Invalid output/redeem script combination" @@ -227,22 +271,23 @@ verifyHashSig (makeSigHash net tx i so val sh rdmM) x (pubKeyPoint p) f TxSignatureEmpty _ = False --- | Apply heuristics to extract the signatures for a particular input that are --- embedded in the transaction. --- --- @since 0.11.0.0 +{- | Apply heuristics to extract the signatures for a particular input that are + embedded in the transaction. + + @since 0.11.0.0 +-} parseExistingSigs :: Network -> Tx -> ScriptOutput -> Int -> [TxSignature] parseExistingSigs net tx so i = insSigs <> witSigs where insSigs = case decodeInputBS net scp of - Right (ScriptHashInput (SpendMulSig xs) _) -> xs - Right (RegularInput (SpendMulSig xs)) -> xs - _ -> [] + Right (ScriptHashInput (SpendMulSig xs) _) -> xs + Right (RegularInput (SpendMulSig xs)) -> xs + _ -> [] scp = scriptInput $ txIn tx !! i witSigs - | not $ isSegwit so = [] + | not $ isSegwit so = [] | null $ txWitness tx = [] - | otherwise = rights $ decodeTxSig net <$> (txWitness tx !! i) + | otherwise = rights $ decodeTxSig net <$> (txWitness tx !! i) -- | Produce a structured representation of a deterministic (RFC-6979) signature over an input. makeSignature :: Network -> Tx -> Int -> SigInput -> SecKeyI -> TxSignature @@ -251,23 +296,24 @@ where m = makeSigHash net tx i so val sh rdmM --- | A function which selects the digest algorithm and parameters as appropriate --- --- @since 0.11.0.0 +{- | A function which selects the digest algorithm and parameters as appropriate + + @since 0.11.0.0 +-} makeSigHash :: - Network - -> Tx - -> Int - -> ScriptOutput - -> Word64 - -> SigHash - -> Maybe RedeemScript - -> Hash256 + Network -> + Tx -> + Int -> + ScriptOutput -> + Word64 -> + SigHash -> + Maybe RedeemScript -> + Hash256 makeSigHash net tx i so val sh rdmM = h net tx (encodeOutput so') val i sh where so' = case so of PayWitnessPKHash h' -> PayPKHash h' - _ -> fromMaybe so rdmM - h | isSegwit so = txSigHashForkId - | otherwise = txSigHash - + _ -> fromMaybe so rdmM + h + | isSegwit so = txSigHashForkId + | otherwise = txSigHash diff --git a/src/Haskoin/Transaction/Common.hs b/src/Haskoin/Transaction/Common.hs --- a/src/Haskoin/Transaction/Common.hs +++ b/src/Haskoin/Transaction/Common.hs @@ -1,7 +1,8 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} -{-| + +{- | Module : Haskoin.Transaction.Common Copyright : No rights reserved License : MIT @@ -11,52 +12,60 @@ Code related to transactions parsing and serialization. -} -module Haskoin.Transaction.Common - ( -- * Transactions - Tx(..) - , TxIn(..) - , TxOut(..) - , OutPoint(..) - , TxHash(..) - , WitnessData - , WitnessStack - , WitnessStackItem - , txHash - , hexToTxHash - , txHashToHex - , nosigTxHash - , nullOutPoint - ) where +module Haskoin.Transaction.Common ( + -- * Transactions + Tx (..), + TxIn (..), + TxOut (..), + OutPoint (..), + TxHash (..), + WitnessData, + WitnessStack, + WitnessStackItem, + txHash, + hexToTxHash, + txHashToHex, + nosigTxHash, + nullOutPoint, +) where -import Control.Applicative ((<|>)) -import Control.DeepSeq -import Control.Monad (forM_, guard, liftM2, mzero, - replicateM, unless, when, (<=<)) -import Data.Aeson as A -import Data.Aeson.Encoding (unsafeToEncoding) -import Data.Binary (Binary (..)) -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import Data.ByteString.Builder (char7) -import qualified Data.ByteString.Lazy as BL -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import Data.Hashable (Hashable) -import Data.Maybe (fromMaybe) -import Data.Serialize (Serialize (..)) -import Data.String (IsString, fromString) -import Data.String.Conversions (cs) -import Data.Text (Text) -import Data.Word (Word32, Word64) -import GHC.Generics (Generic) -import Haskoin.Crypto.Hash -import Haskoin.Network.Common -import Haskoin.Util -import Text.Read as R +import Control.Applicative ((<|>)) +import Control.DeepSeq +import Control.Monad ( + forM_, + guard, + liftM2, + mzero, + replicateM, + unless, + when, + (<=<), + ) +import Data.Aeson as A +import Data.Aeson.Encoding (unsafeToEncoding) +import Data.Binary (Binary (..)) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.ByteString.Builder (char7) +import qualified Data.ByteString.Lazy as BL +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.Hashable (Hashable) +import Data.Maybe (fromMaybe) +import Data.Serialize (Serialize (..)) +import Data.String (IsString, fromString) +import Data.String.Conversions (cs) +import Data.Text (Text) +import Data.Word (Word32, Word64) +import GHC.Generics (Generic) +import Haskoin.Crypto.Hash +import Haskoin.Network.Common +import Haskoin.Util +import Text.Read as R -- | Transaction id: hash of transaction excluding witness data. -newtype TxHash = TxHash { getTxHash :: Hash256 } +newtype TxHash = TxHash {getTxHash :: Hash256} deriving (Eq, Ord, Generic, Hashable, Serial, NFData) instance Serialize TxHash where @@ -78,27 +87,30 @@ instance IsString TxHash where fromString s = let e = error "Could not read transaction hash from hex string" - in fromMaybe e $ hexToTxHash $ cs s + in fromMaybe e $ hexToTxHash $ cs s instance FromJSON TxHash where - parseJSON = withText "txid" $ - maybe mzero return . hexToTxHash + parseJSON = + withText "txid" $ + maybe mzero return . hexToTxHash instance ToJSON TxHash where toJSON = A.String . txHashToHex toEncoding h = unsafeToEncoding $ - char7 '"' <> - hexBuilder (BL.reverse (runPutL (serialize h))) <> - char7 '"' + char7 '"' + <> hexBuilder (BL.reverse (runPutL (serialize h))) + <> char7 '"' -- | Transaction hash excluding signatures. nosigTxHash :: Tx -> TxHash nosigTxHash tx = - TxHash $ doubleSHA256 $ runPutS $ - serialize tx { txIn = map clearInput $ txIn tx } + TxHash $ + doubleSHA256 $ + runPutS $ + serialize tx{txIn = map clearInput $ txIn tx} where - clearInput ti = ti { scriptInput = B.empty } + clearInput ti = ti{scriptInput = B.empty} -- | Convert transaction hash to hex form, reversing bytes. txHashToHex :: TxHash -> Text @@ -113,28 +125,31 @@ -- | Witness stack for SegWit transactions. type WitnessData = [WitnessStack] + -- | Witness stack for SegWit transactions. type WitnessStack = [WitnessStackItem] + -- | Witness stack item for SegWit transactions. type WitnessStackItem = ByteString -- | Data type representing a transaction. data Tx = Tx { -- | transaction data format version - txVersion :: !Word32 - -- | list of transaction inputs - , txIn :: ![TxIn] - -- | list of transaction outputs - , txOut :: ![TxOut] - -- | witness data for the transaction - , txWitness :: !WitnessData - -- | earliest mining height or time - , txLockTime :: !Word32 - } deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData) + txVersion :: !Word32 + , -- | list of transaction inputs + txIn :: ![TxIn] + , -- | list of transaction outputs + txOut :: ![TxOut] + , -- | witness data for the transaction + txWitness :: !WitnessData + , -- | earliest mining height or time + txLockTime :: !Word32 + } + deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData) -- | Compute transaction hash. txHash :: Tx -> TxHash -txHash tx = TxHash . doubleSHA256 . runPutS $ serialize tx {txWitness = []} +txHash tx = TxHash . doubleSHA256 . runPutS $ serialize tx{txWitness = []} instance IsString Tx where fromString = @@ -198,12 +213,12 @@ l <- getWord32le return Tx - { txVersion = v - , txIn = is - , txOut = os - , txWitness = [] - , txLockTime = l - } + { txVersion = v + , txIn = is + , txOut = os + , txWitness = [] + , txLockTime = l + } where replicateList (VarInt c) = replicateM (fromIntegral c) deserialize @@ -219,7 +234,7 @@ w <- parseWitnessData $ length is l <- getWord32le return - Tx {txVersion = v, txIn = is, txOut = os, txWitness = w, txLockTime = l} + Tx{txVersion = v, txIn = is, txOut = os, txWitness = w, txLockTime = l} where replicateList (VarInt c) = replicateM (fromIntegral c) deserialize @@ -248,10 +263,10 @@ instance FromJSON Tx where parseJSON = withObject "Tx" $ \o -> Tx <$> o .: "version" - <*> o .: "inputs" - <*> o .: "outputs" - <*> (mapM (mapM f) =<< o .: "witnessdata") - <*> o .: "locktime" + <*> o .: "inputs" + <*> o .: "outputs" + <*> (mapM (mapM f) =<< o .: "witnessdata") + <*> o .: "locktime" where f = maybe mzero return . decodeHex @@ -267,22 +282,22 @@ toEncoding (Tx v i o w l) = pairs ( "version" .= v - <> "inputs" .= i - <> "outputs" .= o - <> "witnessdata" .= fmap (fmap encodeHex) w - <> "locktime" .= l + <> "inputs" .= i + <> "outputs" .= o + <> "witnessdata" .= fmap (fmap encodeHex) w + <> "locktime" .= l ) -- | Data type representing a transaction input. -data TxIn = - TxIn { - -- | output being spent - prevOutput :: !OutPoint - -- | signatures and redeem script - , scriptInput :: !ByteString - -- | lock-time using sequence numbers (BIP-68) - , txInSequence :: !Word32 - } deriving (Eq, Show, Read, Ord, Generic, Hashable, NFData) +data TxIn = TxIn + { -- | output being spent + prevOutput :: !OutPoint + , -- | signatures and redeem script + scriptInput :: !ByteString + , -- | lock-time using sequence numbers (BIP-68) + txInSequence :: !Word32 + } + deriving (Eq, Show, Read, Ord, Generic, Hashable, NFData) instance Serial TxIn where deserialize = @@ -308,8 +323,8 @@ parseJSON = withObject "TxIn" $ \o -> TxIn <$> o .: "prevoutput" - <*> (maybe mzero return . decodeHex =<< o .: "inputscript") - <*> o .: "sequence" + <*> (maybe mzero return . decodeHex =<< o .: "inputscript") + <*> o .: "sequence" instance ToJSON TxIn where toJSON (TxIn o s q) = @@ -321,18 +336,18 @@ toEncoding (TxIn o s q) = pairs ( "prevoutput" .= o - <> "inputscript" .= encodeHex s - <> "sequence" .= q + <> "inputscript" .= encodeHex s + <> "sequence" .= q ) -- | Data type representing a transaction output. -data TxOut = - TxOut { - -- | value of output is satoshi - outValue :: !Word64 - -- | pubkey script - , scriptOutput :: !ByteString - } deriving (Eq, Show, Read, Ord, Generic, Hashable, NFData) +data TxOut = TxOut + { -- | value of output is satoshi + outValue :: !Word64 + , -- | pubkey script + scriptOutput :: !ByteString + } + deriving (Eq, Show, Read, Ord, Generic, Hashable, NFData) instance Serial TxOut where deserialize = do @@ -357,7 +372,7 @@ parseJSON = withObject "TxOut" $ \o -> TxOut <$> o .: "value" - <*> (maybe mzero return . decodeHex =<< o .: "outputscript") + <*> (maybe mzero return . decodeHex =<< o .: "outputscript") instance ToJSON TxOut where toJSON (TxOut o s) = @@ -368,14 +383,15 @@ -- | The 'OutPoint' refers to a transaction output being spent. data OutPoint = OutPoint { -- | hash of previous transaction - outPointHash :: !TxHash - -- | position of output in previous transaction - , outPointIndex :: !Word32 - } deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData) + outPointHash :: !TxHash + , -- | position of output in previous transaction + outPointIndex :: !Word32 + } + deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData) instance Serial OutPoint where deserialize = do - (h,i) <- liftM2 (,) deserialize getWord32le + (h, i) <- liftM2 (,) deserialize getWord32le return $ OutPoint h i serialize (OutPoint h i) = serialize h >> putWord32le i @@ -400,7 +416,7 @@ nullOutPoint :: OutPoint nullOutPoint = OutPoint - { outPointHash = - "0000000000000000000000000000000000000000000000000000000000000000" - , outPointIndex = maxBound - } + { outPointHash = + "0000000000000000000000000000000000000000000000000000000000000000" + , outPointIndex = maxBound + } diff --git a/src/Haskoin/Transaction/Genesis.hs b/src/Haskoin/Transaction/Genesis.hs --- a/src/Haskoin/Transaction/Genesis.hs +++ b/src/Haskoin/Transaction/Genesis.hs @@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -{-| + +{- | Module : Haskoin.Transaction.Genesis Copyright : No rights reserved License : UNLICENSE @@ -9,14 +10,14 @@ Code related to transactions parsing and serialization. -} -module Haskoin.Transaction.Genesis - ( genesisTx - ) where +module Haskoin.Transaction.Genesis ( + genesisTx, +) where -import Data.String (fromString) -import Haskoin.Script.Standard -import Haskoin.Transaction.Common -import Haskoin.Util +import Data.String (fromString) +import Haskoin.Script.Standard +import Haskoin.Transaction.Common +import Haskoin.Util -- | Transaction from Genesis block. genesisTx :: Tx @@ -27,11 +28,15 @@ txout = TxOut 5000000000 (encodeOutputBS output) locktime = 0 outpoint = OutPoint z maxBound - Just inputBS = decodeHex $ fromString $ - "04ffff001d0104455468652054696d65732030332f4a616e2f323030392043686" ++ - "16e63656c6c6f72206f6e206272696e6b206f66207365636f6e64206261696c6f" ++ - "757420666f722062616e6b73" - output = PayPK $ fromString $ - "04678afdb0fe5548271967f1a67130b7105cd6a828e03909a67962e0ea1f61deb" ++ - "649f6bc3f4cef38c4f35504e51ec112de5c384df7ba0b8d578a4c702b6bf11d5f" + Just inputBS = + decodeHex $ + fromString $ + "04ffff001d0104455468652054696d65732030332f4a616e2f323030392043686" + ++ "16e63656c6c6f72206f6e206272696e6b206f66207365636f6e64206261696c6f" + ++ "757420666f722062616e6b73" + output = + PayPK $ + fromString $ + "04678afdb0fe5548271967f1a67130b7105cd6a828e03909a67962e0ea1f61deb" + ++ "649f6bc3f4cef38c4f35504e51ec112de5c384df7ba0b8d578a4c702b6bf11d5f" z = "0000000000000000000000000000000000000000000000000000000000000000" diff --git a/src/Haskoin/Transaction/Partial.hs b/src/Haskoin/Transaction/Partial.hs --- a/src/Haskoin/Transaction/Partial.hs +++ b/src/Haskoin/Transaction/Partial.hs @@ -1,9 +1,10 @@ -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-| +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +{- | Module : Haskoin.Transaction.Partial Copyright : No rights reserved License : MIT @@ -13,102 +14,157 @@ Code related to PSBT parsing and serialization. -} -module Haskoin.Transaction.Partial - ( -- * Partially-Signed Transactions - PartiallySignedTransaction (..) - , Input (..) - , Output (..) - , UnknownMap (..) - , Key (..) - , merge - , mergeInput - , mergeOutput - , complete - , finalTransaction - , emptyPSBT - , emptyInput - , emptyOutput - ) where +module Haskoin.Transaction.Partial ( + -- * Partially-Signed Transactions + PartiallySignedTransaction (..), + Input (..), + Output (..), + UnknownMap (..), + Key (..), + merge, + mergeMany, + mergeInput, + mergeOutput, + complete, + finalTransaction, + emptyPSBT, + emptyInput, + emptyOutput, -import Control.Applicative ((<|>)) -import Control.DeepSeq -import Control.Monad (guard, replicateM, void) -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import Data.Bytes.Get (runGetS) -import Data.Bytes.Put (runPutS) -import Data.Bytes.Serial (Serial (..)) -import Data.HashMap.Strict (HashMap) -import qualified Data.HashMap.Strict as HashMap -import Data.Hashable (Hashable) -import Data.List (foldl') -import Data.Maybe (fromMaybe, isJust) -import Data.Serialize (Get, Put, Serialize) -import qualified Data.Serialize as S -import GHC.Generics (Generic) -import GHC.Word (Word32, Word8) -import Haskoin.Address (Address (..), pubKeyAddr) -import Haskoin.Keys (Fingerprint, KeyIndex, PubKeyI) -import Haskoin.Network (VarInt (..), VarString (..), - putVarInt) -import Haskoin.Script (Script (..), ScriptOp (..), - ScriptOutput (..), SigHash, - decodeOutput, decodeOutputBS, - encodeOutputBS, isPayScriptHash, - opPushData, toP2SH, toP2WSH) -import Haskoin.Transaction.Common (Tx (..), TxOut, WitnessStack, - outPointIndex, prevOutput, - scriptInput, scriptOutput) -import Haskoin.Util (eitherToMaybe) + -- ** Signing + PsbtSigner, + getSignerKey, + secKeySigner, + xPrvSigner, + signPSBT, +) where --- | PSBT data type as specified in --- [BIP-174](https://github.com/bitcoin/bips/blob/master/bip-0174.mediawiki). --- This contains an unsigned transaction, inputs and outputs, and unspecified --- extra data. There is one input per input in the unsigned transaction, and one --- output per output in the unsigned transaction. The inputs and outputs in the --- 'PartiallySignedTransaction' line up by index with the inputs and outputs in --- the unsigned transaction. -data PartiallySignedTransaction = - PartiallySignedTransaction +import Control.Applicative ((<|>)) +import Control.DeepSeq +import Control.Monad (foldM, guard, replicateM, void) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Bytes.Get (runGetS) +import Data.Bytes.Put (runPutS) +import Data.Bytes.Serial (Serial (..)) +import Data.Either (fromRight) +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as HM +import qualified Data.HashMap.Strict as HashMap +import Data.Hashable (Hashable) +import Data.List (foldl') +import Data.Maybe (fromMaybe, isJust) +import Data.Serialize (Get, Put, Serialize) +import qualified Data.Serialize as S +import GHC.Generics (Generic) +import GHC.Word (Word32, Word8) +import Haskoin.Address (Address (..), pubKeyAddr) +import Haskoin.Crypto (SecKey, derivePubKey) +import Haskoin.Data (Network) +import Haskoin.Keys ( + DerivPath, + DerivPathI (Deriv), + Fingerprint, + KeyIndex, + PubKeyI, + SecKeyI (SecKeyI), + XPrvKey, + derivePath, + deriveXPubKey, + listToPath, + pathToList, + pubKeyCompressed, + pubKeyPoint, + xPrvKey, + xPubFP, + ) +import Haskoin.Network ( + VarInt (..), + VarString (..), + putVarInt, + ) +import Haskoin.Script ( + Script (..), + ScriptOp (..), + ScriptOutput (..), + SigHash, + decodeOutput, + decodeOutputBS, + encodeOutputBS, + encodeTxSig, + isPayScriptHash, + opPushData, + sigHashAll, + toP2SH, + toP2WSH, + ) +import Haskoin.Transaction.Builder (SigInput (..), makeSignature) +import Haskoin.Transaction.Common ( + Tx (..), + TxOut, + WitnessStack, + outPointIndex, + outValue, + prevOutput, + scriptInput, + scriptOutput, + ) +import Haskoin.Transaction.Segwit (isSegwit) +import Haskoin.Util (eitherToMaybe) + +{- | PSBT data type as specified in + [BIP-174](https://github.com/bitcoin/bips/blob/master/bip-0174.mediawiki). + This contains an unsigned transaction, inputs and outputs, and unspecified + extra data. There is one input per input in the unsigned transaction, and one + output per output in the unsigned transaction. The inputs and outputs in the + 'PartiallySignedTransaction' line up by index with the inputs and outputs in + the unsigned transaction. +-} +data PartiallySignedTransaction = PartiallySignedTransaction { unsignedTransaction :: Tx - , globalUnknown :: UnknownMap - , inputs :: [Input] - , outputs :: [Output] - } deriving (Show, Eq, Generic) + , globalUnknown :: UnknownMap + , inputs :: [Input] + , outputs :: [Output] + } + deriving (Show, Eq, Generic) instance NFData PartiallySignedTransaction --- | Inputs contain all of the data needed to sign a transaction and all of the --- resulting signature data after signing. +{- | Inputs contain all of the data needed to sign a transaction and all of the + resulting signature data after signing. +-} data Input = Input - { nonWitnessUtxo :: Maybe Tx - , witnessUtxo :: Maybe TxOut - , partialSigs :: HashMap PubKeyI ByteString - , sigHashType :: Maybe SigHash - , inputRedeemScript :: Maybe Script + { nonWitnessUtxo :: Maybe Tx + , witnessUtxo :: Maybe TxOut + , partialSigs :: HashMap PubKeyI ByteString + , sigHashType :: Maybe SigHash + , inputRedeemScript :: Maybe Script , inputWitnessScript :: Maybe Script - , inputHDKeypaths :: HashMap PubKeyI (Fingerprint, [KeyIndex]) - , finalScriptSig :: Maybe Script + , inputHDKeypaths :: HashMap PubKeyI (Fingerprint, [KeyIndex]) + , finalScriptSig :: Maybe Script , finalScriptWitness :: Maybe WitnessStack - , inputUnknown :: UnknownMap - } deriving (Show, Eq, Generic) + , inputUnknown :: UnknownMap + } + deriving (Show, Eq, Generic) instance NFData Input -- | Outputs can contain information needed to spend the output at a later date. data Output = Output - { outputRedeemScript :: Maybe Script + { outputRedeemScript :: Maybe Script , outputWitnessScript :: Maybe Script - , outputHDKeypaths :: HashMap PubKeyI (Fingerprint, [KeyIndex]) - , outputUnknown :: UnknownMap - } deriving (Show, Eq, Generic) + , outputHDKeypaths :: HashMap PubKeyI (Fingerprint, [KeyIndex]) + , outputUnknown :: UnknownMap + } + deriving (Show, Eq, Generic) instance NFData Output --- | A map of raw PSBT keys to byte strings for extra data. The 'keyType' field --- cannot overlap with any of the reserved 'keyType' fields specified in the --- PSBT specification. -newtype UnknownMap = UnknownMap { unknownMap :: HashMap Key ByteString } +{- | A map of raw PSBT keys to byte strings for extra data. The 'keyType' field + cannot overlap with any of the reserved 'keyType' fields specified in the + PSBT specification. +-} +newtype UnknownMap = UnknownMap {unknownMap :: HashMap Key ByteString} deriving (Show, Eq, Semigroup, Monoid, Generic) instance NFData UnknownMap @@ -116,176 +172,340 @@ -- | Raw keys for the map type used in PSBTs. data Key = Key { keyType :: Word8 - , key :: ByteString - } deriving (Show, Eq, Generic) + , key :: ByteString + } + deriving (Show, Eq, Generic) instance NFData Key instance Hashable Key --- | Take two 'PartiallySignedTransaction's and merge them. The --- 'unsignedTransaction' field in both must be the same. -merge :: PartiallySignedTransaction - -> PartiallySignedTransaction - -> Maybe PartiallySignedTransaction +{- | Take two 'PartiallySignedTransaction's and merge them. The + 'unsignedTransaction' field in both must be the same. +-} +merge :: + PartiallySignedTransaction -> + PartiallySignedTransaction -> + Maybe PartiallySignedTransaction merge psbt1 psbt2 - | unsignedTransaction psbt1 == unsignedTransaction psbt2 - = Just $ psbt1 - { globalUnknown = globalUnknown psbt1 <> globalUnknown psbt2 - , inputs = zipWith mergeInput (inputs psbt1) (inputs psbt2) - , outputs = zipWith mergeOutput (outputs psbt1) (outputs psbt2) - } + | unsignedTransaction psbt1 == unsignedTransaction psbt2 = + Just $ + psbt1 + { globalUnknown = globalUnknown psbt1 <> globalUnknown psbt2 + , inputs = zipWith mergeInput (inputs psbt1) (inputs psbt2) + , outputs = zipWith mergeOutput (outputs psbt1) (outputs psbt2) + } merge _ _ = Nothing +{- | A version of 'merge' for a collection of PSBTs. + + @since 0.21.0 +-} +mergeMany :: [PartiallySignedTransaction] -> Maybe PartiallySignedTransaction +mergeMany (psbt : psbts) = foldM merge psbt psbts +mergeMany _ = Nothing + mergeInput :: Input -> Input -> Input -mergeInput a b = Input - { nonWitnessUtxo = +mergeInput a b = + Input + { nonWitnessUtxo = if isJust witUtx - then Nothing - else nonWitnessUtxo a <|> nonWitnessUtxo b - , witnessUtxo = + then Nothing + else nonWitnessUtxo a <|> nonWitnessUtxo b + , witnessUtxo = witUtx - , sigHashType = + , sigHashType = sigHashType a <|> sigHashType b - , partialSigs = + , partialSigs = partialSigs a <> partialSigs b - , inputHDKeypaths = + , inputHDKeypaths = inputHDKeypaths a <> inputHDKeypaths b - , inputUnknown = + , inputUnknown = inputUnknown a <> inputUnknown b - , inputRedeemScript = + , inputRedeemScript = inputRedeemScript a <|> inputRedeemScript b - , inputWitnessScript = + , inputWitnessScript = inputWitnessScript a <|> inputWitnessScript b - , finalScriptSig = + , finalScriptSig = finalScriptSig a <|> finalScriptSig b - , finalScriptWitness = + , finalScriptWitness = finalScriptWitness a <|> finalScriptWitness b - } + } where witUtx = witnessUtxo a <|> witnessUtxo b mergeOutput :: Output -> Output -> Output -mergeOutput a b = Output - { outputRedeemScript = +mergeOutput a b = + Output + { outputRedeemScript = outputRedeemScript a <|> outputRedeemScript b - , outputWitnessScript = + , outputWitnessScript = outputWitnessScript a <|> outputWitnessScript b - , outputHDKeypaths = + , outputHDKeypaths = outputHDKeypaths a <> outputHDKeypaths b - , outputUnknown = + , outputUnknown = outputUnknown a <> outputUnknown b + } + +{- | A abstraction which covers varying key configurations. Use the 'Semigroup' + instance to create signers for sets of keys: `signerA <> signerB` can sign + anything for which `signerA` or `signerB` could sign. + + @since 0.21@ +-} +newtype PsbtSigner = PsbtSigner + { unPsbtSigner :: + PubKeyI -> + Maybe (Fingerprint, DerivPath) -> + Maybe SecKey } +instance Semigroup PsbtSigner where + PsbtSigner signer1 <> PsbtSigner signer2 = + PsbtSigner $ \pubKey origin -> + signer1 pubKey origin <|> signer2 pubKey origin + +instance Monoid PsbtSigner where + mempty = PsbtSigner $ \_ _ -> Nothing + +{- | Fetch the secret key for the given 'PubKeyI' if possible. + + @since 0.21@ +-} +getSignerKey :: PsbtSigner -> PubKeyI -> Maybe (Fingerprint, DerivPath) -> Maybe SecKey +getSignerKey = unPsbtSigner + +{- | This signer can sign for one key. + + @since 0.21@ +-} +secKeySigner :: SecKey -> PsbtSigner +secKeySigner theSecKey = PsbtSigner signer + where + signer requiredKey _ + | pubKeyPoint requiredKey == derivePubKey theSecKey = Just theSecKey + | otherwise = Nothing + +{- | This signer can sign with any child key, provided that derivation information is present. + + @since 0.21@ +-} +xPrvSigner :: + XPrvKey -> + -- | Origin data, if the input key is explicitly a child key + Maybe (Fingerprint, DerivPath) -> + PsbtSigner +xPrvSigner xprv origin = PsbtSigner signer + where + signer pubKey (Just hdData) + | result@(Just theSecKey) <- maybe noOrigin onOrigin origin hdData + , pubKeyPoint pubKey == derivePubKey theSecKey = + result + signer _ _ = Nothing + + noOrigin (fp, path) + | thisFP == fp = Just $ deriveSecKey path + | otherwise = Nothing + + onOrigin (originFP, originPath) (fp, path) + | thisFP == fp = Just $ deriveSecKey path + | originFP == fp = + deriveSecKey <$> adjustPath (pathToList originPath) (pathToList path) + | otherwise = Nothing + + deriveSecKey path = xPrvKey $ derivePath path xprv + + thisFP = xPubFP $ deriveXPubKey xprv + + -- The origin path should be a prefix of the target path if we match the + -- origin fingerprint. We need to remove this prefix. + adjustPath :: [KeyIndex] -> [KeyIndex] -> Maybe DerivPath + adjustPath (originIx : originTail) (thisIx : thisTail) + | originIx == thisIx = adjustPath originTail thisTail + | otherwise = Nothing + adjustPath [] thePath = Just $ listToPath thePath + adjustPath _ _ = Nothing + +{- | Update a PSBT with signatures when possible. This function uses + 'inputHDKeypaths' in order to calculate secret keys. + + @since 0.21@ +-} +signPSBT :: + Network -> + PsbtSigner -> + PartiallySignedTransaction -> + PartiallySignedTransaction +signPSBT net signer psbt = + psbt + { inputs = addSigsForInput net signer tx <$> zip [0 :: Int ..] (inputs psbt) + } + where + tx = unsignedTransaction psbt + +addSigsForInput :: Network -> PsbtSigner -> Tx -> (Int, Input) -> Input +addSigsForInput net signer tx (ix, input) = + maybe input (onPrevTxOut net signer tx ix input) $ + Left <$> nonWitnessUtxo input <|> Right <$> witnessUtxo input + +onPrevTxOut :: + Network -> + PsbtSigner -> + Tx -> + Int -> + Input -> + Either Tx TxOut -> + Input +onPrevTxOut net signer tx ix input prevTxData = + input + { partialSigs = newSigs <> partialSigs input + } + where + newSigs = HM.mapWithKey sigForInput sigKeys + sigForInput thePubKey theSecKey = + encodeTxSig . makeSignature net tx ix theSigInput $ + SecKeyI theSecKey (pubKeyCompressed thePubKey) + + theSigInput = + SigInput + { -- Must be the segwit input script for segwit spends (even nested) + sigInputScript = fromMaybe theInputScript segwitInput + , sigInputValue = outValue prevTxOut + , sigInputOP = thePrevOutPoint + , sigInputSH = fromMaybe sigHashAll $ sigHashType input + , -- Must be the witness script for segwit spends (even nested) + sigInputRedeem = theWitnessScript <|> theRedeemScript + } + + prevTxOut = either ((!! (fromIntegral . outPointIndex) thePrevOutPoint) . txOut) id prevTxData + thePrevOutPoint = prevOutput $ txIn tx !! ix + + segwitInput = justWhen isSegwit theInputScript <|> (justWhen isSegwit =<< theRedeemScript) + + theInputScript = fromRight inputScriptErr $ (decodeOutputBS . scriptOutput) prevTxOut + inputScriptErr = error "addSigsForInput: Unable to decode input script" + + theRedeemScript = case decodeOutput <$> inputRedeemScript input of + Just (Right script) -> Just script + Just Left{} -> error "addSigsForInput: Unable to decode redeem script" + _ -> Nothing + + theWitnessScript = case decodeOutput <$> inputWitnessScript input of + Just (Right script) -> Just script + Just Left{} -> error "addSigsForInput: Unable to decode witness script" + _ -> Nothing + + sigKeys = HM.mapMaybeWithKey getSignerKey $ inputHDKeypaths input + getSignerKey pubKey (fp, ixs) = unPsbtSigner signer pubKey $ Just (fp, listToPath ixs) + -- | Take partial signatures from all of the 'Input's and finalize the signature. -complete :: PartiallySignedTransaction - -> PartiallySignedTransaction +complete :: + PartiallySignedTransaction -> + PartiallySignedTransaction complete psbt = psbt - { - inputs = map - (completeInput . analyzeInputs) - (indexed $ inputs psbt) - } + { inputs = + map + (completeInput . analyzeInputs) + (indexed $ inputs psbt) + } where analyzeInputs (i, input) = (,) - (outputScript =<< witnessUtxo input <|> nonWitScript) - input + (outputScript =<< witnessUtxo input <|> nonWitScript) + input where nonWitScript = getPrevOut i =<< nonWitnessUtxo input getPrevOut i tx = - (txOut tx !!?) . - fromIntegral . - outPointIndex . - prevOutput =<< - txIn (unsignedTransaction psbt) !!? i + (txOut tx !!?) + . fromIntegral + . outPointIndex + . prevOutput + =<< txIn (unsignedTransaction psbt) !!? i xs !!? i = lookup i $ indexed xs outputScript = eitherToMaybe . decodeOutputBS . scriptOutput - completeInput (Nothing, input) = input - completeInput (Just script, input) = completeSig input script + completeInput (Nothing, input) = input + completeInput (Just script, input) = pruneInputFields $ completeSig input script + -- If we have final scripts, we can get rid of data for signing following + -- the Bitcoin Core implementation. + pruneInputFields input + | isJust (finalScriptSig input) || isJust (finalScriptWitness input) = + input + { partialSigs = mempty + , inputHDKeypaths = mempty + , inputRedeemScript = Nothing + , inputWitnessScript = Nothing + , sigHashType = Nothing + } + | otherwise = input + indexed :: [a] -> [(Word32, a)] - indexed = zip [0..] + indexed = zip [0 ..] completeSig :: Input -> ScriptOutput -> Input - completeSig input (PayPK k) = input - { finalScriptSig = - eitherToMaybe . runGetS deserialize =<< - HashMap.lookup k (partialSigs input) - } - + { finalScriptSig = + eitherToMaybe . runGetS deserialize + =<< HashMap.lookup k (partialSigs input) + } completeSig input (PayPKHash h) | [(k, sig)] <- HashMap.toList (partialSigs input) - , PubKeyAddress h == pubKeyAddr k = - input - { - finalScriptSig = - Just $ + , PubKeyAddress h == pubKeyAddr k = + input + { finalScriptSig = + Just $ Script - [ - opPushData sig, - opPushData (runPutS (serialize k)) - ] + [ opPushData sig + , opPushData (runPutS (serialize k)) + ] } - completeSig input (PayMulSig pubKeys m) | length sigs >= m = - input { finalScriptSig = finalSig } + input{finalScriptSig = Just finalSig} where sigs = collectSigs m pubKeys input - finalSig = - Script . - (OP_0 :) . - (map opPushData sigs <>) . - pure . opPushData . runPutS . serialize <$> - inputRedeemScript input - + finalSig = Script $ OP_0 : map opPushData sigs completeSig input (PayScriptHash h) | Just rdmScript <- inputRedeemScript input - , PayScriptHash h == toP2SH rdmScript - , Right decodedScript <- decodeOutput rdmScript - , not (isPayScriptHash decodedScript) = - completeSig input decodedScript - + , PayScriptHash h == toP2SH rdmScript + , Right decodedScript <- decodeOutput rdmScript + , not (isPayScriptHash decodedScript) = + pushScript rdmScript $ completeSig input decodedScript + where + pushScript rdmScript updatedInput = + updatedInput + { finalScriptSig = + Just $ + fromMaybe (Script mempty) (finalScriptSig updatedInput) + `scriptAppend` serializedRedeemScript rdmScript + } + scriptAppend (Script script1) (Script script2) = Script $ script1 <> script2 completeSig input (PayWitnessPKHash h) | [(k, sig)] <- HashMap.toList (partialSigs input) - , PubKeyAddress h == pubKeyAddr k = - input - { - finalScriptWitness = - Just [sig, runPutS $ serialize k], - finalScriptSig = - Script . pure . opPushData . runPutS . serialize <$> - inputRedeemScript input - } + , PubKeyAddress h == pubKeyAddr k = + input{finalScriptWitness = Just [sig, runPutS $ serialize k]} completeSig input (PayWitnessScriptHash h) | Just witScript <- inputWitnessScript input - , PayWitnessScriptHash h == toP2WSH witScript - , Right decodedScript <- decodeOutput witScript = - completeWitnessSig input decodedScript - + , PayWitnessScriptHash h == toP2WSH witScript + , Right decodedScript <- decodeOutput witScript = + completeWitnessSig input decodedScript completeSig input _ = input +serializedRedeemScript :: Script -> Script +serializedRedeemScript = Script . pure . opPushData . runPutS . serialize + completeWitnessSig :: Input -> ScriptOutput -> Input completeWitnessSig input script@(PayMulSig pubKeys m) | length sigs >= m = - input - { - finalScriptWitness = Just finalWit, - finalScriptSig = finalSig - } + input{finalScriptWitness = Just finalWit} where sigs = collectSigs m pubKeys input - finalSig = Script . pure . opPushData . runPutS . serialize <$> - inputRedeemScript input finalWit = mempty : sigs <> [encodeOutputBS script] - completeWitnessSig input _ = input collectSigs :: Int -> [PubKeyI] -> Input -> [ByteString] @@ -294,58 +514,58 @@ where lookupKey sigs key = maybe sigs (: sigs) $ - HashMap.lookup key (partialSigs input) + HashMap.lookup key (partialSigs input) --- | Take a finalized 'PartiallySignedTransaction' and produce the signed final --- transaction. You may need to call 'complete' on the --- 'PartiallySignedTransaction' before producing the final transaction. +{- | Take a finalized 'PartiallySignedTransaction' and produce the signed final + transaction. You may need to call 'complete' on the + 'PartiallySignedTransaction' before producing the final transaction. +-} finalTransaction :: PartiallySignedTransaction -> Tx finalTransaction psbt = - setInputs . - foldl' finalizeInput ([], []) $ - zip (txIn tx) (inputs psbt) + setInputs + . foldl' finalizeInput ([], []) + $ zip (txIn tx) (inputs psbt) where tx = unsignedTransaction psbt hasWitness = any - (isJust . finalScriptWitness) - (inputs psbt) + (isJust . finalScriptWitness) + (inputs psbt) setInputs (ins, witData) = tx - { - txIn = reverse ins, - txWitness = if hasWitness then reverse witData else [] - } + { txIn = reverse ins + , txWitness = if hasWitness then reverse witData else [] + } finalizeInput (ins, witData) (txInput, psbtInput) = - maybe finalWitness finalScript $ - finalScriptSig psbtInput - where - finalScript script = - ( - txInput { scriptInput = runPutS $ serialize script } : ins, - [] : witData - ) - finalWitness = - ( - ins, - fromMaybe [] (finalScriptWitness psbtInput) : witData - ) + ( txInput{scriptInput = maybe mempty (runPutS . serialize) $ finalScriptSig psbtInput} : ins + , fromMaybe [] (finalScriptWitness psbtInput) : witData + ) --- | Take an unsigned transaction and produce an empty --- 'PartiallySignedTransaction' +{- | Take an unsigned transaction and produce an empty + 'PartiallySignedTransaction' +-} emptyPSBT :: Tx -> PartiallySignedTransaction -emptyPSBT tx = PartiallySignedTransaction - { unsignedTransaction = tx - , globalUnknown = mempty - , inputs = replicate (length (txIn tx)) emptyInput - , outputs = replicate (length (txOut tx)) emptyOutput - } +emptyPSBT tx = + PartiallySignedTransaction + { unsignedTransaction = tx + , globalUnknown = mempty + , inputs = replicate (length (txIn tx)) emptyInput + , outputs = replicate (length (txOut tx)) emptyOutput + } emptyInput :: Input -emptyInput = Input - Nothing Nothing HashMap.empty Nothing - Nothing Nothing HashMap.empty - Nothing Nothing (UnknownMap HashMap.empty) +emptyInput = + Input + Nothing + Nothing + HashMap.empty + Nothing + Nothing + Nothing + HashMap.empty + Nothing + Nothing + (UnknownMap HashMap.empty) emptyOutput :: Output emptyOutput = Output Nothing Nothing HashMap.empty (UnknownMap HashMap.empty) @@ -371,40 +591,37 @@ inputs <- replicateM - (length (txIn unsignedTransaction)) - S.get + (length (txIn unsignedTransaction)) + S.get outputs <- replicateM - (length (txOut unsignedTransaction)) - S.get + (length (txOut unsignedTransaction)) + S.get return PartiallySignedTransaction - { - unsignedTransaction, - globalUnknown, - inputs, - outputs - } - - put PartiallySignedTransaction - { - unsignedTransaction, - globalUnknown, - inputs, - outputs - } = do - S.putByteString "psbt" - S.putWord8 0xff -- Header separator - - S.putWord8 0x01 -- Key size - S.putWord8 0x00 -- Unsigned Transaction type - putSizedBytes $ serialize unsignedTransaction - S.put globalUnknown - S.putWord8 0x00 -- Global end + { unsignedTransaction + , globalUnknown + , inputs + , outputs + } - mapM_ S.put inputs - mapM_ S.put outputs + put + PartiallySignedTransaction + { unsignedTransaction + , globalUnknown + , inputs + , outputs + } = do + S.putByteString "psbt" + S.putWord8 0xff -- Header separator + S.putWord8 0x01 -- Key size + S.putWord8 0x00 -- Unsigned Transaction type + putSizedBytes $ serialize unsignedTransaction + S.put globalUnknown + S.putWord8 0x00 -- Global end + mapM_ S.put inputs + mapM_ S.put outputs instance Serialize Key where get = do @@ -434,9 +651,9 @@ put (UnknownMap m) = void $ - HashMap.traverseWithKey - (\k v -> S.put k >> serialize (VarString v)) - m + HashMap.traverseWithKey + (\k v -> S.put k >> serialize (VarString v)) + m instance Serialize Input where get = @@ -444,75 +661,86 @@ where setInputUnknown f input = input - { - inputUnknown = + { inputUnknown = UnknownMap (f (unknownMap (inputUnknown input))) - } + } - put Input - { - nonWitnessUtxo, - witnessUtxo, - partialSigs, - sigHashType, - inputRedeemScript, - inputWitnessScript, - inputHDKeypaths, - finalScriptSig, - finalScriptWitness, - inputUnknown - } = do - whenJust (putKeyValue InNonWitnessUtxo . serialize) - nonWitnessUtxo - whenJust (putKeyValue InWitnessUtxo . serialize) - witnessUtxo - putPartialSig partialSigs - whenJust putSigHash - sigHashType - whenJust (putKeyValue InRedeemScript . serialize) - inputRedeemScript - whenJust (putKeyValue InWitnessScript . serialize) - inputWitnessScript - putHDPath InBIP32Derivation inputHDKeypaths - whenJust (putKeyValue InFinalScriptSig . serialize) - finalScriptSig - whenJust (putKeyValue InFinalScriptWitness . serialize) - finalScriptWitness - S.put inputUnknown - S.putWord8 0x00 - where - putPartialSig = - putPubKeyMap serialize InPartialSig . fmap VarString - putSigHash sigHash = do - putKey InSigHashType - S.putWord8 0x04 - S.putWord32le (fromIntegral sigHash) + put + Input + { nonWitnessUtxo + , witnessUtxo + , partialSigs + , sigHashType + , inputRedeemScript + , inputWitnessScript + , inputHDKeypaths + , finalScriptSig + , finalScriptWitness + , inputUnknown + } = do + whenJust + (putKeyValue InNonWitnessUtxo . serialize) + nonWitnessUtxo + whenJust + (putKeyValue InWitnessUtxo . serialize) + witnessUtxo + putPartialSig partialSigs + whenJust + putSigHash + sigHashType + whenJust + (putKeyValue InRedeemScript . serialize) + inputRedeemScript + whenJust + (putKeyValue InWitnessScript . serialize) + inputWitnessScript + putHDPath InBIP32Derivation inputHDKeypaths + whenJust + (putKeyValue InFinalScriptSig . serialize) + finalScriptSig + whenJust + (putKeyValue InFinalScriptWitness . putFinalScriptWitness) + finalScriptWitness + S.put inputUnknown + S.putWord8 0x00 + where + putPartialSig = + putPubKeyMap serialize InPartialSig . fmap VarString + putSigHash sigHash = do + putKey InSigHashType + S.putWord8 0x04 + S.putWord32le (fromIntegral sigHash) + putFinalScriptWitness witnessStack = do + S.put $ (VarInt . fromIntegral . length) witnessStack + mapM_ (serialize . VarString) witnessStack instance Serialize Output where get = getMap getOutputItem setOutputUnknown emptyOutput where setOutputUnknown f output = output - { - outputUnknown = + { outputUnknown = UnknownMap (f (unknownMap (outputUnknown output))) - } + } - put Output - { - outputRedeemScript, - outputWitnessScript, - outputHDKeypaths, - outputUnknown - } = do - whenJust (putKeyValue OutRedeemScript . serialize) - outputRedeemScript - whenJust (putKeyValue OutWitnessScript . serialize) - outputWitnessScript - putHDPath OutBIP32Derivation - outputHDKeypaths - S.put outputUnknown - S.putWord8 0x00 + put + Output + { outputRedeemScript + , outputWitnessScript + , outputHDKeypaths + , outputUnknown + } = do + whenJust + (putKeyValue OutRedeemScript . serialize) + outputRedeemScript + whenJust + (putKeyValue OutWitnessScript . serialize) + outputWitnessScript + putHDPath + OutBIP32Derivation + outputHDKeypaths + S.put outputUnknown + S.putWord8 0x00 putSizedBytes :: Put -> Put putSizedBytes f = do @@ -522,10 +750,9 @@ bs = S.runPut f getSizedBytes :: Get a -> Get a -getSizedBytes f = +getSizedBytes = S.getNested - (fromIntegral . getVarInt <$> deserialize) - f + (fromIntegral . getVarInt <$> deserialize) putKeyValue :: Enum t => t -> Put -> Put putKeyValue t v = do @@ -537,15 +764,17 @@ putVarInt (1 :: Word8) S.putWord8 (enumWord8 t) -getMap :: (Bounded t, Enum t) - => (Int -> a -> t -> Get a) - -> ((HashMap Key ByteString -> HashMap Key ByteString) -> a -> a) - -> a -> Get a +getMap :: + (Bounded t, Enum t) => + (Int -> a -> t -> Get a) -> + ((HashMap Key ByteString -> HashMap Key ByteString) -> a -> a) -> + a -> + Get a getMap getMapItem setUnknown = go where getItem keySize m (Right t) = getMapItem (fromIntegral keySize - 1) m t >>= go - getItem keySize m (Left t) = do + getItem keySize m (Left t) = do k <- S.getBytes (fromIntegral keySize - 1) VarString v <- deserialize go $ setUnknown (HashMap.insert (Key t k) v) m @@ -553,7 +782,7 @@ keySize <- getVarInt <$> deserialize if keySize == 0 then return m - else getItem keySize m =<< (word8Enum <$> S.getWord8) + else getItem keySize m . word8Enum =<< S.getWord8 data InputType = InNonWitnessUtxo @@ -578,95 +807,80 @@ instance NFData OutputType getInputItem :: Int -> Input -> InputType -> Get Input - getInputItem 0 input@Input{nonWitnessUtxo = Nothing} InNonWitnessUtxo = do utxo <- getSizedBytes deserialize - return input { nonWitnessUtxo = Just utxo } - + return input{nonWitnessUtxo = Just utxo} getInputItem 0 input@Input{witnessUtxo = Nothing} InWitnessUtxo = do utxo <- getSizedBytes deserialize - return input { witnessUtxo = Just utxo } - + return input{witnessUtxo = Just utxo} getInputItem keySize input InPartialSig = do (k, v) <- getPartialSig return input - { - partialSigs = HashMap.insert k v (partialSigs input) - } + { partialSigs = HashMap.insert k v (partialSigs input) + } where getPartialSig = (,) - <$> S.isolate keySize deserialize - <*> (getVarString <$> deserialize) - + <$> S.isolate keySize deserialize + <*> (getVarString <$> deserialize) getInputItem 0 input@Input{sigHashType = Nothing} InSigHashType = do VarInt size <- deserialize guard $ size == 0x04 sigHash <- fromIntegral <$> S.getWord32le - return $ input { sigHashType = Just sigHash } - + return $ input{sigHashType = Just sigHash} getInputItem 0 input@Input{inputRedeemScript = Nothing} InRedeemScript = do script <- getSizedBytes deserialize - return $ input { inputRedeemScript = Just script } - + return $ input{inputRedeemScript = Just script} getInputItem 0 input@Input{inputWitnessScript = Nothing} InWitnessScript = do script <- getSizedBytes deserialize - return $ input { inputWitnessScript = Just script } - + return $ input{inputWitnessScript = Just script} getInputItem keySize input InBIP32Derivation = do (k, v) <- getHDPath keySize return input - { - inputHDKeypaths = HashMap.insert k v (inputHDKeypaths input) - } - + { inputHDKeypaths = HashMap.insert k v (inputHDKeypaths input) + } getInputItem 0 input@Input{finalScriptSig = Nothing} InFinalScriptSig = do script <- getSizedBytes deserialize - return $ input { finalScriptSig = Just script } - + return $ input{finalScriptSig = Just script} getInputItem 0 input@Input{finalScriptWitness = Nothing} InFinalScriptWitness = do scripts <- map getVarString <$> getVarIntList - return $ input { finalScriptWitness = Just scripts } + return $ input{finalScriptWitness = Just scripts} where - getVarIntList = do - VarInt n <- deserialize + getVarIntList = getSizedBytes $ do + VarInt n <- deserialize -- Item count replicateM (fromIntegral n) deserialize - -getInputItem keySize input inputType = fail $ - "Incorrect key size for input item or item already existed: " <> - show (keySize, input, inputType) +getInputItem keySize input inputType = + fail $ + "Incorrect key size for input item or item already existed: " + <> show (keySize, input, inputType) getOutputItem :: Int -> Output -> OutputType -> Get Output - getOutputItem 0 output@Output{outputRedeemScript = Nothing} OutRedeemScript = do script <- getSizedBytes deserialize - return $ output { outputRedeemScript = Just script } - + return $ output{outputRedeemScript = Just script} getOutputItem 0 output@Output{outputWitnessScript = Nothing} OutWitnessScript = do script <- getSizedBytes deserialize - return $ output { outputWitnessScript = Just script } - + return $ output{outputWitnessScript = Just script} getOutputItem keySize output OutBIP32Derivation = do (k, v) <- getHDPath keySize - return $ output { outputHDKeypaths = HashMap.insert k v (outputHDKeypaths output) } - -getOutputItem keySize output outputType = fail $ - "Incorrect key size for output item or item already existed: " <> - show (keySize, output, outputType) + return $ output{outputHDKeypaths = HashMap.insert k v (outputHDKeypaths output)} +getOutputItem keySize output outputType = + fail $ + "Incorrect key size for output item or item already existed: " + <> show (keySize, output, outputType) getHDPath :: Int -> Get (PubKeyI, (Fingerprint, [KeyIndex])) getHDPath keySize = (,) - <$> S.isolate keySize deserialize - <*> (unPSBTHDPath <$> S.get) + <$> S.isolate keySize deserialize + <*> (unPSBTHDPath <$> S.get) putHDPath :: Enum t => t -> HashMap PubKeyI (Fingerprint, [KeyIndex]) -> Put putHDPath t = putPubKeyMap S.put t . fmap PSBTHDPath -newtype PSBTHDPath = - PSBTHDPath { unPSBTHDPath :: (Fingerprint, [KeyIndex]) } +newtype PSBTHDPath = PSBTHDPath {unPSBTHDPath :: (Fingerprint, [KeyIndex])} deriving (Show, Eq, Generic) instance NFData PSBTHDPath @@ -676,10 +890,10 @@ VarInt valueSize <- deserialize guard $ valueSize `mod` 4 == 0 let numIndices = (fromIntegral valueSize - 4) `div` 4 - PSBTHDPath <$> - S.isolate + PSBTHDPath + <$> S.isolate (fromIntegral valueSize) - ((,) <$> S.getWord32le <*> getKeyIndexList numIndices) + ((,) <$> S.get <*> getKeyIndexList numIndices) where getKeyIndexList n = replicateM n S.getWord32le @@ -687,7 +901,7 @@ putVarInt (B.length bs) S.putByteString bs where - bs = S.runPut $ S.putWord32le fp >> mapM_ S.putWord32le kis + bs = S.runPut $ S.put fp >> mapM_ S.putWord32le kis putPubKeyMap :: Enum t => (a -> Put) -> t -> HashMap PubKeyI a -> Put putPubKeyMap f t = @@ -706,3 +920,6 @@ whenJust :: Monad m => (a -> m ()) -> Maybe a -> m () whenJust = maybe (return ()) + +justWhen :: (a -> Bool) -> a -> Maybe a +justWhen test x = if test x then Just x else Nothing diff --git a/src/Haskoin/Transaction/Segwit.hs b/src/Haskoin/Transaction/Segwit.hs --- a/src/Haskoin/Transaction/Segwit.hs +++ b/src/Haskoin/Transaction/Segwit.hs @@ -1,7 +1,8 @@ -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TupleSections #-} -{-| +{-# LANGUAGE TupleSections #-} + +{- | Module : Haskoin.Transaction.Segwit Copyright : No rights reserved License : MIT @@ -14,103 +15,109 @@ and [BIP 143](https://github.com/bitcoin/bips/blob/master/bip-0143.mediawiki) for details. -} -module Haskoin.Transaction.Segwit - ( -- * Segwit - WitnessProgram (..) - , WitnessProgramPKH (..) - , WitnessProgramSH (..) - , isSegwit - - , viewWitnessProgram - , decodeWitnessInput +module Haskoin.Transaction.Segwit ( + -- * Segwit + WitnessProgram (..), + WitnessProgramPKH (..), + WitnessProgramSH (..), + isSegwit, + viewWitnessProgram, + decodeWitnessInput, + calcWitnessProgram, + simpleInputStack, + toWitnessStack, +) where - , calcWitnessProgram - , simpleInputStack - , toWitnessStack - ) where +import Data.ByteString (ByteString) +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import Haskoin.Data +import Haskoin.Keys.Common +import Haskoin.Script +import Haskoin.Transaction.Common -import Data.ByteString (ByteString) -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import Haskoin.Constants -import Haskoin.Keys.Common -import Haskoin.Script -import Haskoin.Transaction.Common +{- | Test if a 'ScriptOutput' is P2WPKH or P2WSH --- | Test if a 'ScriptOutput' is P2WPKH or P2WSH --- --- @since 0.11.0.0 + @since 0.11.0.0 +-} isSegwit :: ScriptOutput -> Bool isSegwit = \case - PayWitnessPKHash{} -> True + PayWitnessPKHash{} -> True PayWitnessScriptHash{} -> True - _ -> False + _ -> False --- | High level represenation of a (v0) witness program --- --- @since 0.11.0.0 +{- | High level represenation of a (v0) witness program + + @since 0.11.0.0 +-} data WitnessProgram = P2WPKH WitnessProgramPKH | P2WSH WitnessProgramSH | EmptyWitnessProgram deriving (Eq, Show) --- | Encode a witness program --- --- @since 0.11.0.0 +{- | Encode a witness program + + @since 0.11.0.0 +-} toWitnessStack :: WitnessProgram -> WitnessStack toWitnessStack = \case P2WPKH (WitnessProgramPKH sig key) -> [encodeTxSig sig, runPutS (serialize key)] P2WSH (WitnessProgramSH stack scr) -> stack <> [runPutS (serialize scr)] - EmptyWitnessProgram -> mempty + EmptyWitnessProgram -> mempty --- | High level representation of a P2WPKH witness --- --- @since 0.11.0.0 +{- | High level representation of a P2WPKH witness + + @since 0.11.0.0 +-} data WitnessProgramPKH = WitnessProgramPKH { witnessSignature :: !TxSignature - , witnessPubKey :: !PubKeyI + , witnessPubKey :: !PubKeyI } deriving (Eq, Show) --- | High-level representation of a P2WSH witness --- --- @since 0.11.0.0 +{- | High-level representation of a P2WSH witness + + @since 0.11.0.0 +-} data WitnessProgramSH = WitnessProgramSH - { witnessScriptHashStack :: ![ByteString] + { witnessScriptHashStack :: ![ByteString] , witnessScriptHashScript :: !Script } deriving (Eq, Show) --- | Calculate the witness program from the transaction data --- --- @since 0.11.0.0 +{- | Calculate the witness program from the transaction data + + @since 0.11.0.0 +-} viewWitnessProgram :: - Network -> ScriptOutput -> WitnessStack -> Either String WitnessProgram + Network -> ScriptOutput -> WitnessStack -> Either String WitnessProgram viewWitnessProgram net so witness = case so of PayWitnessPKHash _ | length witness == 2 -> do - sig <- decodeTxSig net $ head witness + sig <- decodeTxSig net $ head witness pubkey <- runGetS deserialize $ witness !! 1 return . P2WPKH $ WitnessProgramPKH sig pubkey PayWitnessScriptHash _ | not (null witness) -> do redeemScript <- runGetS deserialize $ last witness return . P2WSH $ WitnessProgramSH (init witness) redeemScript - _ | null witness -> return EmptyWitnessProgram - | otherwise -> Left "viewWitnessProgram: Invalid witness program" + _ + | null witness -> return EmptyWitnessProgram + | otherwise -> Left "viewWitnessProgram: Invalid witness program" --- | Analyze the witness, trying to match it with standard input structures --- --- @since 0.11.0.0 +{- | Analyze the witness, trying to match it with standard input structures + + @since 0.11.0.0 +-} decodeWitnessInput :: - Network - -> WitnessProgram - -> Either String (Maybe ScriptOutput, SimpleInput) + Network -> + WitnessProgram -> + Either String (Maybe ScriptOutput, SimpleInput) decodeWitnessInput net = \case P2WPKH (WitnessProgramPKH sig key) -> return (Nothing, SpendPKHash sig key) P2WSH (WitnessProgramSH st scr) -> do so <- decodeOutput scr - fmap (Just so, ) $ case (so, st) of + fmap (Just so,) $ case (so, st) of (PayPK _, [sigBS]) -> SpendPK <$> decodeTxSig net sigBS (PayPKHash _, [sigBS, keyBS]) -> @@ -120,28 +127,30 @@ _ -> Left "decodeWitnessInput: Non-standard script output" EmptyWitnessProgram -> Left "decodeWitnessInput: Empty witness program" --- | Create the witness program for a standard input --- --- @since 0.11.0.0 +{- | Create the witness program for a standard input + + @since 0.11.0.0 +-} calcWitnessProgram :: ScriptOutput -> ScriptInput -> Either String WitnessProgram calcWitnessProgram so si = case (so, si) of (PayWitnessPKHash{}, RegularInput (SpendPKHash sig pk)) -> p2wpkh sig pk - (PayScriptHash{}, RegularInput (SpendPKHash sig pk)) -> p2wpkh sig pk - (PayWitnessScriptHash{}, ScriptHashInput i o) -> p2wsh i o - (PayScriptHash{}, ScriptHashInput i o) -> p2wsh i o + (PayScriptHash{}, RegularInput (SpendPKHash sig pk)) -> p2wpkh sig pk + (PayWitnessScriptHash{}, ScriptHashInput i o) -> p2wsh i o + (PayScriptHash{}, ScriptHashInput i o) -> p2wsh i o _ -> Left "calcWitnessProgram: Invalid segwit SigInput" where p2wpkh sig = return . P2WPKH . WitnessProgramPKH sig - p2wsh i o = return . P2WSH $ WitnessProgramSH (simpleInputStack i) (encodeOutput o) + p2wsh i o = return . P2WSH $ WitnessProgramSH (simpleInputStack i) (encodeOutput o) --- | Create the witness stack required to spend a standard P2WSH input --- --- @since 0.11.0.0 +{- | Create the witness stack required to spend a standard P2WSH input + + @since 0.11.0.0 +-} simpleInputStack :: SimpleInput -> [ByteString] simpleInputStack = \case - SpendPK sig -> [f sig] + SpendPK sig -> [f sig] SpendPKHash sig k -> [f sig, runPutS (serialize k)] - SpendMulSig sigs -> "" : fmap f sigs + SpendMulSig sigs -> "" : fmap f sigs where f TxSignatureEmpty = "" - f sig = encodeTxSig sig + f sig = encodeTxSig sig diff --git a/src/Haskoin/Transaction/Taproot.hs b/src/Haskoin/Transaction/Taproot.hs new file mode 100644 --- /dev/null +++ b/src/Haskoin/Transaction/Taproot.hs @@ -0,0 +1,310 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +{- | +Module : Haskoin.Transaction.Taproot +Copyright : No rights reserved +License : MIT +Maintainer : jprupp@protonmail.ch +Stability : experimental +Portability : POSIX + +This module provides support for reperesenting full taproot outputs and parsing +taproot witnesses. For reference see BIPS 340, 341, and 342. +-} +module Haskoin.Transaction.Taproot ( + XOnlyPubKey (..), + TapLeafVersion, + MAST (..), + mastCommitment, + getMerkleProofs, + TaprootOutput (..), + taprootOutputKey, + taprootScriptOutput, + TaprootWitness (..), + ScriptPathData (..), + viewTaprootWitness, + encodeTaprootWitness, + verifyScriptPathData, +) where + +import Control.Applicative (many) +import Control.Monad ((<=<)) +import Crypto.Hash ( + Digest, + SHA256, + digestFromByteString, + hashFinalize, + hashUpdate, + hashUpdates, + ) +import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), withText) +import Data.Binary (Binary (..)) +import Data.Bits ((.&.), (.|.)) +import Data.Bool (bool) +import qualified Data.ByteArray as BA +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.Bytes.Get (getBytes, runGetS) +import Data.Bytes.Put (putByteString, runPutS) +import Data.Bytes.Serial (Serial (..), deserialize, serialize) +import Data.Bytes.VarInt (VarInt (VarInt)) +import Data.Foldable (foldl') +import Data.Maybe (fromMaybe, mapMaybe) +import Data.Serialize (Serialize, get, getByteString, getWord8, put) +import Data.Word (Word8) +import Haskoin.Crypto (PubKey, initTaggedHash, tweak, tweakAddPubKey) +import Haskoin.Keys.Common (PubKeyI (PubKeyI), pubKeyPoint) +import Haskoin.Script.Common (Script) +import Haskoin.Script.Standard (ScriptOutput (PayWitness)) +import Haskoin.Transaction.Common (WitnessStack) +import Haskoin.Util (decodeHex, eitherToMaybe, encodeHex) + +{- | An x-only pubkey corresponds to the keys @(x,y)@ and @(x, -y)@. The +equality test only checks the x-coordinate. An x-only pubkey serializes to 32 +bytes. + +@since 0.21.0 +-} +newtype XOnlyPubKey = XOnlyPubKey {xOnlyPubKey :: PubKey} + deriving (Show) + +instance Eq XOnlyPubKey where + k1 == k2 = runPutS (serialize k1) == runPutS (serialize k2) + +instance Serial XOnlyPubKey where + serialize (XOnlyPubKey pk) = + putByteString + . BS.drop 1 + . runPutS + . serialize + $ PubKeyI pk True + deserialize = + either fail (pure . XOnlyPubKey . pubKeyPoint) + . runGetS deserialize + . BS.cons 0x02 + =<< getBytes 32 + +instance Serialize XOnlyPubKey where + put = serialize + get = deserialize + +instance Binary XOnlyPubKey where + put = serialize + get = deserialize + +-- | Hex encoding +instance FromJSON XOnlyPubKey where + parseJSON = + withText "XOnlyPubKey" $ + either fail pure + . (runGetS deserialize <=< maybe (Left "Unable to decode hex") Right . decodeHex) + +-- | Hex encoding +instance ToJSON XOnlyPubKey where + toJSON = toJSON . encodeHex . runPutS . serialize + +-- | @since 0.21.0 +type TapLeafVersion = Word8 + +{- | Merklized Abstract Syntax Tree. This type can represent trees where only a +subset of the leaves are known. Note that the tree is invariant under swapping +branches at an internal node. + +@since 0.21.0 +-} +data MAST + = MASTBranch MAST MAST + | MASTLeaf TapLeafVersion Script + | MASTCommitment (Digest SHA256) + deriving (Show) + +{- | Get the inclusion proofs for the leaves in the tree. The proof is ordered +leaf-to-root. + +@since 0.21.0 +-} +getMerkleProofs :: MAST -> [(TapLeafVersion, Script, [Digest SHA256])] +getMerkleProofs = getProofs mempty + where + getProofs proof = \case + MASTBranch branchL branchR -> + (updateProof proof (mastCommitment branchR) <$> getMerkleProofs branchL) + <> (updateProof proof (mastCommitment branchL) <$> getMerkleProofs branchR) + MASTLeaf v s -> [(v, s, proof)] + MASTCommitment{} -> mempty + updateProof proofInit branchCommitment (v, s, proofTail) = + (v, s, reverse $ proofInit <> (branchCommitment : proofTail)) + +{- | Calculate the root hash for this tree. + +@since 0.21.0 +-} +mastCommitment :: MAST -> Digest SHA256 +mastCommitment = \case + MASTBranch leftBranch rightBranch -> + hashBranch (mastCommitment leftBranch) (mastCommitment rightBranch) + MASTLeaf leafVersion leafScript -> leafHash leafVersion leafScript + MASTCommitment theCommitment -> theCommitment + +hashBranch :: Digest SHA256 -> Digest SHA256 -> Digest SHA256 +hashBranch hashA hashB = + hashFinalize $ + hashUpdates + (initTaggedHash "TapBranch") + [ min hashA hashB + , max hashA hashB + ] + +leafHash :: TapLeafVersion -> Script -> Digest SHA256 +leafHash leafVersion leafScript = + hashFinalize + . hashUpdate (initTaggedHash "TapLeaf") + . runPutS + $ do + serialize leafVersion + serialize $ VarInt (BS.length scriptBytes) + putByteString scriptBytes + where + scriptBytes = runPutS $ serialize leafScript + +{- | Representation of a full taproot output. + +@since 0.21.0 +-} +data TaprootOutput = TaprootOutput + { taprootInternalKey :: PubKey + , taprootMAST :: Maybe MAST + } + deriving (Show) + +-- | @since 0.21.0 +taprootOutputKey :: TaprootOutput -> PubKey +taprootOutputKey TaprootOutput{taprootInternalKey, taprootMAST} = + fromMaybe keyFail $ tweak commitment >>= tweakAddPubKey taprootInternalKey + where + commitment = taprootCommitment taprootInternalKey $ mastCommitment <$> taprootMAST + keyFail = error "haskoin-core taprootOutputKey: key derivation failed" + +taprootCommitment :: PubKey -> Maybe (Digest SHA256) -> ByteString +taprootCommitment internalKey merkleRoot = + BA.convert . hashFinalize + . maybe id (flip hashUpdate) merkleRoot + . (`hashUpdate` keyBytes) + $ initTaggedHash "TapTweak" + where + keyBytes = runPutS . serialize $ XOnlyPubKey internalKey + +{- | Generate the output script for a taproot output + +@since 0.21.0 +-} +taprootScriptOutput :: TaprootOutput -> ScriptOutput +taprootScriptOutput = PayWitness 0x01 . runPutS . serialize . XOnlyPubKey . taprootOutputKey + +{- | Comprehension of taproot witness data + +@since 0.21.0 +-} +data TaprootWitness + = -- | Signature + KeyPathSpend ByteString + | ScriptPathSpend ScriptPathData + deriving (Eq, Show) + +-- | @since 0.21.0 +data ScriptPathData = ScriptPathData + { scriptPathAnnex :: Maybe ByteString + , scriptPathStack :: [ByteString] + , scriptPathScript :: Script + , scriptPathExternalIsOdd :: Bool + , -- | This value is masked by 0xFE + scriptPathLeafVersion :: Word8 + , scriptPathInternalKey :: PubKey + , scriptPathControl :: [ByteString] + } + deriving (Eq, Show) + +{- | Try to interpret a 'WitnessStack' as taproot witness data. + +@since 0.21.0 +-} +viewTaprootWitness :: WitnessStack -> Maybe TaprootWitness +viewTaprootWitness witnessStack = case reverse witnessStack of + [sig] -> Just $ KeyPathSpend sig + annexA : remainingStack + | 0x50 : _ <- BS.unpack annexA -> + parseSpendPathData (Just annexA) remainingStack + remainingStack -> parseSpendPathData Nothing remainingStack + where + parseSpendPathData scriptPathAnnex = \case + scriptBytes : controlBytes : scriptPathStack -> do + scriptPathScript <- eitherToMaybe $ runGetS deserialize scriptBytes + (v, scriptPathInternalKey, scriptPathControl) <- deconstructControl controlBytes + pure . ScriptPathSpend $ + ScriptPathData + { scriptPathAnnex + , scriptPathStack + , scriptPathScript + , scriptPathExternalIsOdd = odd v + , scriptPathLeafVersion = v .&. 0xFE + , scriptPathInternalKey + , scriptPathControl + } + _ -> Nothing + deconstructControl = eitherToMaybe . runGetS deserializeControl + deserializeControl = do + v <- getWord8 + k <- xOnlyPubKey <$> deserialize + proof <- many $ getByteString 32 + pure (v, k, proof) + +{- | Transform the high-level representation of taproot witness data into a witness stack + +@since 0.21.0 +-} +encodeTaprootWitness :: TaprootWitness -> WitnessStack +encodeTaprootWitness = \case + KeyPathSpend signature -> pure signature + ScriptPathSpend scriptPathData -> + scriptPathStack scriptPathData + <> [ runPutS . serialize $ scriptPathScript scriptPathData + , mconcat + [ BS.pack [scriptPathLeafVersion scriptPathData .|. parity scriptPathData] + , runPutS . serialize . XOnlyPubKey $ scriptPathInternalKey scriptPathData + , mconcat $ scriptPathControl scriptPathData + ] + , fromMaybe mempty $ scriptPathAnnex scriptPathData + ] + where + parity = bool 0 1 . scriptPathExternalIsOdd + +{- | Verify that the script path spend is valid, except for script execution. + +@since 0.21.0 +-} +verifyScriptPathData :: + -- | Output key + PubKey -> + ScriptPathData -> + Bool +verifyScriptPathData outputKey scriptPathData = fromMaybe False $ do + tweak commitment >>= fmap onComputedKey . tweakAddPubKey (scriptPathInternalKey scriptPathData) + where + onComputedKey computedKey = + XOnlyPubKey outputKey == XOnlyPubKey computedKey + && expectedParity == keyParity computedKey + commitment = taprootCommitment (scriptPathInternalKey scriptPathData) (Just merkleRoot) + merkleRoot = + foldl' hashBranch theLeafHash + . mapMaybe (digestFromByteString @SHA256) + $ scriptPathControl scriptPathData + theLeafHash = (leafHash <$> (.&. 0xFE) . scriptPathLeafVersion <*> scriptPathScript) scriptPathData + expectedParity = bool 0 1 $ scriptPathExternalIsOdd scriptPathData + +keyParity :: PubKey -> Word8 +keyParity key = case BS.unpack . runPutS . serialize $ PubKeyI key True of + 0x02 : _ -> 0x00 + _ -> 0x01 diff --git a/src/Haskoin/Util.hs b/src/Haskoin/Util.hs --- a/src/Haskoin/Util.hs +++ b/src/Haskoin/Util.hs @@ -1,7 +1,8 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-| + +{- | Module : Haskoin.Util Copyright : No rights reserved License : MIT @@ -11,75 +12,84 @@ This module defines various utility functions used across the library. -} -module Haskoin.Util - ( - -- * ByteString Helpers - bsToInteger - , integerToBS - , hexBuilder - , encodeHex - , encodeHexLazy - , decodeHex - , decodeHexLazy - , getBits - - -- * Maybe & Either Helpers - , eitherToMaybe - , maybeToEither - , liftEither - , liftMaybe +module Haskoin.Util ( + -- * ByteString Helpers + bsToInteger, + integerToBS, + hexBuilder, + encodeHex, + encodeHexLazy, + decodeHex, + decodeHexLazy, + getBits, - -- * Other Helpers - , updateIndex - , matchTemplate - , convertBits + -- * Maybe & Either Helpers + eitherToMaybe, + maybeToEither, + liftEither, + liftMaybe, - -- * Triples - , fst3 - , snd3 - , lst3 + -- * Other Helpers + updateIndex, + matchTemplate, + convertBits, - -- * JSON Utilities - , dropFieldLabel - , dropSumLabels + -- * Triples + fst3, + snd3, + lst3, - -- * Serialization Helpers - , putList, getList - , putMaybe, getMaybe - , putLengthBytes, getLengthBytes - , putInteger, getInteger - , putInt32be, getInt32be - , putInt64be, getInt64be - , getIntMap, putIntMap - , getTwo, putTwo + -- * JSON Utilities + dropFieldLabel, + dropSumLabels, - ) where + -- * Serialization Helpers + putList, + getList, + putMaybe, + getMaybe, + putLengthBytes, + getLengthBytes, + putInteger, + getInteger, + putInt32be, + getInt32be, + putInt64be, + getInt64be, + getIntMap, + putIntMap, + getTwo, + putTwo, +) where -import Control.Monad -import Control.Monad.Except (ExceptT (..), liftEither) -import Data.Aeson.Types (Options (..), SumEncoding (..), - defaultOptions, - defaultTaggedObject) -import Data.Bits -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import qualified Data.ByteString.Base16 as B16 -import Data.ByteString.Builder -import qualified Data.ByteString.Lazy as BL +import Control.Monad +import Control.Monad.Except (ExceptT (..), liftEither) +import Data.Aeson.Types ( + Options (..), + SumEncoding (..), + defaultOptions, + defaultTaggedObject, + ) +import Data.Bits +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base16 as B16 +import Data.ByteString.Builder +import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Base16 as BL16 -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import Data.Char (toLower) -import Data.Int -import Data.IntMap (IntMap) -import qualified Data.IntMap as IntMap -import Data.List -import Data.Text (Text) -import qualified Data.Text.Encoding as E -import qualified Data.Text.Lazy as TL -import qualified Data.Text.Lazy.Encoding as EL -import Data.Word +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.Char (toLower) +import Data.Int +import Data.IntMap (IntMap) +import qualified Data.IntMap as IntMap +import Data.List +import Data.Text (Text) +import qualified Data.Text.Encoding as E +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as EL +import Data.Word -- ByteString helpers @@ -93,7 +103,7 @@ integerToBS :: Integer -> ByteString integerToBS 0 = BS.pack [0] integerToBS i - | i > 0 = BS.reverse $ BS.unfoldr f i + | i > 0 = BS.reverse $ BS.unfoldr f i | otherwise = error "integerToBS not defined for negative values" where f 0 = Nothing @@ -116,9 +126,10 @@ decodeHexLazy :: TL.Text -> Maybe BL.ByteString decodeHexLazy = eitherToMaybe . BL16.decodeBase16 . EL.encodeUtf8 --- | Obtain 'Int' bits from beginning of 'ByteString'. Resulting 'ByteString' --- will be smallest required to hold that many bits, padded with zeroes to the --- right. +{- | Obtain 'Int' bits from beginning of 'ByteString'. Resulting 'ByteString' + will be smallest required to hold that many bits, padded with zeroes to the + right. +-} getBits :: Int -> ByteString -> ByteString getBits b bs | r == 0 = BS.take q bs @@ -131,14 +142,16 @@ -- Maybe and Either monad helpers --- | Transform an 'Either' value into a 'Maybe' value. 'Right' is mapped to --- 'Just' and 'Left' is mapped to 'Nothing'. The value inside 'Left' is lost. +{- | Transform an 'Either' value into a 'Maybe' value. 'Right' is mapped to + 'Just' and 'Left' is mapped to 'Nothing'. The value inside 'Left' is lost. +-} eitherToMaybe :: Either a b -> Maybe b eitherToMaybe (Right b) = Just b -eitherToMaybe _ = Nothing +eitherToMaybe _ = Nothing --- | Transform a 'Maybe' value into an 'Either' value. 'Just' is mapped to --- 'Right' and 'Nothing' is mapped to 'Left'. Default 'Left' required. +{- | Transform a 'Maybe' value into an 'Either' value. 'Just' is mapped to + 'Right' and 'Nothing' is mapped to 'Left'. Default 'Left' required. +-} maybeToEither :: b -> Maybe a -> Either b a maybeToEither err = maybe (Left err) Right @@ -148,62 +161,77 @@ -- Various helpers --- | Applies a function to only one element of a list defined by its index. If --- the index is out of the bounds of the list, the original list is returned. -updateIndex :: Int -- ^ index of the element to change - -> [a] -- ^ list of elements - -> (a -> a) -- ^ function to apply - -> [a] -- ^ result with one element changed +{- | Applies a function to only one element of a list defined by its index. If + the index is out of the bounds of the list, the original list is returned. +-} +updateIndex :: + -- | index of the element to change + Int -> + -- | list of elements + [a] -> + -- | function to apply + (a -> a) -> + -- | result with one element changed + [a] updateIndex i xs f | i < 0 || i >= length xs = xs | otherwise = l ++ (f h : r) where - (l,h:r) = splitAt i xs + (l, h : r) = splitAt i xs --- | Use the list @[b]@ as a template and try to match the elements of @[a]@ --- against it. For each element of @[b]@ return the (first) matching element of --- @[a]@, or 'Nothing'. Output list has same size as @[b]@ and contains results --- in same order. Elements of @[a]@ can only appear once. -matchTemplate :: [a] -- ^ input list - -> [b] -- ^ list to serve as a template - -> (a -> b -> Bool) -- ^ comparison function - -> [Maybe a] +{- | Use the list @[b]@ as a template and try to match the elements of @[a]@ + against it. For each element of @[b]@ return the (first) matching element of + @[a]@, or 'Nothing'. Output list has same size as @[b]@ and contains results + in same order. Elements of @[a]@ can only appear once. +-} +matchTemplate :: + -- | input list + [a] -> + -- | list to serve as a template + [b] -> + -- | comparison function + (a -> b -> Bool) -> + [Maybe a] matchTemplate [] bs _ = replicate (length bs) Nothing -matchTemplate _ [] _ = [] -matchTemplate as (b:bs) f = case break (`f` b) as of - (l,r:rs) -> Just r : matchTemplate (l ++ rs) bs f - _ -> Nothing : matchTemplate as bs f +matchTemplate _ [] _ = [] +matchTemplate as (b : bs) f = case break (`f` b) as of + (l, r : rs) -> Just r : matchTemplate (l ++ rs) bs f + _ -> Nothing : matchTemplate as bs f -- | Returns the first value of a triple. -fst3 :: (a,b,c) -> a -fst3 (a,_,_) = a +fst3 :: (a, b, c) -> a +fst3 (a, _, _) = a -- | Returns the second value of a triple. -snd3 :: (a,b,c) -> b -snd3 (_,b,_) = b +snd3 :: (a, b, c) -> b +snd3 (_, b, _) = b -- | Returns the last value of a triple. -lst3 :: (a,b,c) -> c -lst3 (_,_,c) = c +lst3 :: (a, b, c) -> c +lst3 (_, _, c) = c -- | Field label goes lowercase and first @n@ characters get removed. dropFieldLabel :: Int -> Options -dropFieldLabel n = defaultOptions - { fieldLabelModifier = map toLower . drop n - } +dropFieldLabel n = + defaultOptions + { fieldLabelModifier = map toLower . drop n + } --- | Transformation from 'dropFieldLabel' is applied with argument @f@, plus --- constructor tags are lowercased and first @c@ characters removed. @tag@ is --- used as the name of the object field name that will hold the transformed --- constructor tag as its value. +{- | Transformation from 'dropFieldLabel' is applied with argument @f@, plus + constructor tags are lowercased and first @c@ characters removed. @tag@ is + used as the name of the object field name that will hold the transformed + constructor tag as its value. +-} dropSumLabels :: Int -> Int -> String -> Options -dropSumLabels c f tag = (dropFieldLabel f) - { constructorTagModifier = map toLower . drop c - , sumEncoding = defaultTaggedObject { tagFieldName = tag } - } +dropSumLabels c f tag = + (dropFieldLabel f) + { constructorTagModifier = map toLower . drop c + , sumEncoding = defaultTaggedObject{tagFieldName = tag} + } --- | Convert from one power-of-two base to another, as long as it fits in a --- 'Word'. +{- | Convert from one power-of-two base to another, as long as it fits in a + 'Word'. +-} convertBits :: Bool -> Int -> Int -> [Word] -> ([Word], Bool) convertBits pad frombits tobits i = (reverse yout, rem') where @@ -211,7 +239,7 @@ (yout, rem') | pad && xbits /= 0 = let xout' = (xacc `shiftL` (tobits - xbits)) .&. maxv : xout - in (xout', False) + in (xout', False) | pad = (xout, False) | xbits /= 0 = (xout, True) | otherwise = (xout, False) @@ -221,12 +249,12 @@ let acc' = ((acc `shiftL` frombits) .|. it) .&. max_acc bits' = bits + frombits (out', bits'') = inner acc' out bits' - in (acc', bits'', out') + in (acc', bits'', out') inner acc out bits | bits >= tobits = let bits' = bits - tobits out' = ((acc `shiftR` bits') .&. maxv) : out - in inner acc out' bits' + in inner acc out' bits' | otherwise = (out, bits) -- @@ -260,14 +288,14 @@ putInteger :: MonadPut m => Integer -> m () putInteger n | n >= lo && n <= hi = do - putWord8 0x00 - putInt32be (fromIntegral n) + putWord8 0x00 + putInt32be (fromIntegral n) | otherwise = do - putWord8 0x01 - putWord8 (fromIntegral (signum n)) - let len = (nrBits (abs n) + 7) `div` 8 - putWord64be (fromIntegral len) - mapM_ putWord8 (unroll (abs n)) + putWord8 0x01 + putWord8 (fromIntegral (signum n)) + let len = (nrBits (abs n) + 7) `div` 8 + putWord64be (fromIntegral len) + mapM_ putWord8 (unroll (abs n)) where lo = fromIntegral (minBound :: Int32) hi = fromIntegral (maxBound :: Int32) @@ -275,23 +303,23 @@ getInteger :: MonadGet m => m Integer getInteger = getWord8 >>= \case - 0 -> fromIntegral <$> getInt32be - _ -> do - sign <- getWord8 - bytes <- getList getWord8 - let v = roll bytes - return $! if sign == 0x01 then v else - v + 0 -> fromIntegral <$> getInt32be + _ -> do + sign <- getWord8 + bytes <- getList getWord8 + let v = roll bytes + return $! if sign == 0x01 then v else - v putMaybe :: MonadPut m => (a -> m ()) -> Maybe a -> m () -putMaybe f Nothing = putWord8 0x00 +putMaybe f Nothing = putWord8 0x00 putMaybe f (Just x) = putWord8 0x01 >> f x getMaybe :: MonadGet m => m a -> m (Maybe a) getMaybe f = getWord8 >>= \case - 0x00 -> return Nothing - 0x01 -> Just <$> f - _ -> fail "Not a Maybe" + 0x00 -> return Nothing + 0x01 -> Just <$> f + _ -> fail "Not a Maybe" putLengthBytes :: MonadPut m => ByteString -> m () putLengthBytes bs = do @@ -313,7 +341,7 @@ step i = Just (fromIntegral i, i `shiftR` 8) roll :: (Integral a, Bits a) => [Word8] -> a -roll = foldr unstep 0 +roll = foldr unstep 0 where unstep b a = a `shiftL` 8 .|. fromIntegral b @@ -324,9 +352,10 @@ findNr lo hi | mid == lo = hi | 2 ^ mid <= k = findNr mid hi - | 2 ^ mid > k = findNr lo mid - where mid = (lo + hi) `div` 2 - in findNr (expMax `div` 2) expMax + | 2 ^ mid > k = findNr lo mid + where + mid = (lo + hi) `div` 2 + in findNr (expMax `div` 2) expMax -- | Read as a list of pairs of int and element. getIntMap :: MonadGet m => m Int -> m a -> m (IntMap a) diff --git a/src/Haskoin/Util/Arbitrary.hs b/src/Haskoin/Util/Arbitrary.hs --- a/src/Haskoin/Util/Arbitrary.hs +++ b/src/Haskoin/Util/Arbitrary.hs @@ -1,4 +1,4 @@ -{-| +{- | Module : Haskoin.Test Copyright : No rights reserved License : MIT @@ -8,16 +8,16 @@ Arbitrary instances for testing. -} -module Haskoin.Util.Arbitrary - ( module X - ) where +module Haskoin.Util.Arbitrary ( + module X, +) where -import Haskoin.Util.Arbitrary.Address as X -import Haskoin.Util.Arbitrary.Block as X -import Haskoin.Util.Arbitrary.Crypto as X -import Haskoin.Util.Arbitrary.Keys as X -import Haskoin.Util.Arbitrary.Message as X -import Haskoin.Util.Arbitrary.Network as X -import Haskoin.Util.Arbitrary.Script as X -import Haskoin.Util.Arbitrary.Transaction as X -import Haskoin.Util.Arbitrary.Util as X +import Haskoin.Util.Arbitrary.Address as X +import Haskoin.Util.Arbitrary.Block as X +import Haskoin.Util.Arbitrary.Crypto as X +import Haskoin.Util.Arbitrary.Keys as X +import Haskoin.Util.Arbitrary.Message as X +import Haskoin.Util.Arbitrary.Network as X +import Haskoin.Util.Arbitrary.Script as X +import Haskoin.Util.Arbitrary.Transaction as X +import Haskoin.Util.Arbitrary.Util as X diff --git a/src/Haskoin/Util/Arbitrary/Address.hs b/src/Haskoin/Util/Arbitrary/Address.hs --- a/src/Haskoin/Util/Arbitrary/Address.hs +++ b/src/Haskoin/Util/Arbitrary/Address.hs @@ -1,5 +1,6 @@ {-# LANGUAGE TupleSections #-} -{-| + +{- | Module : Haskoin.Test.Address Copyright : No rights reserved License : MIT @@ -10,11 +11,12 @@ module Haskoin.Util.Arbitrary.Address where import qualified Data.ByteString as B -import Haskoin.Address -import Haskoin.Constants -import Haskoin.Util.Arbitrary.Crypto -import Haskoin.Util.Arbitrary.Util -import Test.QuickCheck +import Haskoin.Address +import Haskoin.Constants +import Haskoin.Data +import Haskoin.Util.Arbitrary.Crypto +import Haskoin.Util.Arbitrary.Util +import Test.QuickCheck -- | Arbitrary pay-to-public-key-hash or pay-to-script-hash address. arbitraryAddress :: Gen Address @@ -23,20 +25,21 @@ -- | Arbitrary address including pay-to-witness arbitraryAddressAll :: Gen Address arbitraryAddressAll = - oneof [ arbitraryPubKeyAddress - , arbitraryScriptAddress - , arbitraryWitnessPubKeyAddress - , arbitraryWitnessScriptAddress - , arbitraryWitnessAddress - ] + oneof + [ arbitraryPubKeyAddress + , arbitraryScriptAddress + , arbitraryWitnessPubKeyAddress + , arbitraryWitnessScriptAddress + , arbitraryWitnessAddress + ] -- | Arbitrary valid combination of (Network, Address) arbitraryNetAddress :: Gen (Network, Address) arbitraryNetAddress = do net <- arbitraryNetwork - if net `elem` [bch, bchTest, bchRegTest] - then (net, ) <$> arbitraryAddress - else (net, ) <$> arbitraryAddressAll + if net `elem` [bch, bchTest, bchTest4, bchRegTest] + then (net,) <$> arbitraryAddress + else (net,) <$> arbitraryAddressAll -- | Arbitrary pay-to-public-key-hash address. arbitraryPubKeyAddress :: Gen Address diff --git a/src/Haskoin/Util/Arbitrary/Block.hs b/src/Haskoin/Util/Arbitrary/Block.hs --- a/src/Haskoin/Util/Arbitrary/Block.hs +++ b/src/Haskoin/Util/Arbitrary/Block.hs @@ -1,4 +1,4 @@ -{-| +{- | Module : Haskoin.Test.Block Copyright : No rights reserved License : MIT @@ -8,20 +8,20 @@ -} module Haskoin.Util.Arbitrary.Block where -import qualified Data.HashMap.Strict as HashMap -import Haskoin.Block -import Haskoin.Constants -import Haskoin.Util.Arbitrary.Util -import Haskoin.Util.Arbitrary.Crypto -import Haskoin.Util.Arbitrary.Network -import Haskoin.Util.Arbitrary.Transaction -import Test.QuickCheck +import qualified Data.HashMap.Strict as HashMap +import Haskoin.Block +import Haskoin.Data +import Haskoin.Util.Arbitrary.Crypto +import Haskoin.Util.Arbitrary.Network +import Haskoin.Util.Arbitrary.Transaction +import Haskoin.Util.Arbitrary.Util +import Test.QuickCheck -- | Block full or arbitrary transactions. arbitraryBlock :: Network -> Gen Block arbitraryBlock net = do - h <- arbitraryBlockHeader - c <- choose (0,10) + h <- arbitraryBlockHeader + c <- choose (0, 10) txs <- vectorOf c (arbitraryTx net) return $ Block h txs @@ -29,11 +29,11 @@ arbitraryBlockHeader :: Gen BlockHeader arbitraryBlockHeader = BlockHeader <$> arbitrary - <*> arbitraryBlockHash - <*> arbitraryHash256 - <*> arbitrary - <*> arbitrary - <*> arbitrary + <*> arbitraryBlockHash + <*> arbitraryHash256 + <*> arbitrary + <*> arbitrary + <*> arbitrary -- | Arbitrary block hash. arbitraryBlockHash :: Gen BlockHash @@ -43,15 +43,15 @@ arbitraryGetBlocks :: Gen GetBlocks arbitraryGetBlocks = GetBlocks <$> arbitrary - <*> listOf1 arbitraryBlockHash - <*> arbitraryBlockHash + <*> listOf1 arbitraryBlockHash + <*> arbitraryBlockHash -- | Arbitrary 'GetHeaders' object with at least one block header. arbitraryGetHeaders :: Gen GetHeaders arbitraryGetHeaders = GetHeaders <$> arbitrary - <*> listOf1 arbitraryBlockHash - <*> arbitraryBlockHash + <*> listOf1 arbitraryBlockHash + <*> arbitraryBlockHash -- | Arbitrary 'Headers' object with at least one block header. arbitraryHeaders :: Gen Headers @@ -61,29 +61,26 @@ -- | Arbitrary 'MerkleBlock' with at least one hash. arbitraryMerkleBlock :: Gen MerkleBlock arbitraryMerkleBlock = do - bh <- arbitraryBlockHeader - ntx <- arbitrary + bh <- arbitraryBlockHeader + ntx <- arbitrary hashes <- listOf1 arbitraryHash256 - c <- choose (1,10) - flags <- vectorOf (c*8) arbitrary + c <- choose (1, 10) + flags <- vectorOf (c * 8) arbitrary return $ MerkleBlock bh ntx hashes flags -- | Arbitrary 'BlockNode' arbitraryBlockNode :: Gen BlockNode arbitraryBlockNode = oneof - [ BlockNode - <$> arbitraryBlockHeader - <*> choose (0, maxBound) - <*> arbitrarySizedNatural - <*> arbitraryBlockHash - ] + [ BlockNode + <$> arbitraryBlockHeader + <*> choose (0, maxBound) + <*> arbitrarySizedNatural + <*> arbitraryBlockHash + ] -- | Arbitrary 'HeaderMemory' arbitraryHeaderMemory :: Gen HeaderMemory arbitraryHeaderMemory = do ls <- listOf $ (,) <$> arbitrary <*> arbitraryBSS - HeaderMemory - <$> (return $ HashMap.fromList ls) - <*> arbitraryBlockNode - + HeaderMemory (HashMap.fromList ls) <$> arbitraryBlockNode diff --git a/src/Haskoin/Util/Arbitrary/Crypto.hs b/src/Haskoin/Util/Arbitrary/Crypto.hs --- a/src/Haskoin/Util/Arbitrary/Crypto.hs +++ b/src/Haskoin/Util/Arbitrary/Crypto.hs @@ -1,4 +1,4 @@ -{-| +{- | Module : Haskoin.Test.Crypto Copyright : No rights reserved License : MIT @@ -8,9 +8,9 @@ -} module Haskoin.Util.Arbitrary.Crypto where -import Haskoin.Crypto.Hash -import Haskoin.Util.Arbitrary.Util -import Test.QuickCheck +import Haskoin.Crypto.Hash +import Haskoin.Util.Arbitrary.Util +import Test.QuickCheck -- | Arbitrary 160-bit hash. arbitraryHash160 :: Gen Hash160 diff --git a/src/Haskoin/Util/Arbitrary/Keys.hs b/src/Haskoin/Util/Arbitrary/Keys.hs --- a/src/Haskoin/Util/Arbitrary/Keys.hs +++ b/src/Haskoin/Util/Arbitrary/Keys.hs @@ -1,4 +1,4 @@ -{-| +{- | Module : Haskoin.Test.Keys Copyright : No rights reserved License : MIT @@ -8,14 +8,16 @@ -} module Haskoin.Util.Arbitrary.Keys where -import Data.Bits (clearBit) -import Data.List (foldl') -import Data.Word (Word32) -import Haskoin.Crypto -import Haskoin.Keys.Common -import Haskoin.Keys.Extended -import Haskoin.Util.Arbitrary.Crypto -import Test.QuickCheck +import Data.Bits (clearBit) +import Data.Coerce (coerce) +import Data.List (foldl') +import Data.Word (Word32) +import Haskoin.Crypto +import Haskoin.Keys.Common +import Haskoin.Keys.Extended +import Haskoin.Keys.Extended.Internal (Fingerprint (..)) +import Haskoin.Util.Arbitrary.Crypto +import Test.QuickCheck -- | Arbitrary private key with arbitrary compressed flag. arbitrarySecKeyI :: Gen SecKeyI @@ -27,14 +29,17 @@ k <- arbitrarySecKeyI return (k, derivePubKeyI k) +arbitraryFingerprint :: Gen Fingerprint +arbitraryFingerprint = Fingerprint <$> arbitrary + -- | Arbitrary extended private key. arbitraryXPrvKey :: Gen XPrvKey arbitraryXPrvKey = XPrvKey <$> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitraryHash256 - <*> arbitrary + <*> arbitraryFingerprint + <*> arbitrary + <*> arbitraryHash256 + <*> arbitrary -- | Arbitrary extended public key with its corresponding private key. arbitraryXPubKey :: Gen (XPrvKey, XPubKey) @@ -49,9 +54,10 @@ -- | Arbitrary BIP-32 path index. Can be hardened or not. arbitraryBip32PathIndex :: Gen Bip32PathIndex arbitraryBip32PathIndex = - oneof [ Bip32SoftIndex <$> genIndex - , Bip32HardIndex <$> genIndex - ] + oneof + [ Bip32SoftIndex <$> genIndex + , Bip32HardIndex <$> genIndex + ] -- | Arbitrary BIP-32 derivation path composed of only hardened derivations. arbitraryHardPath :: Gen HardPath @@ -65,18 +71,21 @@ arbitraryDerivPath :: Gen DerivPath arbitraryDerivPath = concatBip32Segments <$> listOf arbitraryBip32PathIndex --- | Arbitrary parsed derivation path. Can contain 'ParsedPrv', 'ParsedPub' or --- 'ParsedEmpty' elements. +{- | Arbitrary parsed derivation path. Can contain 'ParsedPrv', 'ParsedPub' or + 'ParsedEmpty' elements. +-} arbitraryParsedPath :: Gen ParsedPath arbitraryParsedPath = - oneof [ ParsedPrv <$> arbitraryDerivPath - , ParsedPub <$> arbitraryDerivPath - , ParsedEmpty <$> arbitraryDerivPath - ] + oneof + [ ParsedPrv <$> arbitraryDerivPath + , ParsedPub <$> arbitraryDerivPath + , ParsedEmpty <$> arbitraryDerivPath + ] --- | Arbitrary message hash, private key, nonce and corresponding signature. The --- signature is generated with a random message, random private key and a random --- nonce. +{- | Arbitrary message hash, private key, nonce and corresponding signature. The + signature is generated with a random message, random private key and a random + nonce. +-} arbitrarySignature :: Gen (Hash256, SecKey, Sig) arbitrarySignature = do m <- arbitraryHash256 diff --git a/src/Haskoin/Util/Arbitrary/Message.hs b/src/Haskoin/Util/Arbitrary/Message.hs --- a/src/Haskoin/Util/Arbitrary/Message.hs +++ b/src/Haskoin/Util/Arbitrary/Message.hs @@ -1,4 +1,4 @@ -{-| +{- | Module : Haskoin.Test.Message Copyright : No rights reserved License : MIT @@ -8,21 +8,21 @@ -} module Haskoin.Util.Arbitrary.Message where -import Haskoin.Constants -import Haskoin.Network.Message -import Haskoin.Util.Arbitrary.Block -import Haskoin.Util.Arbitrary.Crypto -import Haskoin.Util.Arbitrary.Network -import Haskoin.Util.Arbitrary.Transaction -import Test.QuickCheck +import Haskoin.Data +import Haskoin.Network.Message +import Haskoin.Util.Arbitrary.Block +import Haskoin.Util.Arbitrary.Crypto +import Haskoin.Util.Arbitrary.Network +import Haskoin.Util.Arbitrary.Transaction +import Test.QuickCheck -- | Arbitrary 'MessageHeader'. arbitraryMessageHeader :: Gen MessageHeader arbitraryMessageHeader = MessageHeader <$> arbitrary - <*> arbitraryMessageCommand - <*> arbitrary - <*> arbitraryCheckSum32 + <*> arbitraryMessageCommand + <*> arbitrary + <*> arbitraryCheckSum32 -- | Arbitrary 'Message'. arbitraryMessage :: Network -> Gen Message diff --git a/src/Haskoin/Util/Arbitrary/Network.hs b/src/Haskoin/Util/Arbitrary/Network.hs --- a/src/Haskoin/Util/Arbitrary/Network.hs +++ b/src/Haskoin/Util/Arbitrary/Network.hs @@ -1,4 +1,4 @@ -{-| +{- | Module : Haskoin.Test.Network Copyright : No rights reserved License : MIT @@ -8,14 +8,14 @@ -} module Haskoin.Util.Arbitrary.Network where -import qualified Data.ByteString as BS (empty, pack) -import qualified Data.ByteString.Char8 as C8 -import Data.Word (Word16, Word32) -import Haskoin.Network -import Haskoin.Util.Arbitrary.Crypto -import Haskoin.Util.Arbitrary.Util -import Network.Socket (SockAddr (..)) -import Test.QuickCheck +import qualified Data.ByteString as BS (empty, pack) +import qualified Data.ByteString.Char8 as C8 +import Data.Word (Word16, Word32) +import Haskoin.Network +import Haskoin.Util.Arbitrary.Crypto +import Haskoin.Util.Arbitrary.Util +import Network.Socket (SockAddr (..)) +import Test.QuickCheck -- | Arbitrary 'VarInt'. arbitraryVarInt :: Gen VarInt @@ -31,14 +31,15 @@ s <- arbitrary a <- arbitrary p <- arbitrary - d <- oneof - [ do - b <- arbitrary - c <- arbitrary - d <- arbitrary - return $ SockAddrInet6 (fromIntegral p) 0 (a,b,c,d) 0 - , return $ SockAddrInet (fromIntegral (p :: Word16)) a - ] + d <- + oneof + [ do + b <- arbitrary + c <- arbitrary + d <- arbitrary + return $ SockAddrInet6 (fromIntegral p) 0 (a, b, c, d) 0 + , return $ SockAddrInet (fromIntegral (p :: Word16)) a + ] let n = sockToHostAddress d return $ NetworkAddress s n @@ -62,21 +63,22 @@ arbitraryVersion :: Gen Version arbitraryVersion = Version <$> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitraryNetworkAddress - <*> arbitraryNetworkAddress - <*> arbitrary - <*> arbitraryVarString - <*> arbitrary - <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitraryNetworkAddress + <*> arbitraryNetworkAddress + <*> arbitrary + <*> arbitraryVarString + <*> arbitrary + <*> arbitrary -- | Arbitrary non-empty 'Addr'. arbitraryAddr1 :: Gen Addr arbitraryAddr1 = Addr <$> listOf1 arbitraryNetworkAddressTime --- | Arbitrary 'Alert' with random payload and signature. Signature is not --- valid. +{- | Arbitrary 'Alert' with random payload and signature. Signature is not + valid. +-} arbitraryAlert :: Gen Alert arbitraryAlert = Alert <$> arbitraryVarString <*> arbitraryVarString @@ -86,9 +88,11 @@ m <- arbitraryMessageCommand c <- arbitraryRejectCode s <- arbitraryVarString - d <- oneof [ return BS.empty - , BS.pack <$> vectorOf 32 arbitrary - ] + d <- + oneof + [ return BS.empty + , BS.pack <$> vectorOf 32 arbitrary + ] return $ Reject m c s d -- | Arbitrary 'RejectCode'. @@ -130,14 +134,15 @@ , BloomUpdateP2PubKeyOnly ] --- | Arbitrary bloom filter with its corresponding number of elements --- and false positive rate. +{- | Arbitrary bloom filter with its corresponding number of elements + and false positive rate. +-} arbitraryBloomFilter :: Gen (Int, Double, BloomFilter) arbitraryBloomFilter = do - n <- choose (0,100000) - fp <- choose (1e-8,1) + n <- choose (0, 100000) + fp <- choose (1e-8, 1) tweak <- arbitrary - fl <- arbitraryBloomFlags + fl <- arbitraryBloomFlags return (n, fp, bloomCreate n fp tweak fl) -- | Arbitrary 'FilterLoad'. diff --git a/src/Haskoin/Util/Arbitrary/Script.hs b/src/Haskoin/Util/Arbitrary/Script.hs --- a/src/Haskoin/Util/Arbitrary/Script.hs +++ b/src/Haskoin/Util/Arbitrary/Script.hs @@ -1,5 +1,6 @@ {-# LANGUAGE LambdaCase #-} -{-| + +{- | Module : Haskoin.Test.Script Copyright : No rights reserved License : MIT @@ -9,21 +10,22 @@ -} module Haskoin.Util.Arbitrary.Script where -import Crypto.Secp256k1 -import qualified Data.ByteString as B -import Data.Maybe -import Data.Word -import Haskoin.Address -import Haskoin.Constants -import Haskoin.Keys.Common -import Haskoin.Script -import Haskoin.Transaction.Common -import Haskoin.Util -import Haskoin.Util.Arbitrary.Address -import Haskoin.Util.Arbitrary.Crypto -import Haskoin.Util.Arbitrary.Keys -import Haskoin.Util.Arbitrary.Util -import Test.QuickCheck +import Crypto.Secp256k1 +import qualified Data.ByteString as B +import Data.Maybe +import Data.Word +import Haskoin.Address +import Haskoin.Constants +import Haskoin.Data +import Haskoin.Keys.Common +import Haskoin.Script +import Haskoin.Transaction.Common +import Haskoin.Util +import Haskoin.Util.Arbitrary.Address +import Haskoin.Util.Arbitrary.Crypto +import Haskoin.Util.Arbitrary.Keys +import Haskoin.Util.Arbitrary.Util +import Test.QuickCheck -- | Arbitrary 'Script' with random script ops. arbitraryScript :: Gen Script @@ -33,7 +35,7 @@ arbitraryScriptOp :: Gen ScriptOp arbitraryScriptOp = oneof - -- Pushing Data + -- Pushing Data [ opPushData <$> arbitraryBS1 , return OP_0 , return OP_1NEGATE @@ -54,8 +56,8 @@ , return OP_14 , return OP_15 , return OP_16 - -- Flow control - , return OP_NOP + , -- Flow control + return OP_NOP , return OP_VER , return OP_IF , return OP_NOTIF @@ -65,8 +67,8 @@ , return OP_ENDIF , return OP_VERIFY , return OP_RETURN - -- Stack operations - , return OP_TOALTSTACK + , -- Stack operations + return OP_TOALTSTACK , return OP_FROMALTSTACK , return OP_IFDUP , return OP_DEPTH @@ -85,14 +87,14 @@ , return OP_2OVER , return OP_2ROT , return OP_2SWAP - -- Splice - , return OP_CAT + , -- Splice + return OP_CAT , return OP_SUBSTR , return OP_LEFT , return OP_RIGHT , return OP_SIZE - -- Bitwise logic - , return OP_INVERT + , -- Bitwise logic + return OP_INVERT , return OP_AND , return OP_OR , return OP_XOR @@ -100,8 +102,8 @@ , return OP_EQUALVERIFY , return OP_RESERVED1 , return OP_RESERVED2 - -- Arithmetic - , return OP_1ADD + , -- Arithmetic + return OP_1ADD , return OP_1SUB , return OP_2MUL , return OP_2DIV @@ -128,8 +130,8 @@ , return OP_MIN , return OP_MAX , return OP_WITHIN - -- Crypto - , return OP_RIPEMD160 + , -- Crypto + return OP_RIPEMD160 , return OP_SHA1 , return OP_SHA256 , return OP_HASH160 @@ -139,8 +141,8 @@ , return OP_CHECKSIGVERIFY , return OP_CHECKMULTISIG , return OP_CHECKMULTISIGVERIFY - -- Expansion - , return OP_NOP1 + , -- Expansion + return OP_NOP1 , return OP_CHECKLOCKTIMEVERIFY , return OP_CHECKSEQUENCEVERIFY , return OP_NOP4 @@ -150,13 +152,13 @@ , return OP_NOP8 , return OP_NOP9 , return OP_NOP10 - -- Bitcoin Cash Nov 2018 hard fork - , return OP_CHECKDATASIG + , -- Bitcoin Cash Nov 2018 hard fork + return OP_CHECKDATASIG , return OP_CHECKDATASIGVERIFY - -- Bitcoin Cash May 2020 hard fork - , return OP_REVERSEBYTES - -- Other - , return OP_PUBKEYHASH + , -- Bitcoin Cash May 2020 hard fork + return OP_REVERSEBYTES + , -- Other + return OP_PUBKEYHASH , return OP_PUBKEY , return $ OP_INVALIDOPCODE 0xff ] @@ -165,10 +167,22 @@ arbitraryIntScriptOp :: Gen ScriptOp arbitraryIntScriptOp = elements - [ OP_1, OP_2, OP_3, OP_4 - , OP_5, OP_6, OP_7, OP_8 - , OP_9, OP_10, OP_11, OP_12 - , OP_13, OP_14, OP_15, OP_16 + [ OP_1 + , OP_2 + , OP_3 + , OP_4 + , OP_5 + , OP_6 + , OP_7 + , OP_8 + , OP_9 + , OP_10 + , OP_11 + , OP_12 + , OP_13 + , OP_14 + , OP_15 + , OP_16 ] -- | Arbitrary 'PushDataType'. @@ -185,9 +199,9 @@ sh <- elements [sigHashAll, sigHashNone, sigHashSingle] f1 <- elements $ - if isJust (getSigHashForkId net) - then [id, setForkIdFlag] - else [id] + if isJust (getSigHashForkId net) + then [id, setForkIdFlag] + else [id] f2 <- elements [id, setAnyoneCanPayFlag] return $ f1 $ f2 sh @@ -201,9 +215,10 @@ , SIGHASH_ANYONECANPAY ] --- | Arbitrary message hash, private key and corresponding 'TxSignature'. The --- signature is generated deterministically using a random message and a random --- private key. +{- | Arbitrary message hash, private key and corresponding 'TxSignature'. The + signature is generated deterministically using a random message and a random + private key. +-} arbitraryTxSignature :: Network -> Gen (TxHash, SecKey, TxSignature) arbitraryTxSignature net = do (m, key, sig) <- arbitrarySignature @@ -211,43 +226,47 @@ let txsig = TxSignature sig sh return (TxHash m, key, txsig) where - filterBad sh = not $ - isSigHashUnknown sh || - isNothing (getSigHashForkId net) && hasForkIdFlag sh + filterBad sh = + not $ + isSigHashUnknown sh + || isNothing (getSigHashForkId net) && hasForkIdFlag sh -- | Arbitrary transaction signature that could also be empty. arbitraryTxSignatureEmpty :: Network -> Gen TxSignature arbitraryTxSignatureEmpty net = - frequency [ (1, return TxSignatureEmpty) - , (10, lst3 <$> arbitraryTxSignature net) - ] + frequency + [ (1, return TxSignatureEmpty) + , (10, lst3 <$> arbitraryTxSignature net) + ] -- | Arbitrary m of n parameters. arbitraryMSParam :: Gen (Int, Int) arbitraryMSParam = do - m <- choose (1,16) - n <- choose (m,16) + m <- choose (1, 16) + n <- choose (m, 16) return (m, n) -- | Arbitrary 'ScriptOutput' (Can by any valid type). arbitraryScriptOutput :: Network -> Gen ScriptOutput arbitraryScriptOutput net = oneof $ - [ arbitraryPKOutput - , arbitraryPKHashOutput - , arbitraryMSOutput - , arbitrarySHOutput - , arbitraryDCOutput - ] ++ - if getSegWit net - then [ arbitraryWPKHashOutput - , arbitraryWSHOutput - , arbitraryWitOutput - ] - else [] + [ arbitraryPKOutput + , arbitraryPKHashOutput + , arbitraryMSOutput + , arbitrarySHOutput + , arbitraryDCOutput + ] + ++ if getSegWit net + then + [ arbitraryWPKHashOutput + , arbitraryWSHOutput + , arbitraryWitOutput + ] + else [] --- | Arbitrary 'ScriptOutput' of type 'PayPK', 'PayPKHash' or 'PayMS' --- (Not 'PayScriptHash', 'DataCarrier', or SegWit) +{- | Arbitrary 'ScriptOutput' of type 'PayPK', 'PayPKHash' or 'PayMS' + (Not 'PayScriptHash', 'DataCarrier', or SegWit) +-} arbitrarySimpleOutput :: Gen ScriptOutput arbitrarySimpleOutput = oneof @@ -258,7 +277,7 @@ -- | Arbitrary 'ScriptOutput' of type 'PayPK' arbitraryPKOutput :: Gen ScriptOutput -arbitraryPKOutput = PayPK . snd <$> arbitraryKeyPair +arbitraryPKOutput = PayPK . snd <$> arbitraryKeyPair -- | Arbitrary 'ScriptOutput' of type 'PayPKHash' arbitraryPKHashOutput :: Gen ScriptOutput @@ -292,8 +311,8 @@ arbitraryMSOutputC = do (m, n) <- arbitraryMSParam keys <- - map snd <$> - vectorOf n (arbitraryKeyPair `suchThat` (pubKeyCompressed . snd)) + map snd + <$> vectorOf n (arbitraryKeyPair `suchThat` (pubKeyCompressed . snd)) return $ PayMulSig keys m -- | Arbitrary 'ScriptOutput' of type 'PayScriptHash'. @@ -314,8 +333,9 @@ , arbitrarySHInput net ] --- | Arbitrary 'ScriptInput' of type 'SpendPK', 'SpendPKHash' or 'SpendMulSig' --- (not 'ScriptHashInput') +{- | Arbitrary 'ScriptInput' of type 'SpendPK', 'SpendPKHash' or 'SpendMulSig' + (not 'ScriptHashInput') +-} arbitrarySimpleInput :: Network -> Gen ScriptInput arbitrarySimpleInput net = oneof @@ -352,7 +372,7 @@ -- | Arbitrary 'ScriptInput' of type 'SpendMulSig'. arbitraryMSInput :: Network -> Gen ScriptInput arbitraryMSInput net = do - m <- fst <$> arbitraryMSParam + m <- fst <$> arbitraryMSParam sigs <- vectorOf m (arbitraryTxSignatureEmpty net) return $ RegularInput $ SpendMulSig sigs @@ -362,8 +382,9 @@ i <- arbitrarySimpleInput net ScriptHashInput (getRegularInput i) <$> arbitrarySimpleOutput --- | Arbitrary 'ScriptInput' of type 'ScriptHashInput' containing a --- 'RedeemScript' of type 'PayMulSig' and an input of type 'SpendMulSig'. +{- | Arbitrary 'ScriptInput' of type 'ScriptHashInput' containing a + 'RedeemScript' of type 'PayMulSig' and an input of type 'SpendMulSig'. +-} arbitraryMulSigSHInput :: Network -> Gen ScriptInput arbitraryMulSigSHInput net = arbitraryMSOutput >>= \case @@ -372,14 +393,15 @@ return $ ScriptHashInput (SpendMulSig sigs) rdm _ -> undefined --- | Arbitrary 'ScriptInput' of type 'ScriptHashInput' containing a --- 'RedeemScript' of type 'PayMulSig' and an input of type 'SpendMulSig'. +{- | Arbitrary 'ScriptInput' of type 'ScriptHashInput' containing a + 'RedeemScript' of type 'PayMulSig' and an input of type 'SpendMulSig'. +-} arbitraryMulSigSHInputC :: Network -> Gen ScriptInput arbitraryMulSigSHInputC net = arbitraryMSOutputC >>= \case rdm@(PayMulSig _ m) -> do - sigs <- vectorOf m (arbitraryTxSignatureEmpty net) - return $ ScriptHashInput (SpendMulSig sigs) rdm + sigs <- vectorOf m (arbitraryTxSignatureEmpty net) + return $ ScriptHashInput (SpendMulSig sigs) rdm _ -> undefined -- | Like 'arbitraryMulSigSHCInput' with no empty signatures. diff --git a/src/Haskoin/Util/Arbitrary/Transaction.hs b/src/Haskoin/Util/Arbitrary/Transaction.hs --- a/src/Haskoin/Util/Arbitrary/Transaction.hs +++ b/src/Haskoin/Util/Arbitrary/Transaction.hs @@ -1,4 +1,4 @@ -{-| +{- | Module : Haskoin.Test.Transaction Copyright : No rights reserved License : MIT @@ -8,24 +8,25 @@ -} module Haskoin.Util.Arbitrary.Transaction where -import Control.Monad -import qualified Data.ByteString as BS -import Data.Either (fromRight) -import Data.List (nub, nubBy, permutations) -import Data.Word (Word64) -import Haskoin.Address -import Haskoin.Constants -import Haskoin.Keys.Common -import Haskoin.Script -import Haskoin.Util.Arbitrary.Crypto -import Haskoin.Util.Arbitrary.Keys -import Haskoin.Util.Arbitrary.Script -import Haskoin.Util.Arbitrary.Util -import Haskoin.Transaction -import Test.QuickCheck +import Control.Monad +import qualified Data.ByteString as BS +import Data.Either (fromRight) +import Data.List (nub, nubBy, permutations) +import Data.Word (Word64) +import Haskoin.Address +import Haskoin.Constants +import Haskoin.Data +import Haskoin.Keys.Common +import Haskoin.Script +import Haskoin.Transaction +import Haskoin.Util.Arbitrary.Crypto +import Haskoin.Util.Arbitrary.Keys +import Haskoin.Util.Arbitrary.Script +import Haskoin.Util.Arbitrary.Util +import Test.QuickCheck -- | Wrapped coin value for testing. -newtype TestCoin = TestCoin { getTestCoin :: Word64 } +newtype TestCoin = TestCoin {getTestCoin :: Word64} deriving (Eq, Show) instance Coin TestCoin where @@ -47,14 +48,14 @@ arbitraryTxOut :: Network -> Gen TxOut arbitraryTxOut net = TxOut <$> (getTestCoin <$> arbitrarySatoshi net) - <*> (encodeOutputBS <$> arbitraryScriptOutput net) + <*> (encodeOutputBS <$> arbitraryScriptOutput net) -- | Arbitrary 'TxIn'. arbitraryTxIn :: Network -> Gen TxIn arbitraryTxIn net = TxIn <$> arbitraryOutPoint - <*> (encodeInputBS <$> arbitraryScriptInput net) - <*> arbitrary + <*> (encodeInputBS <$> arbitraryScriptInput net) + <*> arbitrary -- | Arbitrary transaction. Can be regular or with witnesses. arbitraryTx :: Network -> Gen Tx @@ -82,9 +83,10 @@ else return [] Tx <$> arbitrary <*> pure uniqueInps <*> pure outs <*> pure w <*> arbitrary --- | Arbitrary transaction containing only inputs of type 'SpendPKHash', --- 'SpendScriptHash' (multisig) and outputs of type 'PayPKHash' and 'PaySH'. --- Only compressed public keys are used. +{- | Arbitrary transaction containing only inputs of type 'SpendPKHash', + 'SpendScriptHash' (multisig) and outputs of type 'PayPKHash' and 'PaySH'. + Only compressed public keys are used. +-} arbitraryAddrOnlyTx :: Network -> Gen Tx arbitraryAddrOnlyTx net = do ni <- choose (1, 5) @@ -102,8 +104,9 @@ outs <- vectorOf no (arbitraryAddrOnlyTxOut net) Tx <$> arbitrary <*> pure inps <*> pure outs <*> pure [] <*> arbitrary --- | Arbitrary TxIn that can only be of type 'SpendPKHash' or 'SpendScriptHash' --- (multisig). Only compressed public keys are used. +{- | Arbitrary TxIn that can only be of type 'SpendPKHash' or 'SpendScriptHash' + (multisig). Only compressed public keys are used. +-} arbitraryAddrOnlyTxIn :: Network -> Gen TxIn arbitraryAddrOnlyTxIn net = do inp <- oneof [arbitraryPKHashInput net, arbitraryMulSigSHInput net] @@ -123,8 +126,9 @@ out <- oneof [arbitraryPKHashOutput, arbitrarySHOutput] return $ TxOut v $ encodeOutputBS out --- | Arbitrary 'SigInput' with the corresponding private keys used --- to generate the 'ScriptOutput' or 'RedeemScript'. +{- | Arbitrary 'SigInput' with the corresponding private keys used + to generate the 'ScriptOutput' or 'RedeemScript'. +-} arbitrarySigInput :: Network -> Gen (SigInput, [SecKeyI]) arbitrarySigInput net = oneof @@ -148,7 +152,8 @@ arbitraryAnyInput :: Network -> Bool -> Gen (SigInput, SecKeyI) arbitraryAnyInput net pkh = do (k, p) <- arbitraryKeyPair - let out | pkh = PayPKHash $ getAddrHash160 $ pubKeyAddr p + let out + | pkh = PayPKHash $ getAddrHash160 $ pubKeyAddr p | otherwise = PayPK p (val, op, sh) <- arbitraryInputStuff net return (SigInput out val op sh Nothing, k) @@ -172,15 +177,17 @@ let ksPerm = map fst $ take m $ permutations ks !! perm return (SigInput out val op sh Nothing, ksPerm) --- | Arbitrary 'SigInput' with 'ScriptOutput' of type 'PaySH' and a --- 'RedeemScript'. +{- | Arbitrary 'SigInput' with 'ScriptOutput' of type 'PaySH' and a + 'RedeemScript'. +-} arbitrarySHSigInput :: Network -> Gen (SigInput, [SecKeyI]) arbitrarySHSigInput net = do - (SigInput rdm val op sh _, ks) <- oneof - [ wrapKey <$> arbitraryPKSigInput net - , wrapKey <$> arbitraryPKHashSigInput net - , arbitraryMSSigInput net - ] + (SigInput rdm val op sh _, ks) <- + oneof + [ wrapKey <$> arbitraryPKSigInput net + , wrapKey <$> arbitraryPKHashSigInput net + , arbitraryMSSigInput net + ] let out = PayScriptHash $ getAddrHash160 $ payToScriptAddress rdm return (SigInput out val op sh $ Just rdm, ks) @@ -193,16 +200,18 @@ arbitraryWSHSigInput :: Network -> Gen (SigInput, [SecKeyI]) arbitraryWSHSigInput net = do - (SigInput rdm val op sh _, ks) <- oneof - [ wrapKey <$> arbitraryPKSigInput net - , wrapKey <$> arbitraryPKHashSigInput net - , arbitraryMSSigInput net - ] + (SigInput rdm val op sh _, ks) <- + oneof + [ wrapKey <$> arbitraryPKSigInput net + , wrapKey <$> arbitraryPKHashSigInput net + , arbitraryMSSigInput net + ] let out = PayWitnessScriptHash . getAddrHash256 $ payToWitnessScriptAddress rdm return (SigInput out val op sh $ Just rdm, ks) --- | Arbitrary 'Tx' (empty 'TxIn'), 'SigInputs' and private keys that can be --- passed to 'signTx' or 'detSignTx' to fully sign the 'Tx'. +{- | Arbitrary 'Tx' (empty 'TxIn'), 'SigInputs' and private keys that can be + passed to 'signTx' or 'detSignTx' to fully sign the 'Tx'. +-} arbitrarySigningData :: Network -> Gen (Tx, [SigInput], [SecKeyI]) arbitrarySigningData net = do v <- arbitrary @@ -221,18 +230,18 @@ -- | Arbitrary transaction with empty inputs. arbitraryEmptyTx :: Network -> Gen Tx arbitraryEmptyTx net = do - v <- arbitrary - no <- choose (1,5) - ni <- choose (1,5) + v <- arbitrary + no <- choose (1, 5) + ni <- choose (1, 5) outs <- vectorOf no (arbitraryTxOut net) - ops <- vectorOf ni arbitraryOutPoint - t <- arbitrary - s <- arbitrary + ops <- vectorOf ni arbitraryOutPoint + t <- arbitrary + s <- arbitrary return $ Tx v (map (\op -> TxIn op BS.empty s) (nub ops)) outs [] t -- | Arbitrary partially-signed transactions. arbitraryPartialTxs :: - Network -> Gen ([Tx], [(ScriptOutput, Word64, OutPoint, Int, Int)]) + Network -> Gen ([Tx], [(ScriptOutput, Word64, OutPoint, Int, Int)]) arbitraryPartialTxs net = do tx <- arbitraryEmptyTx net res <- @@ -258,12 +267,14 @@ let so = PayMulSig pubKeys m elements [ (so, val, Nothing, prvKeys, m, n) - , ( PayScriptHash $ getAddrHash160 $ payToScriptAddress so - , val - , Just so - , prvKeys - , m - , n) + , + ( PayScriptHash $ getAddrHash160 $ payToScriptAddress so + , val + , Just so + , prvKeys + , m + , n + ) ] wrapKey :: (SigInput, SecKeyI) -> (SigInput, [SecKeyI]) diff --git a/src/Haskoin/Util/Arbitrary/Util.hs b/src/Haskoin/Util/Arbitrary/Util.hs --- a/src/Haskoin/Util/Arbitrary/Util.hs +++ b/src/Haskoin/Util/Arbitrary/Util.hs @@ -1,6 +1,7 @@ {-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE OverloadedStrings #-} -{-| +{-# LANGUAGE OverloadedStrings #-} + +{- | Module : Haskoin.Test.Util Copyright : No rights reserved License : MIT @@ -8,49 +9,49 @@ Stability : experimental Portability : POSIX -} -module Haskoin.Util.Arbitrary.Util -( arbitraryBS -, arbitraryBS1 -, arbitraryBSn -, arbitraryBSS -, arbitraryBSS1 -, arbitraryBSSn -, arbitraryMaybe -, arbitraryNetwork -, arbitraryUTCTime -, SerialBox(..) -, JsonBox(..) -, NetBox(..) -, ReadBox(..) -, testIdentity -, testSerial -, testRead -, testJson -, testNetJson -, arbitraryNetData -, genNetData -) -where +module Haskoin.Util.Arbitrary.Util ( + arbitraryBS, + arbitraryBS1, + arbitraryBSn, + arbitraryBSS, + arbitraryBSS1, + arbitraryBSSn, + arbitraryMaybe, + arbitraryNetwork, + arbitraryUTCTime, + SerialBox (..), + JsonBox (..), + NetBox (..), + ReadBox (..), + testIdentity, + testSerial, + testRead, + testJson, + testNetJson, + arbitraryNetData, + genNetData, +) where -import Control.Monad (forM_, (<=<)) -import qualified Data.Aeson as A -import qualified Data.Aeson.Encoding as A -import qualified Data.Aeson.Types as A -import Data.ByteString (ByteString, pack) +import Control.Monad (forM_, (<=<)) +import qualified Data.Aeson as A +import qualified Data.Aeson.Encoding as A +import qualified Data.Aeson.Types as A +import Data.ByteString (ByteString, pack) import qualified Data.ByteString.Short as BSS -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import qualified Data.Map.Strict as Map -import Data.Proxy -import Data.Time.Clock (UTCTime (..)) -import Data.Time.Clock.POSIX (posixSecondsToUTCTime) -import qualified Data.Typeable as T -import Data.Word (Word32) -import Haskoin.Constants -import Test.Hspec (Spec, describe, shouldBe, shouldSatisfy) -import Test.Hspec.QuickCheck (prop) -import Test.QuickCheck +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import qualified Data.Map.Strict as Map +import Data.Proxy +import Data.Time.Clock (UTCTime (..)) +import Data.Time.Clock.POSIX (posixSecondsToUTCTime) +import qualified Data.Typeable as T +import Data.Word (Word32) +import Haskoin.Constants +import Haskoin.Data +import Test.Hspec (Spec, describe, shouldBe, shouldSatisfy) +import Test.Hspec.QuickCheck (prop) +import Test.QuickCheck -- | Arbitrary strict 'ByteString'. arbitraryBS :: Gen ByteString @@ -84,9 +85,11 @@ -- | Generate a Maybe from a Gen a arbitraryMaybe :: Gen a -> Gen (Maybe a) -arbitraryMaybe g = frequency [ (1, return Nothing) - , (5, Just <$> g) - ] +arbitraryMaybe g = + frequency + [ (1, return Nothing) + , (5, Just <$> g) + ] -- | Generate an Network arbitraryNetwork :: Gen Network @@ -94,25 +97,30 @@ -- Helpers for creating Serial and JSON Identity tests -data SerialBox = - forall a. (Show a, Eq a, T.Typeable a, Serial a) => - SerialBox (Gen a) +data SerialBox + = forall a. + (Show a, Eq a, T.Typeable a, Serial a) => + SerialBox (Gen a) -data ReadBox = - forall a. (Read a, Show a, Eq a, T.Typeable a) => - ReadBox (Gen a) +data ReadBox + = forall a. + (Read a, Show a, Eq a, T.Typeable a) => + ReadBox (Gen a) -data JsonBox = - forall a. (Show a, Eq a, T.Typeable a, A.ToJSON a, A.FromJSON a) => - JsonBox (Gen a) +data JsonBox + = forall a. + (Show a, Eq a, T.Typeable a, A.ToJSON a, A.FromJSON a) => + JsonBox (Gen a) -data NetBox = - forall a. (Show a, Eq a, T.Typeable a) => - NetBox - ( Network -> a -> A.Value - , Network -> a -> A.Encoding - , Network -> A.Value -> A.Parser a - , Gen (Network, a)) +data NetBox + = forall a. + (Show a, Eq a, T.Typeable a) => + NetBox + ( Network -> a -> A.Value + , Network -> a -> A.Encoding + , Network -> A.Value -> A.Parser a + , Gen (Network, a) + ) testIdentity :: [SerialBox] -> [ReadBox] -> [JsonBox] -> [NetBox] -> Spec testIdentity serialVals readVals jsonVals netVals = do @@ -123,15 +131,15 @@ describe "Data.Aeson Encoding" $ forM_ jsonVals $ \(JsonBox g) -> testJson g describe "Data.Aeson Encoding with Network" $ - forM_ netVals $ \(NetBox (j,e,p,g)) -> testNetJson j e p g + forM_ netVals $ \(NetBox (j, e, p, g)) -> testNetJson j e p g -- | Generate binary identity tests testSerial :: - (Eq a, Show a, T.Typeable a, Serial a) => Gen a -> Spec + (Eq a, Show a, T.Typeable a, Serial a) => Gen a -> Spec testSerial gen = prop ("Binary encoding/decoding identity for " <> name) $ - forAll gen $ \x -> - (runGetS deserialize . runPutS . serialize) x `shouldBe` Right x + forAll gen $ \x -> + (runGetS deserialize . runPutS . serialize) x `shouldBe` Right x where name = show $ T.typeRep $ proxy gen proxy :: Gen a -> Proxy a @@ -139,7 +147,7 @@ -- | Generate Read/Show identity tests testRead :: - (Eq a, Read a, Show a, T.Typeable a) => Gen a -> Spec + (Eq a, Read a, Show a, T.Typeable a) => Gen a -> Spec testRead gen = prop ("read/show identity for " <> name) $ forAll gen $ \x -> (read . show) x `shouldBe` x @@ -150,7 +158,7 @@ -- | Generate Data.Aeson identity tests testJson :: - (Eq a, Show a, T.Typeable a, A.ToJSON a, A.FromJSON a) => Gen a -> Spec + (Eq a, Show a, T.Typeable a, A.ToJSON a, A.FromJSON a) => Gen a -> Spec testJson gen = do prop ("Data.Aeson toJSON/fromJSON identity for " <> name) $ forAll gen (`shouldSatisfy` jsonID) @@ -162,17 +170,17 @@ proxy = const Proxy jsonID x = (A.fromJSON . A.toJSON) (toMap x) == A.Success (toMap x) encodingID x = - (A.decode . A.encodingToLazyByteString . A.toEncoding) (toMap x) == - Just (toMap x) + (A.decode . A.encodingToLazyByteString . A.toEncoding) (toMap x) + == Just (toMap x) -- | Generate Data.Aeson identity tests for type that need the @Network@ testNetJson :: - (Eq a, Show a, T.Typeable a) - => (Network -> a -> A.Value) - -> (Network -> a -> A.Encoding) - -> (Network -> A.Value -> A.Parser a) - -> Gen (Network, a) - -> Spec + (Eq a, Show a, T.Typeable a) => + (Network -> a -> A.Value) -> + (Network -> a -> A.Encoding) -> + (Network -> A.Value -> A.Parser a) -> + Gen (Network, a) -> + Spec testNetJson j e p g = do prop ("Data.Aeson toJSON/fromJSON identity (with network) for " <> name) $ forAll g $ \(net, x) -> dec net (encVal net x) `shouldBe` Just x @@ -202,8 +210,7 @@ toMap = Map.singleton "object" toMapE :: A.Encoding -> A.Encoding -toMapE = A.pairs . (A.pair "object") +toMapE = A.pairs . A.pair "object" fromMap :: Map.Map String a -> a fromMap = (Map.! "object") - diff --git a/test/Haskoin/Address/Bech32Spec.hs b/test/Haskoin/Address/Bech32Spec.hs --- a/test/Haskoin/Address/Bech32Spec.hs +++ b/test/Haskoin/Address/Bech32Spec.hs @@ -1,24 +1,25 @@ {-# LANGUAGE OverloadedStrings #-} -module Haskoin.Address.Bech32Spec - ( spec - ) where -import Control.Monad -import Data.Bits (xor) -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import Data.Char (chr, ord, toLower) -import Data.Maybe -import Data.String.Conversions -import Data.Text (Text, append, pack, snoc, uncons) -import qualified Data.Text as T -import Data.Word (Word8) -import Haskoin.Address -import Haskoin.Address.Bech32 -import Haskoin.Util -import Test.HUnit -import Test.Hspec +module Haskoin.Address.Bech32Spec ( + spec, +) where +import Control.Monad +import Data.Bits (xor) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Char (chr, ord, toLower) +import Data.Maybe +import Data.String.Conversions +import Data.Text (Text, append, pack, snoc, uncons) +import qualified Data.Text as T +import Data.Word (Word8) +import Haskoin.Address +import Haskoin.Address.Bech32 +import Haskoin.Util +import Test.HUnit +import Test.Hspec + spec = do describe "bech32 checksum" $ do it "should be valid" $ @@ -27,7 +28,7 @@ forM_ invalidChecksums testInvalidChecksum it "should be case-insensitive" $ all (== Just "test12hrzfj") $ - map (flip (bech32Encode Bech32) []) hrpCaseVariants + map (flip (bech32Encode Bech32) []) hrpCaseVariants describe "bech32 address" $ do it "should be valid" $ forM_ validChecksums (uncurry testValidChecksum) @@ -35,11 +36,11 @@ forM_ invalidChecksums testInvalidChecksum it "should be case-insensitive" $ all (== Just "test12hrzfj") $ - map (flip (bech32Encode Bech32) []) hrpCaseVariants + map (flip (bech32Encode Bech32) []) hrpCaseVariants describe "bech32 encoding/decoding" $ do it "should not encode long data string" $ assert . isNothing $ - bech32Encode Bech32 "bc" (replicate 82 (word5 (1 :: Word8))) + bech32Encode Bech32 "bc" (replicate 82 (word5 (1 :: Word8))) it "should not encode bad version number" $ assert $ isNothing $ segwitEncode "bc" 17 [] it "should not encode invalid length for version 0" $ @@ -55,24 +56,24 @@ it "human-readable part should be case-insensitive" $ bech32Encode Bech32 "HRP" [] `shouldBe` bech32Encode Bech32 "hrp" [] - testValidChecksum :: Bech32Encoding -> Bech32 -> Assertion testValidChecksum enc checksum = case bech32Decode checksum of - Nothing -> assertFailure (show checksum) + Nothing -> assertFailure (show checksum) Just (enc', resultHRP, resultData) -> do assertEqual (show checksum ++ " encoding incorrect") enc enc' -- test that a corrupted checksum fails decoding. - let (hrp, rest) = T.breakOnEnd "1" checksum + let (hrp, rest) = T.breakOnEnd "1" checksum Just (first, rest') = uncons rest - checksumCorrupted = (hrp `snoc` chr (ord first `xor` 1)) `append` rest' - assertBool (show checksum ++ " corrupted") - $ isNothing (bech32Decode checksumCorrupted) + checksumCorrupted = (hrp `snoc` chr (ord first `xor` 1)) `append` rest' + assertBool (show checksum ++ " corrupted") $ + isNothing (bech32Decode checksumCorrupted) -- test that re-encoding the decoded checksum results in the same checksum. - let checksumEncoded = bech32Encode enc' resultHRP resultData + let checksumEncoded = bech32Encode enc' resultHRP resultData expectedChecksum = Just $ T.toLower checksum - assertEqual (show checksum ++ " re-encode") - expectedChecksum - checksumEncoded + assertEqual + (show checksum ++ " re-encode") + expectedChecksum + checksumEncoded testInvalidChecksum :: Bech32 -> Assertion testInvalidChecksum checksum = @@ -81,17 +82,19 @@ testValidAddress :: (Text, Text) -> Assertion testValidAddress (address, hexscript) = do let address' = T.toLower address - hrp = T.take 2 address' + hrp = T.take 2 address' case segwitDecode hrp address of - Nothing -> + Nothing -> assertFailure (T.unpack address <> ": decode failed") Just (witver, witprog) -> do - assertEqual (show address) - (decodeHex hexscript) - (Just $ segwitScriptPubkey witver witprog) - assertEqual (show address) - (Just address') - (segwitEncode hrp witver witprog) + assertEqual + (show address) + (decodeHex hexscript) + (Just $ segwitScriptPubkey witver witprog) + assertEqual + (show address) + (Just address') + (segwitEncode hrp witver witprog) testInvalidAddress :: Text -> Assertion testInvalidAddress address = do @@ -101,46 +104,59 @@ segwitScriptPubkey :: Word8 -> [Word8] -> ByteString segwitScriptPubkey witver witprog = B.pack $ witver' : fromIntegral (length witprog) : witprog - where witver' = if witver == 0 then 0 else witver + 0x50 + where + witver' = if witver == 0 then 0 else witver + 0x50 validChecksums :: [(Bech32Encoding, Text)] validChecksums = - [ ( Bech32 - , "A12UEL5L" - ) - , ( Bech32 - , "an83characterlonghumanreadablepartthatcontainsthenumber1andtheexcludedcharactersbio1tt5tgs" - ) - , ( Bech32 - , "abcdef1qpzry9x8gf2tvdw0s3jn54khce6mua7lmqqqxw" - ) - , ( Bech32 - , "11qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqc8247j" - ) - , ( Bech32 - , "split1checkupstagehandshakeupstreamerranterredcaperred2y9e3w" - ) - , ( Bech32m - , "A1LQFN3A" - ) - , ( Bech32m - , "a1lqfn3a" - ) - , ( Bech32m - , "an83characterlonghumanreadablepartthatcontainsthetheexcludedcharactersbioandnumber11sg7hg6" - ) - , ( Bech32m - , "abcdef1l7aum6echk45nj3s0wdvt2fg8x9yrzpqzd3ryx" - ) - , ( Bech32m - , "11llllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllludsr8" - ) - , ( Bech32m - , "split1checkupstagehandshakeupstreamerranterredcaperredlc445v" - ) - , ( Bech32m - , "?1v759aa" - ) + [ + ( Bech32 + , "A12UEL5L" + ) + , + ( Bech32 + , "an83characterlonghumanreadablepartthatcontainsthenumber1andtheexcludedcharactersbio1tt5tgs" + ) + , + ( Bech32 + , "abcdef1qpzry9x8gf2tvdw0s3jn54khce6mua7lmqqqxw" + ) + , + ( Bech32 + , "11qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqc8247j" + ) + , + ( Bech32 + , "split1checkupstagehandshakeupstreamerranterredcaperred2y9e3w" + ) + , + ( Bech32m + , "A1LQFN3A" + ) + , + ( Bech32m + , "a1lqfn3a" + ) + , + ( Bech32m + , "an83characterlonghumanreadablepartthatcontainsthetheexcludedcharactersbioandnumber11sg7hg6" + ) + , + ( Bech32m + , "abcdef1l7aum6echk45nj3s0wdvt2fg8x9yrzpqzd3ryx" + ) + , + ( Bech32m + , "11llllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllludsr8" + ) + , + ( Bech32m + , "split1checkupstagehandshakeupstreamerranterredcaperredlc445v" + ) + , + ( Bech32m + , "?1v759aa" + ) ] invalidChecksums :: [Text] @@ -157,39 +173,50 @@ validAddresses :: [(Text, Text)] validAddresses = - [ ( "BC1QW508D6QEJXTDG4Y5R3ZARVARY0C5XW7KV8F3T4" - , "0014751e76e8199196d454941c45d1b3a323f1433bd6" - ) - , ( "tb1qrp33g0q5c5txsp9arysrx4k6zdkfs4nce4xj0gdcccefvpysxf3q0sl5k7" - , "00201863143c14c5166804bd19203356da136c985678cd4d27a1b8c6329604903262" - ) - , ( "tb1qqqqqp399et2xygdj5xreqhjjvcmzhxw4aywxecjdzew6hylgvsesrxh6hy" - , "0020000000c4a5cad46221b2a187905e5266362b99d5e91c6ce24d165dab93e86433" - ) - , ( "BC1QW508D6QEJXTDG4Y5R3ZARVARY0C5XW7KV8F3T4" - , "0014751e76e8199196d454941c45d1b3a323f1433bd6" - ) - , ( "tb1qrp33g0q5c5txsp9arysrx4k6zdkfs4nce4xj0gdcccefvpysxf3q0sl5k7" - , "00201863143c14c5166804bd19203356da136c985678cd4d27a1b8c6329604903262" - ) - , ( "bc1pw508d6qejxtdg4y5r3zarvary0c5xw7kw508d6qejxtdg4y5r3zarvary0c5xw7kt5nd6y" - , "5128751e76e8199196d454941c45d1b3a323f1433bd6751e76e8199196d454941c45d1b3a323f1433bd6" - ) - , ( "BC1SW50QGDZ25J" - , "6002751e" - ) - , ( "bc1zw508d6qejxtdg4y5r3zarvaryvaxxpcs" - , "5210751e76e8199196d454941c45d1b3a323" - ) - , ( "tb1qqqqqp399et2xygdj5xreqhjjvcmzhxw4aywxecjdzew6hylgvsesrxh6hy" - , "0020000000c4a5cad46221b2a187905e5266362b99d5e91c6ce24d165dab93e86433" - ) - , ( "tb1pqqqqp399et2xygdj5xreqhjjvcmzhxw4aywxecjdzew6hylgvsesf3hn0c" - , "5120000000c4a5cad46221b2a187905e5266362b99d5e91c6ce24d165dab93e86433" - ) - , ( "bc1p0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7vqzk5jj0" - , "512079be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798" - ) + [ + ( "BC1QW508D6QEJXTDG4Y5R3ZARVARY0C5XW7KV8F3T4" + , "0014751e76e8199196d454941c45d1b3a323f1433bd6" + ) + , + ( "tb1qrp33g0q5c5txsp9arysrx4k6zdkfs4nce4xj0gdcccefvpysxf3q0sl5k7" + , "00201863143c14c5166804bd19203356da136c985678cd4d27a1b8c6329604903262" + ) + , + ( "tb1qqqqqp399et2xygdj5xreqhjjvcmzhxw4aywxecjdzew6hylgvsesrxh6hy" + , "0020000000c4a5cad46221b2a187905e5266362b99d5e91c6ce24d165dab93e86433" + ) + , + ( "BC1QW508D6QEJXTDG4Y5R3ZARVARY0C5XW7KV8F3T4" + , "0014751e76e8199196d454941c45d1b3a323f1433bd6" + ) + , + ( "tb1qrp33g0q5c5txsp9arysrx4k6zdkfs4nce4xj0gdcccefvpysxf3q0sl5k7" + , "00201863143c14c5166804bd19203356da136c985678cd4d27a1b8c6329604903262" + ) + , + ( "bc1pw508d6qejxtdg4y5r3zarvary0c5xw7kw508d6qejxtdg4y5r3zarvary0c5xw7kt5nd6y" + , "5128751e76e8199196d454941c45d1b3a323f1433bd6751e76e8199196d454941c45d1b3a323f1433bd6" + ) + , + ( "BC1SW50QGDZ25J" + , "6002751e" + ) + , + ( "bc1zw508d6qejxtdg4y5r3zarvaryvaxxpcs" + , "5210751e76e8199196d454941c45d1b3a323" + ) + , + ( "tb1qqqqqp399et2xygdj5xreqhjjvcmzhxw4aywxecjdzew6hylgvsesrxh6hy" + , "0020000000c4a5cad46221b2a187905e5266362b99d5e91c6ce24d165dab93e86433" + ) + , + ( "tb1pqqqqp399et2xygdj5xreqhjjvcmzhxw4aywxecjdzew6hylgvsesf3hn0c" + , "5120000000c4a5cad46221b2a187905e5266362b99d5e91c6ce24d165dab93e86433" + ) + , + ( "bc1p0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7vqzk5jj0" + , "512079be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798" + ) ] invalidAddresses :: [Text] @@ -219,7 +246,7 @@ , "tb1p0xlxvlhemja6c4dqv22uapctqupfhlxm9h8z3k2e72q4k9hcz7vpggkg4j" ] -hrpCaseVariants:: [Text] +hrpCaseVariants :: [Text] hrpCaseVariants = map T.pack hrpTestPermutations hrpTestPermutations :: [String] diff --git a/test/Haskoin/Address/CashAddrSpec.hs b/test/Haskoin/Address/CashAddrSpec.hs --- a/test/Haskoin/Address/CashAddrSpec.hs +++ b/test/Haskoin/Address/CashAddrSpec.hs @@ -1,16 +1,17 @@ {-# LANGUAGE OverloadedStrings #-} + module Haskoin.Address.CashAddrSpec (spec) where -import Control.Monad -import qualified Data.ByteString.Char8 as C -import Data.Maybe -import Data.String.Conversions -import Data.Text (Text) -import Haskoin.Address -import Haskoin.Constants -import Haskoin.Util -import Test.Hspec -import Test.HUnit +import Control.Monad +import qualified Data.ByteString.Char8 as C +import Data.Maybe +import Data.String.Conversions +import Data.Text (Text) +import Haskoin.Address +import Haskoin.Constants +import Haskoin.Util +import Test.HUnit +import Test.Hspec spec :: Spec spec = do @@ -25,10 +26,11 @@ let mpb = cash32decode "bitcoincash:qpzry9x8gf2tvdw0s3jn54khce6mua7lcw20ayyn" - mpb `shouldBe` - Just + mpb + `shouldBe` Just ( "bitcoincash" - , "\NULD2\DC4\199BT\182\&5\207\132e:V\215\198u\190w\223") + , "\NULD2\DC4\199BT\182\&5\207\132e:V\215\198u\190w\223" + ) it "bchtest:testnetaddress4d6njnut" $ do let mpb = cash32decode "bchtest:testnetaddress4d6njnut" mpb `shouldBe` Just ("bchtest", "^`\185\229}kG\152") @@ -36,89 +38,90 @@ let mpb = cash32decode "bchreg:555555555555555555555555555555555555555555555udxmlmrz" - mpb `shouldBe` - Just + mpb + `shouldBe` Just ( "bchreg" - , "\165)JR\148\165)JR\148\165)JR\148\165)JR\148\165)JR\148\165)J") + , "\165)JR\148\165)JR\148\165)JR\148\165)JR\148\165)JR\148\165)J" + ) describe "cashaddr to base58 translation test vectors" $ do it "1BpEi6DfDAUFd7GtittLSdBeYJvcoaVggu" $ do let addr = - addrToText bch =<< - textToAddr btc "1BpEi6DfDAUFd7GtittLSdBeYJvcoaVggu" - addr `shouldBe` - Just "bitcoincash:qpm2qsznhks23z7629mms6s4cwef74vcwvy22gdx6a" + addrToText bch + =<< textToAddr btc "1BpEi6DfDAUFd7GtittLSdBeYJvcoaVggu" + addr + `shouldBe` Just "bitcoincash:qpm2qsznhks23z7629mms6s4cwef74vcwvy22gdx6a" it "1KXrWXciRDZUpQwQmuM1DbwsKDLYAYsVLR" $ do let addr = - addrToText bch =<< - textToAddr btc "1KXrWXciRDZUpQwQmuM1DbwsKDLYAYsVLR" - addr `shouldBe` - Just "bitcoincash:qr95sy3j9xwd2ap32xkykttr4cvcu7as4y0qverfuy" + addrToText bch + =<< textToAddr btc "1KXrWXciRDZUpQwQmuM1DbwsKDLYAYsVLR" + addr + `shouldBe` Just "bitcoincash:qr95sy3j9xwd2ap32xkykttr4cvcu7as4y0qverfuy" it "16w1D5WRVKJuZUsSRzdLp9w3YGcgoxDXb" $ do let addr = - addrToText bch =<< - textToAddr btc "16w1D5WRVKJuZUsSRzdLp9w3YGcgoxDXb" - addr `shouldBe` - Just "bitcoincash:qqq3728yw0y47sqn6l2na30mcw6zm78dzqre909m2r" + addrToText bch + =<< textToAddr btc "16w1D5WRVKJuZUsSRzdLp9w3YGcgoxDXb" + addr + `shouldBe` Just "bitcoincash:qqq3728yw0y47sqn6l2na30mcw6zm78dzqre909m2r" it "3CWFddi6m4ndiGyKqzYvsFYagqDLPVMTzC" $ do let addr = - addrToText bch =<< - textToAddr btc "3CWFddi6m4ndiGyKqzYvsFYagqDLPVMTzC" - addr `shouldBe` - Just "bitcoincash:ppm2qsznhks23z7629mms6s4cwef74vcwvn0h829pq" + addrToText bch + =<< textToAddr btc "3CWFddi6m4ndiGyKqzYvsFYagqDLPVMTzC" + addr + `shouldBe` Just "bitcoincash:ppm2qsznhks23z7629mms6s4cwef74vcwvn0h829pq" it "3LDsS579y7sruadqu11beEJoTjdFiFCdX4" $ do let addr = - addrToText bch =<< - textToAddr btc "3LDsS579y7sruadqu11beEJoTjdFiFCdX4" - addr `shouldBe` - Just "bitcoincash:pr95sy3j9xwd2ap32xkykttr4cvcu7as4yc93ky28e" + addrToText bch + =<< textToAddr btc "3LDsS579y7sruadqu11beEJoTjdFiFCdX4" + addr + `shouldBe` Just "bitcoincash:pr95sy3j9xwd2ap32xkykttr4cvcu7as4yc93ky28e" it "31nwvkZwyPdgzjBJZXfDmSWsC4ZLKpYyUw" $ do let addr = - addrToText bch =<< - textToAddr btc "31nwvkZwyPdgzjBJZXfDmSWsC4ZLKpYyUw" - addr `shouldBe` - Just "bitcoincash:pqq3728yw0y47sqn6l2na30mcw6zm78dzq5ucqzc37" + addrToText bch + =<< textToAddr btc "31nwvkZwyPdgzjBJZXfDmSWsC4ZLKpYyUw" + addr + `shouldBe` Just "bitcoincash:pqq3728yw0y47sqn6l2na30mcw6zm78dzq5ucqzc37" describe "base58 to cashaddr translation test vectors" $ do it "bitcoincash:qpm2qsznhks23z7629mms6s4cwef74vcwvy22gdx6a" $ do let addr = - addrToText btc =<< - textToAddr - bch - "bitcoincash:qpm2qsznhks23z7629mms6s4cwef74vcwvy22gdx6a" + addrToText btc + =<< textToAddr + bch + "bitcoincash:qpm2qsznhks23z7629mms6s4cwef74vcwvy22gdx6a" addr `shouldBe` Just "1BpEi6DfDAUFd7GtittLSdBeYJvcoaVggu" it "bitcoincash:qr95sy3j9xwd2ap32xkykttr4cvcu7as4y0qverfuy" $ do let addr = - addrToText btc =<< - textToAddr - bch - "bitcoincash:qr95sy3j9xwd2ap32xkykttr4cvcu7as4y0qverfuy" + addrToText btc + =<< textToAddr + bch + "bitcoincash:qr95sy3j9xwd2ap32xkykttr4cvcu7as4y0qverfuy" addr `shouldBe` Just "1KXrWXciRDZUpQwQmuM1DbwsKDLYAYsVLR" it "bitcoincash:qqq3728yw0y47sqn6l2na30mcw6zm78dzqre909m2r" $ do let addr = - addrToText btc =<< - textToAddr - bch - "bitcoincash:qqq3728yw0y47sqn6l2na30mcw6zm78dzqre909m2r" + addrToText btc + =<< textToAddr + bch + "bitcoincash:qqq3728yw0y47sqn6l2na30mcw6zm78dzqre909m2r" addr `shouldBe` Just "16w1D5WRVKJuZUsSRzdLp9w3YGcgoxDXb" it "bitcoincash:ppm2qsznhks23z7629mms6s4cwef74vcwvn0h829pq" $ do let addr = - addrToText btc =<< - textToAddr - bch - "bitcoincash:ppm2qsznhks23z7629mms6s4cwef74vcwvn0h829pq" + addrToText btc + =<< textToAddr + bch + "bitcoincash:ppm2qsznhks23z7629mms6s4cwef74vcwvn0h829pq" addr `shouldBe` Just "3CWFddi6m4ndiGyKqzYvsFYagqDLPVMTzC" it "bitcoincash:pr95sy3j9xwd2ap32xkykttr4cvcu7as4yc93ky28e" $ do let addr = - addrToText btc =<< - textToAddr - bch - "bitcoincash:pr95sy3j9xwd2ap32xkykttr4cvcu7as4yc93ky28e" + addrToText btc + =<< textToAddr + bch + "bitcoincash:pr95sy3j9xwd2ap32xkykttr4cvcu7as4yc93ky28e" addr `shouldBe` Just "3LDsS579y7sruadqu11beEJoTjdFiFCdX4" it "bitcoincash:pqq3728yw0y47sqn6l2na30mcw6zm78dzq5ucqzc37" $ do let addr = - addrToText btc =<< - textToAddr - bch - "bitcoincash:pqq3728yw0y47sqn6l2na30mcw6zm78dzq5ucqzc37" + addrToText btc + =<< textToAddr + bch + "bitcoincash:pqq3728yw0y47sqn6l2na30mcw6zm78dzq5ucqzc37" addr `shouldBe` Just "31nwvkZwyPdgzjBJZXfDmSWsC4ZLKpYyUw" describe "cashaddr larger test vectors" $ forM_ (zip [0 ..] vectors) $ \(i, vec) -> @@ -144,136 +147,201 @@ Just bs = decodeHex hex Just (_, ver, pay) = cash32decodeType addr --- | All vectors starting with @pref@ had the wrong version in the spec --- document. +{- | All vectors starting with @pref@ had the wrong version in the spec + document. +-} vectors :: [(Int, CashVersion, Text, Text)] vectors = - [ ( 20 - , 0 - , "bitcoincash:qr6m7j9njldwwzlg9v7v53unlr4jkmx6eylep8ekg2" - , "F5BF48B397DAE70BE82B3CCA4793F8EB2B6CDAC9") - , ( 20 - , 1 - , "bchtest:pr6m7j9njldwwzlg9v7v53unlr4jkmx6eyvwc0uz5t" - , "F5BF48B397DAE70BE82B3CCA4793F8EB2B6CDAC9") - , ( 20 - , 1 - , "pref:pr6m7j9njldwwzlg9v7v53unlr4jkmx6ey65nvtks5" - , "F5BF48B397DAE70BE82B3CCA4793F8EB2B6CDAC9") - , ( 20 - , 15 - , "prefix:0r6m7j9njldwwzlg9v7v53unlr4jkmx6ey3qnjwsrf" - , "F5BF48B397DAE70BE82B3CCA4793F8EB2B6CDAC9") - , ( 24 - , 0 - , "bitcoincash:q9adhakpwzztepkpwp5z0dq62m6u5v5xtyj7j3h2ws4mr9g0" - , "7ADBF6C17084BC86C1706827B41A56F5CA32865925E946EA") - , ( 24 - , 1 - , "bchtest:p9adhakpwzztepkpwp5z0dq62m6u5v5xtyj7j3h2u94tsynr" - , "7ADBF6C17084BC86C1706827B41A56F5CA32865925E946EA") - , ( 24 - , 1 - , "pref:p9adhakpwzztepkpwp5z0dq62m6u5v5xtyj7j3h2khlwwk5v" - , "7ADBF6C17084BC86C1706827B41A56F5CA32865925E946EA") - , ( 24 - , 15 - , "prefix:09adhakpwzztepkpwp5z0dq62m6u5v5xtyj7j3h2p29kc2lp" - , "7ADBF6C17084BC86C1706827B41A56F5CA32865925E946EA") - , ( 28 - , 0 - , "bitcoincash:qgagf7w02x4wnz3mkwnchut2vxphjzccwxgjvvjmlsxqwkcw59jxxuz" - , "3A84F9CF51AAE98A3BB3A78BF16A6183790B18719126325BFC0C075B") - , ( 28 - , 1 - , "bchtest:pgagf7w02x4wnz3mkwnchut2vxphjzccwxgjvvjmlsxqwkcvs7md7wt" - , "3A84F9CF51AAE98A3BB3A78BF16A6183790B18719126325BFC0C075B") - , ( 28 - , 1 - , "pref:pgagf7w02x4wnz3mkwnchut2vxphjzccwxgjvvjmlsxqwkcrsr6gzkn" - , "3A84F9CF51AAE98A3BB3A78BF16A6183790B18719126325BFC0C075B") - , ( 28 - , 15 - , "prefix:0gagf7w02x4wnz3mkwnchut2vxphjzccwxgjvvjmlsxqwkc5djw8s9g" - , "3A84F9CF51AAE98A3BB3A78BF16A6183790B18719126325BFC0C075B") - , ( 32 - , 0 - , "bitcoincash:qvch8mmxy0rtfrlarg7ucrxxfzds5pamg73h7370aa87d80gyhqxq5nlegake" - , "3173EF6623C6B48FFD1A3DCC0CC6489B0A07BB47A37F47CFEF4FE69DE825C060") - , ( 32 - , 1 - , "bchtest:pvch8mmxy0rtfrlarg7ucrxxfzds5pamg73h7370aa87d80gyhqxq7fqng6m6" - , "3173EF6623C6B48FFD1A3DCC0CC6489B0A07BB47A37F47CFEF4FE69DE825C060") - , ( 32 - , 1 - , "pref:pvch8mmxy0rtfrlarg7ucrxxfzds5pamg73h7370aa87d80gyhqxq4k9m7qf9" - , "3173EF6623C6B48FFD1A3DCC0CC6489B0A07BB47A37F47CFEF4FE69DE825C060") - , ( 32 - , 15 - , "prefix:0vch8mmxy0rtfrlarg7ucrxxfzds5pamg73h7370aa87d80gyhqxqsh6jgp6w" - , "3173EF6623C6B48FFD1A3DCC0CC6489B0A07BB47A37F47CFEF4FE69DE825C060") - , ( 40 - , 0 - , "bitcoincash:qnq8zwpj8cq05n7pytfmskuk9r4gzzel8qtsvwz79zdskftrzxtar994cgutavfklv39gr3uvz" - , "C07138323E00FA4FC122D3B85B9628EA810B3F381706385E289B0B25631197D194B5C238BEB136FB") - , ( 40 - , 1 - , "bchtest:pnq8zwpj8cq05n7pytfmskuk9r4gzzel8qtsvwz79zdskftrzxtar994cgutavfklvmgm6ynej" - , "C07138323E00FA4FC122D3B85B9628EA810B3F381706385E289B0B25631197D194B5C238BEB136FB") - , ( 40 - , 1 - , "pref:pnq8zwpj8cq05n7pytfmskuk9r4gzzel8qtsvwz79zdskftrzxtar994cgutavfklv0vx5z0w3" - , "C07138323E00FA4FC122D3B85B9628EA810B3F381706385E289B0B25631197D194B5C238BEB136FB") - , ( 40 - , 15 - , "prefix:0nq8zwpj8cq05n7pytfmskuk9r4gzzel8qtsvwz79zdskftrzxtar994cgutavfklvwsvctzqy" - , "C07138323E00FA4FC122D3B85B9628EA810B3F381706385E289B0B25631197D194B5C238BEB136FB") - , ( 48 - , 0 - , "bitcoincash:qh3krj5607v3qlqh5c3wq3lrw3wnuxw0sp8dv0zugrrt5a3kj6ucysfz8kxwv2k53krr7n933jfsunqex2w82sl" - , "E361CA9A7F99107C17A622E047E3745D3E19CF804ED63C5C40C6BA763696B98241223D8CE62AD48D863F4CB18C930E4C") - , ( 48 - , 1 - , "bchtest:ph3krj5607v3qlqh5c3wq3lrw3wnuxw0sp8dv0zugrrt5a3kj6ucysfz8kxwv2k53krr7n933jfsunqnzf7mt6x" - , "E361CA9A7F99107C17A622E047E3745D3E19CF804ED63C5C40C6BA763696B98241223D8CE62AD48D863F4CB18C930E4C") - , ( 48 - , 1 - , "pref:ph3krj5607v3qlqh5c3wq3lrw3wnuxw0sp8dv0zugrrt5a3kj6ucysfz8kxwv2k53krr7n933jfsunqjntdfcwg" - , "E361CA9A7F99107C17A622E047E3745D3E19CF804ED63C5C40C6BA763696B98241223D8CE62AD48D863F4CB18C930E4C") - , ( 48 - , 15 - , "prefix:0h3krj5607v3qlqh5c3wq3lrw3wnuxw0sp8dv0zugrrt5a3kj6ucysfz8kxwv2k53krr7n933jfsunqakcssnmn" - , "E361CA9A7F99107C17A622E047E3745D3E19CF804ED63C5C40C6BA763696B98241223D8CE62AD48D863F4CB18C930E4C") - , ( 56 - , 0 - , "bitcoincash:qmvl5lzvdm6km38lgga64ek5jhdl7e3aqd9895wu04fvhlnare5937w4ywkq57juxsrhvw8ym5d8qx7sz7zz0zvcypqscw8jd03f" - , "D9FA7C4C6EF56DC4FF423BAAE6D495DBFF663D034A72D1DC7D52CBFE7D1E6858F9D523AC0A7A5C34077638E4DD1A701BD017842789982041") - , ( 56 - , 1 - , "bchtest:pmvl5lzvdm6km38lgga64ek5jhdl7e3aqd9895wu04fvhlnare5937w4ywkq57juxsrhvw8ym5d8qx7sz7zz0zvcypqs6kgdsg2g" - , "D9FA7C4C6EF56DC4FF423BAAE6D495DBFF663D034A72D1DC7D52CBFE7D1E6858F9D523AC0A7A5C34077638E4DD1A701BD017842789982041") - , ( 56 - , 1 - , "pref:pmvl5lzvdm6km38lgga64ek5jhdl7e3aqd9895wu04fvhlnare5937w4ywkq57juxsrhvw8ym5d8qx7sz7zz0zvcypqsammyqffl" - , "D9FA7C4C6EF56DC4FF423BAAE6D495DBFF663D034A72D1DC7D52CBFE7D1E6858F9D523AC0A7A5C34077638E4DD1A701BD017842789982041") - , ( 56 - , 15 - , "prefix:0mvl5lzvdm6km38lgga64ek5jhdl7e3aqd9895wu04fvhlnare5937w4ywkq57juxsrhvw8ym5d8qx7sz7zz0zvcypqsgjrqpnw8" - , "D9FA7C4C6EF56DC4FF423BAAE6D495DBFF663D034A72D1DC7D52CBFE7D1E6858F9D523AC0A7A5C34077638E4DD1A701BD017842789982041") - , ( 64 - , 0 - , "bitcoincash:qlg0x333p4238k0qrc5ej7rzfw5g8e4a4r6vvzyrcy8j3s5k0en7calvclhw46hudk5flttj6ydvjc0pv3nchp52amk97tqa5zygg96mtky5sv5w" - , "D0F346310D5513D9E01E299978624BA883E6BDA8F4C60883C10F28C2967E67EC77ECC7EEEAEAFC6DA89FAD72D11AC961E164678B868AEEEC5F2C1DA08884175B") - , ( 64 - , 1 - , "bchtest:plg0x333p4238k0qrc5ej7rzfw5g8e4a4r6vvzyrcy8j3s5k0en7calvclhw46hudk5flttj6ydvjc0pv3nchp52amk97tqa5zygg96mc773cwez" - , "D0F346310D5513D9E01E299978624BA883E6BDA8F4C60883C10F28C2967E67EC77ECC7EEEAEAFC6DA89FAD72D11AC961E164678B868AEEEC5F2C1DA08884175B") - , ( 64 - , 1 - , "pref:plg0x333p4238k0qrc5ej7rzfw5g8e4a4r6vvzyrcy8j3s5k0en7calvclhw46hudk5flttj6ydvjc0pv3nchp52amk97tqa5zygg96mg7pj3lh8" - , "D0F346310D5513D9E01E299978624BA883E6BDA8F4C60883C10F28C2967E67EC77ECC7EEEAEAFC6DA89FAD72D11AC961E164678B868AEEEC5F2C1DA08884175B") - , ( 64 - , 15 - , "prefix:0lg0x333p4238k0qrc5ej7rzfw5g8e4a4r6vvzyrcy8j3s5k0en7calvclhw46hudk5flttj6ydvjc0pv3nchp52amk97tqa5zygg96ms92w6845" - , "D0F346310D5513D9E01E299978624BA883E6BDA8F4C60883C10F28C2967E67EC77ECC7EEEAEAFC6DA89FAD72D11AC961E164678B868AEEEC5F2C1DA08884175B") + [ + ( 20 + , 0 + , "bitcoincash:qr6m7j9njldwwzlg9v7v53unlr4jkmx6eylep8ekg2" + , "F5BF48B397DAE70BE82B3CCA4793F8EB2B6CDAC9" + ) + , + ( 20 + , 1 + , "bchtest:pr6m7j9njldwwzlg9v7v53unlr4jkmx6eyvwc0uz5t" + , "F5BF48B397DAE70BE82B3CCA4793F8EB2B6CDAC9" + ) + , + ( 20 + , 1 + , "pref:pr6m7j9njldwwzlg9v7v53unlr4jkmx6ey65nvtks5" + , "F5BF48B397DAE70BE82B3CCA4793F8EB2B6CDAC9" + ) + , + ( 20 + , 15 + , "prefix:0r6m7j9njldwwzlg9v7v53unlr4jkmx6ey3qnjwsrf" + , "F5BF48B397DAE70BE82B3CCA4793F8EB2B6CDAC9" + ) + , + ( 24 + , 0 + , "bitcoincash:q9adhakpwzztepkpwp5z0dq62m6u5v5xtyj7j3h2ws4mr9g0" + , "7ADBF6C17084BC86C1706827B41A56F5CA32865925E946EA" + ) + , + ( 24 + , 1 + , "bchtest:p9adhakpwzztepkpwp5z0dq62m6u5v5xtyj7j3h2u94tsynr" + , "7ADBF6C17084BC86C1706827B41A56F5CA32865925E946EA" + ) + , + ( 24 + , 1 + , "pref:p9adhakpwzztepkpwp5z0dq62m6u5v5xtyj7j3h2khlwwk5v" + , "7ADBF6C17084BC86C1706827B41A56F5CA32865925E946EA" + ) + , + ( 24 + , 15 + , "prefix:09adhakpwzztepkpwp5z0dq62m6u5v5xtyj7j3h2p29kc2lp" + , "7ADBF6C17084BC86C1706827B41A56F5CA32865925E946EA" + ) + , + ( 28 + , 0 + , "bitcoincash:qgagf7w02x4wnz3mkwnchut2vxphjzccwxgjvvjmlsxqwkcw59jxxuz" + , "3A84F9CF51AAE98A3BB3A78BF16A6183790B18719126325BFC0C075B" + ) + , + ( 28 + , 1 + , "bchtest:pgagf7w02x4wnz3mkwnchut2vxphjzccwxgjvvjmlsxqwkcvs7md7wt" + , "3A84F9CF51AAE98A3BB3A78BF16A6183790B18719126325BFC0C075B" + ) + , + ( 28 + , 1 + , "pref:pgagf7w02x4wnz3mkwnchut2vxphjzccwxgjvvjmlsxqwkcrsr6gzkn" + , "3A84F9CF51AAE98A3BB3A78BF16A6183790B18719126325BFC0C075B" + ) + , + ( 28 + , 15 + , "prefix:0gagf7w02x4wnz3mkwnchut2vxphjzccwxgjvvjmlsxqwkc5djw8s9g" + , "3A84F9CF51AAE98A3BB3A78BF16A6183790B18719126325BFC0C075B" + ) + , + ( 32 + , 0 + , "bitcoincash:qvch8mmxy0rtfrlarg7ucrxxfzds5pamg73h7370aa87d80gyhqxq5nlegake" + , "3173EF6623C6B48FFD1A3DCC0CC6489B0A07BB47A37F47CFEF4FE69DE825C060" + ) + , + ( 32 + , 1 + , "bchtest:pvch8mmxy0rtfrlarg7ucrxxfzds5pamg73h7370aa87d80gyhqxq7fqng6m6" + , "3173EF6623C6B48FFD1A3DCC0CC6489B0A07BB47A37F47CFEF4FE69DE825C060" + ) + , + ( 32 + , 1 + , "pref:pvch8mmxy0rtfrlarg7ucrxxfzds5pamg73h7370aa87d80gyhqxq4k9m7qf9" + , "3173EF6623C6B48FFD1A3DCC0CC6489B0A07BB47A37F47CFEF4FE69DE825C060" + ) + , + ( 32 + , 15 + , "prefix:0vch8mmxy0rtfrlarg7ucrxxfzds5pamg73h7370aa87d80gyhqxqsh6jgp6w" + , "3173EF6623C6B48FFD1A3DCC0CC6489B0A07BB47A37F47CFEF4FE69DE825C060" + ) + , + ( 40 + , 0 + , "bitcoincash:qnq8zwpj8cq05n7pytfmskuk9r4gzzel8qtsvwz79zdskftrzxtar994cgutavfklv39gr3uvz" + , "C07138323E00FA4FC122D3B85B9628EA810B3F381706385E289B0B25631197D194B5C238BEB136FB" + ) + , + ( 40 + , 1 + , "bchtest:pnq8zwpj8cq05n7pytfmskuk9r4gzzel8qtsvwz79zdskftrzxtar994cgutavfklvmgm6ynej" + , "C07138323E00FA4FC122D3B85B9628EA810B3F381706385E289B0B25631197D194B5C238BEB136FB" + ) + , + ( 40 + , 1 + , "pref:pnq8zwpj8cq05n7pytfmskuk9r4gzzel8qtsvwz79zdskftrzxtar994cgutavfklv0vx5z0w3" + , "C07138323E00FA4FC122D3B85B9628EA810B3F381706385E289B0B25631197D194B5C238BEB136FB" + ) + , + ( 40 + , 15 + , "prefix:0nq8zwpj8cq05n7pytfmskuk9r4gzzel8qtsvwz79zdskftrzxtar994cgutavfklvwsvctzqy" + , "C07138323E00FA4FC122D3B85B9628EA810B3F381706385E289B0B25631197D194B5C238BEB136FB" + ) + , + ( 48 + , 0 + , "bitcoincash:qh3krj5607v3qlqh5c3wq3lrw3wnuxw0sp8dv0zugrrt5a3kj6ucysfz8kxwv2k53krr7n933jfsunqex2w82sl" + , "E361CA9A7F99107C17A622E047E3745D3E19CF804ED63C5C40C6BA763696B98241223D8CE62AD48D863F4CB18C930E4C" + ) + , + ( 48 + , 1 + , "bchtest:ph3krj5607v3qlqh5c3wq3lrw3wnuxw0sp8dv0zugrrt5a3kj6ucysfz8kxwv2k53krr7n933jfsunqnzf7mt6x" + , "E361CA9A7F99107C17A622E047E3745D3E19CF804ED63C5C40C6BA763696B98241223D8CE62AD48D863F4CB18C930E4C" + ) + , + ( 48 + , 1 + , "pref:ph3krj5607v3qlqh5c3wq3lrw3wnuxw0sp8dv0zugrrt5a3kj6ucysfz8kxwv2k53krr7n933jfsunqjntdfcwg" + , "E361CA9A7F99107C17A622E047E3745D3E19CF804ED63C5C40C6BA763696B98241223D8CE62AD48D863F4CB18C930E4C" + ) + , + ( 48 + , 15 + , "prefix:0h3krj5607v3qlqh5c3wq3lrw3wnuxw0sp8dv0zugrrt5a3kj6ucysfz8kxwv2k53krr7n933jfsunqakcssnmn" + , "E361CA9A7F99107C17A622E047E3745D3E19CF804ED63C5C40C6BA763696B98241223D8CE62AD48D863F4CB18C930E4C" + ) + , + ( 56 + , 0 + , "bitcoincash:qmvl5lzvdm6km38lgga64ek5jhdl7e3aqd9895wu04fvhlnare5937w4ywkq57juxsrhvw8ym5d8qx7sz7zz0zvcypqscw8jd03f" + , "D9FA7C4C6EF56DC4FF423BAAE6D495DBFF663D034A72D1DC7D52CBFE7D1E6858F9D523AC0A7A5C34077638E4DD1A701BD017842789982041" + ) + , + ( 56 + , 1 + , "bchtest:pmvl5lzvdm6km38lgga64ek5jhdl7e3aqd9895wu04fvhlnare5937w4ywkq57juxsrhvw8ym5d8qx7sz7zz0zvcypqs6kgdsg2g" + , "D9FA7C4C6EF56DC4FF423BAAE6D495DBFF663D034A72D1DC7D52CBFE7D1E6858F9D523AC0A7A5C34077638E4DD1A701BD017842789982041" + ) + , + ( 56 + , 1 + , "pref:pmvl5lzvdm6km38lgga64ek5jhdl7e3aqd9895wu04fvhlnare5937w4ywkq57juxsrhvw8ym5d8qx7sz7zz0zvcypqsammyqffl" + , "D9FA7C4C6EF56DC4FF423BAAE6D495DBFF663D034A72D1DC7D52CBFE7D1E6858F9D523AC0A7A5C34077638E4DD1A701BD017842789982041" + ) + , + ( 56 + , 15 + , "prefix:0mvl5lzvdm6km38lgga64ek5jhdl7e3aqd9895wu04fvhlnare5937w4ywkq57juxsrhvw8ym5d8qx7sz7zz0zvcypqsgjrqpnw8" + , "D9FA7C4C6EF56DC4FF423BAAE6D495DBFF663D034A72D1DC7D52CBFE7D1E6858F9D523AC0A7A5C34077638E4DD1A701BD017842789982041" + ) + , + ( 64 + , 0 + , "bitcoincash:qlg0x333p4238k0qrc5ej7rzfw5g8e4a4r6vvzyrcy8j3s5k0en7calvclhw46hudk5flttj6ydvjc0pv3nchp52amk97tqa5zygg96mtky5sv5w" + , "D0F346310D5513D9E01E299978624BA883E6BDA8F4C60883C10F28C2967E67EC77ECC7EEEAEAFC6DA89FAD72D11AC961E164678B868AEEEC5F2C1DA08884175B" + ) + , + ( 64 + , 1 + , "bchtest:plg0x333p4238k0qrc5ej7rzfw5g8e4a4r6vvzyrcy8j3s5k0en7calvclhw46hudk5flttj6ydvjc0pv3nchp52amk97tqa5zygg96mc773cwez" + , "D0F346310D5513D9E01E299978624BA883E6BDA8F4C60883C10F28C2967E67EC77ECC7EEEAEAFC6DA89FAD72D11AC961E164678B868AEEEC5F2C1DA08884175B" + ) + , + ( 64 + , 1 + , "pref:plg0x333p4238k0qrc5ej7rzfw5g8e4a4r6vvzyrcy8j3s5k0en7calvclhw46hudk5flttj6ydvjc0pv3nchp52amk97tqa5zygg96mg7pj3lh8" + , "D0F346310D5513D9E01E299978624BA883E6BDA8F4C60883C10F28C2967E67EC77ECC7EEEAEAFC6DA89FAD72D11AC961E164678B868AEEEC5F2C1DA08884175B" + ) + , + ( 64 + , 15 + , "prefix:0lg0x333p4238k0qrc5ej7rzfw5g8e4a4r6vvzyrcy8j3s5k0en7calvclhw46hudk5flttj6ydvjc0pv3nchp52amk97tqa5zygg96ms92w6845" + , "D0F346310D5513D9E01E299978624BA883E6BDA8F4C60883C10F28C2967E67EC77ECC7EEEAEAFC6DA89FAD72D11AC961E164678B868AEEEC5F2C1DA08884175B" + ) ] diff --git a/test/Haskoin/AddressSpec.hs b/test/Haskoin/AddressSpec.hs --- a/test/Haskoin/AddressSpec.hs +++ b/test/Haskoin/AddressSpec.hs @@ -1,20 +1,22 @@ {-# LANGUAGE OverloadedStrings #-} + module Haskoin.AddressSpec (spec) where -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS (append, empty, pack) -import Data.Maybe (fromJust, isJust) -import Data.Text (Text) -import qualified Data.Text as T -import Haskoin.Address -import Haskoin.Constants -import Haskoin.Keys -import Haskoin.Util -import Haskoin.Util.Arbitrary -import Test.Hspec -import Test.Hspec.QuickCheck -import Test.HUnit -import Test.QuickCheck +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS (append, empty, pack) +import Data.Maybe (fromJust, isJust) +import Data.Text (Text) +import qualified Data.Text as T +import Haskoin.Address +import Haskoin.Constants +import Haskoin.Data +import Haskoin.Keys +import Haskoin.Util +import Haskoin.Util.Arbitrary +import Test.HUnit +import Test.Hspec +import Test.Hspec.QuickCheck +import Test.QuickCheck serialVals :: [SerialBox] serialVals = [SerialBox arbitraryAddressAll] @@ -61,7 +63,7 @@ assertEqual "decodeBase58" (Just bs) (decodeBase58 b58) assertEqual "decodeBase58Check" (Just bs) (decodeBase58Check b58Chk) where - b58 = encodeBase58 bs + b58 = encodeBase58 bs b58Chk = encodeBase58Check bs vectors :: [(ByteString, Text, Text)] @@ -71,22 +73,24 @@ , (BS.pack [0, 0, 0, 0], "1111", "11114bdQda") , (BS.pack [0, 0, 1, 0, 0], "11LUw", "113CUwsFVuo") , (BS.pack [255], "5Q", "VrZDWwe") - , ( BS.pack [0, 0, 0, 0] `BS.append` BS.pack [1 .. 255] - , "1111cWB5HCBdLjAuqGGReWE3R3CguuwSjw6RHn39s2yuDRTS5N\ - \sBgNiFpWgAnEx6VQi8csexkgYw3mdYrMHr8x9i7aEwP8kZ7vcc\ - \XWqKDvGv3u1GxFKPuAkn8JCPPGDMf3vMMnbzm6Nh9zh1gcNsMv\ - \H3ZNLmP5fSG6DGbbi2tuwMWPthr4boWwCxf7ewSgNQeacyozhK\ - \DDQQ1qL5fQFUW52QKUZDZ5fw3KXNQJMcNTcaB723LchjeKun7M\ - \uGW5qyCBZYzA1KjofN1gYBV3NqyhQJ3Ns746GNuf9N2pQPmHz4\ - \xpnSrrfCvy6TVVz5d4PdrjeshsWQwpZsZGzvbdAdN8MKV5QsBDY" - , "111151KWPPBRzdWPr1ASeu172gVgLf1YfUp6VJyk6K9t4cLqYt\ - \FHcMa2iX8S3NJEprUcW7W5LvaPRpz7UG7puBj5STE3nKhCGt5e\ - \ckYq7mMn5nT7oTTic2BAX6zDdqrmGCnkszQkzkz8e5QLGDjf7K\ - \eQgtEDm4UER6DMSdBjFQVa6cHrrJn9myVyyhUrsVnfUk2WmNFZ\ - \vkWv3Tnvzo2cJ1xW62XDfUgYz1pd97eUGGPuXvDFfLsBVd1dfd\ - \UhPwxW7pMPgdWHTmg5uqKGFF6vE4xXpAqZTbTxRZjCDdTn68c2\ - \wrcxApm8hq3JX65Hix7VtcD13FF8b7BzBtwjXq1ze6NMjKgUcq\ - \pJTN9vt") + , + ( BS.pack [0, 0, 0, 0] `BS.append` BS.pack [1 .. 255] + , "1111cWB5HCBdLjAuqGGReWE3R3CguuwSjw6RHn39s2yuDRTS5N\ + \sBgNiFpWgAnEx6VQi8csexkgYw3mdYrMHr8x9i7aEwP8kZ7vcc\ + \XWqKDvGv3u1GxFKPuAkn8JCPPGDMf3vMMnbzm6Nh9zh1gcNsMv\ + \H3ZNLmP5fSG6DGbbi2tuwMWPthr4boWwCxf7ewSgNQeacyozhK\ + \DDQQ1qL5fQFUW52QKUZDZ5fw3KXNQJMcNTcaB723LchjeKun7M\ + \uGW5qyCBZYzA1KjofN1gYBV3NqyhQJ3Ns746GNuf9N2pQPmHz4\ + \xpnSrrfCvy6TVVz5d4PdrjeshsWQwpZsZGzvbdAdN8MKV5QsBDY" + , "111151KWPPBRzdWPr1ASeu172gVgLf1YfUp6VJyk6K9t4cLqYt\ + \FHcMa2iX8S3NJEprUcW7W5LvaPRpz7UG7puBj5STE3nKhCGt5e\ + \ckYq7mMn5nT7oTTic2BAX6zDdqrmGCnkszQkzkz8e5QLGDjf7K\ + \eQgtEDm4UER6DMSdBjFQVa6cHrrJn9myVyyhUrsVnfUk2WmNFZ\ + \vkWv3Tnvzo2cJ1xW62XDfUgYz1pd97eUGGPuXvDFfLsBVd1dfd\ + \UhPwxW7pMPgdWHTmg5uqKGFF6vE4xXpAqZTbTxRZjCDdTn68c2\ + \wrcxApm8hq3JX65Hix7VtcD13FF8b7BzBtwjXq1ze6NMjKgUcq\ + \pJTN9vt" + ) ] -- Test vectors from: @@ -107,34 +111,42 @@ , ("61", "2g") , ("626262", "a3gV") , ("636363", "aPEr") - , ( "73696d706c792061206c6f6e6720737472696e67" - , "2cFupjhnEsSn59qHXstmK2ffpLv2") - , ( "00eb15231dfceb60925886b67d065299925915aeb172c06647" - , "1NS17iag9jJgTHD1VXjvLCEnZuQ3rJDE9L") + , + ( "73696d706c792061206c6f6e6720737472696e67" + , "2cFupjhnEsSn59qHXstmK2ffpLv2" + ) + , + ( "00eb15231dfceb60925886b67d065299925915aeb172c06647" + , "1NS17iag9jJgTHD1VXjvLCEnZuQ3rJDE9L" + ) , ("516b6fcd0f", "ABnLTmg") , ("bf4f89001e670274dd", "3SEo3LWLoPntC") , ("572e4794", "3EFU7m") , ("ecac89cad93923c02321", "EJDM8drfXA6uyA") , ("10c8511e", "Rt5zm") , ("00000000000000000000", "1111111111") - , ( "000111d38e5fc9071ffcd20b4a763cc9ae4f252bb4e48fd66a835e252a\ - \da93ff480d6dd43dc62a641155a5" - , "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz") - , ( "000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c\ - \1d1e1f202122232425262728292a2b2c2d2e2f30313233343536373839\ - \3a3b3c3d3e3f404142434445464748494a4b4c4d4e4f50515253545556\ - \5758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f70717273\ - \7475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f90\ - \9192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacad\ - \aeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9ca\ - \cbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7\ - \e8e9eaebecedeeeff0f1f2f3f4f5f6f7f8f9fafbfcfdfeff" - , "1cWB5HCBdLjAuqGGReWE3R3CguuwSjw6RHn39s2yuDRTS5NsBgNiFpWgAn\ - \Ex6VQi8csexkgYw3mdYrMHr8x9i7aEwP8kZ7vccXWqKDvGv3u1GxFKPuAk\ - \n8JCPPGDMf3vMMnbzm6Nh9zh1gcNsMvH3ZNLmP5fSG6DGbbi2tuwMWPthr\ - \4boWwCxf7ewSgNQeacyozhKDDQQ1qL5fQFUW52QKUZDZ5fw3KXNQJMcNTc\ - \aB723LchjeKun7MuGW5qyCBZYzA1KjofN1gYBV3NqyhQJ3Ns746GNuf9N2\ - \pQPmHz4xpnSrrfCvy6TVVz5d4PdrjeshsWQwpZsZGzvbdAdN8MKV5QsBDY") + , + ( "000111d38e5fc9071ffcd20b4a763cc9ae4f252bb4e48fd66a835e252a\ + \da93ff480d6dd43dc62a641155a5" + , "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz" + ) + , + ( "000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c\ + \1d1e1f202122232425262728292a2b2c2d2e2f30313233343536373839\ + \3a3b3c3d3e3f404142434445464748494a4b4c4d4e4f50515253545556\ + \5758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f70717273\ + \7475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f90\ + \9192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacad\ + \aeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9ca\ + \cbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7\ + \e8e9eaebecedeeeff0f1f2f3f4f5f6f7f8f9fafbfcfdfeff" + , "1cWB5HCBdLjAuqGGReWE3R3CguuwSjw6RHn39s2yuDRTS5NsBgNiFpWgAn\ + \Ex6VQi8csexkgYw3mdYrMHr8x9i7aEwP8kZ7vccXWqKDvGv3u1GxFKPuAk\ + \n8JCPPGDMf3vMMnbzm6Nh9zh1gcNsMvH3ZNLmP5fSG6DGbbi2tuwMWPthr\ + \4boWwCxf7ewSgNQeacyozhKDDQQ1qL5fQFUW52QKUZDZ5fw3KXNQJMcNTc\ + \aB723LchjeKun7MuGW5qyCBZYzA1KjofN1gYBV3NqyhQJ3Ns746GNuf9N2\ + \pQPmHz4xpnSrrfCvy6TVVz5d4PdrjeshsWQwpZsZGzvbdAdN8MKV5QsBDY" + ) ] -- Test vectors from: @@ -167,7 +179,7 @@ base58ChkInvalidVectors :: [(Text, Maybe Text)] base58ChkInvalidVectors = [ ("3vQB7B6MrGQZaxCuFg4oh", Just "68656c6c6f20776f726c64") - , ("3vQB7B6MrGQZaxCuFg4oi", Nothing) + , ("3vQB7B6MrGQZaxCuFg4oi", Nothing) , ("3vQB7B6MrGQZaxCuFg4oh0IOl", Nothing) , ("3vQB7B6MrGQZaxCuFg4oh\00IOl", Nothing) ] @@ -183,7 +195,9 @@ compatWitnessVectors :: [(Network, Text, Text)] compatWitnessVectors = - [ ( btcTest - , "cNUnpYpMsJXYCERYBciJnsWBpcYEFjdcbq6dxj4SskGhs7uHuJ7Q" - , "2N6PDTueBHvXzW61B4oe5SW1D3v2Z3Vpbvw") + [ + ( btcTest + , "cNUnpYpMsJXYCERYBciJnsWBpcYEFjdcbq6dxj4SskGhs7uHuJ7Q" + , "2N6PDTueBHvXzW61B4oe5SW1D3v2Z3Vpbvw" + ) ] diff --git a/test/Haskoin/BlockSpec.hs b/test/Haskoin/BlockSpec.hs --- a/test/Haskoin/BlockSpec.hs +++ b/test/Haskoin/BlockSpec.hs @@ -1,26 +1,26 @@ {-# LANGUAGE OverloadedStrings #-} -module Haskoin.BlockSpec - ( spec - ) where - -import Control.Monad.State.Strict -import Data.Either (fromRight) -import Data.Maybe (fromJust) -import Data.String (fromString) -import Data.String.Conversions (cs) -import Data.Text (Text) -import Data.Word (Word32) -import Haskoin.Block -import Haskoin.Constants -import Haskoin.Transaction -import Haskoin.Util.Arbitrary -import Test.Hspec -import Test.Hspec.QuickCheck -import Test.HUnit hiding (State) -import Test.QuickCheck -import Text.Printf (printf) +module Haskoin.BlockSpec ( + spec, +) where +import Control.Monad.State.Strict +import Data.Either (fromRight) +import Data.Maybe (fromJust) +import Data.String (fromString) +import Data.String.Conversions (cs) +import Data.Text (Text) +import Data.Word (Word32) +import Haskoin.Block +import Haskoin.Constants +import Haskoin.Data +import Haskoin.Transaction +import Haskoin.Util.Arbitrary +import Test.HUnit hiding (State) +import Test.Hspec +import Test.Hspec.QuickCheck +import Test.QuickCheck +import Text.Printf (printf) serialVals :: [SerialBox] serialVals = @@ -85,7 +85,7 @@ bb <- getBestBlockHeader blockLocatorNodes bb heights = map nodeHeight loc - in heights `shouldBe` [100,99 .. 90] <> [88, 84, 76, 60, 28, 0] + in heights `shouldBe` [100, 99 .. 90] <> [88, 84, 76, 60, 28, 0] it "follows split chains on bchRegTest" $ let net = bchRegTest bb = withChain net $ splitChain net >> getBestBlockHeader @@ -110,9 +110,12 @@ it "compact number local vectors" testCompact it "compact number imported vectors" testCompactBitcoinCore describe "asert" $ - mapM_ (\x -> asertTests $ - "test_vectors_aserti3-2d_run" ++ printf "%02d" x ++ ".txt" - ) [(1 :: Int) .. 12] + mapM_ + ( \x -> + asertTests $ + "test_vectors_aserti3-2d_run" ++ printf "%02d" x ++ ".txt" + ) + [(1 :: Int) .. 12] describe "helper functions" $ do it "computes bitcoin block subsidy correctly" (testSubsidy btc) it "computes regtest block subsidy correctly" (testSubsidy btcRegTest) @@ -137,25 +140,27 @@ sp1 <- splitPoint (head tail1) (head tail3) unless (sp1 == head start) $ error $ - "Split point wrong between blocks 4031 and 4035: " ++ - show (nodeHeight sp1) + "Split point wrong between blocks 4031 and 4035: " + ++ show (nodeHeight sp1) sp2 <- splitPoint (head tail4) (head tail3) unless (sp2 == head tail2) $ error $ - "Split point wrong between blocks 2185 and 4035: " ++ - show (nodeHeight sp2) + "Split point wrong between blocks 2185 and 4035: " + ++ show (nodeHeight sp2) where e n bn = unless (nodeHeight bn == n) $ - error $ - "Node height " ++ - show (nodeHeight bn) ++ " of first chunk should be " ++ show n + error $ + "Node height " + ++ show (nodeHeight bn) + ++ " of first chunk should be " + ++ show n go seed start n = do let bhs = appendBlocks net seed start n bnE <- connectBlocks net myTime bhs case bnE of Right bn -> return bn - Left ex -> error ex + Left ex -> error ex {- Merkle Trees -} @@ -172,7 +177,7 @@ (f, h) = buildPartialMerkle txs (r, m) = fromRight (error "Could not extract matches from Merkle tree") $ - extractMatches net f h (length txs) + extractMatches net f h (length txs) testCompact :: Assertion testCompact = do @@ -251,7 +256,8 @@ assertEqual "vector 8 (decode)" ( 0x1234560000000000000000000000000000000000000000000000000000000000 - , False) + , False + ) (decodeCompact 0x20123456) assertEqual "vector 8 (encode · decode)" @@ -271,85 +277,96 @@ merkleVectors :: [(Text, [Text])] merkleVectors = - -- Block 000000000000cd7e8cf6510303dde76121a1a791c15dba0be4be7022b07cf9e1 - [ ( "fb6698ac95b754256c5e71b4fbe07638cb6ca83ee67f44e181b91727f09f4b1f" - , [ "dd96fdcfaec994bf583af650ff6022980ee0ba1686d84d0a3a2d24eabf34bc52" - , "1bc216f786a564378710ae589916fc8e092ddfb9f24fe6c47b733550d476d5d9" - , "a1db0b0194426064b067899ff2d975fb277fd52dbb1a38370800c76dd6503d41" - , "d69f7fb0e668fbd437d1bf5211cc34d7eb8746f50cfddf705fe10bc2f8f7035f" - , "5b4057cd80be7df5ed2ac42b776897ed3c26e3a01e4072075b8129c587094ef6" - , "ed6dabcfba0ef43c50d89a8a0e4b236b1bc6585d4c3bbf49728b55f44312d6bc" - , "056aaa9a3c635909c794e9b0acc7dccb0456c59a84c6b08417335bee4515e3d3" - , "05bae5f1d1c874171692e1fc06f664e63eb143d3f096601ef938e4a9012eee66" - , "b5e48e94e3f2fba197b3f591e01f47e185d7834d669529d44078e41c671aab0f" - , "3b56aeadfc0c5484fd507bc89f13f2e5f61c42e0a4ae9062eda9a9aeef7db6a4" - , "2affa187e1ebb94a2a86578b9f64951e854ff3d346fef259acfb6d0f5212e0d3" - ] - ) - -- Block 00000000000007cc4b6f07bfed72bccc1ed8dd031a93969a4c22211f784457d4 - , ( "886fea311d2dc64c315519f2d647e43998d780d2170f77e53dc0d85bf2ee680c" - , [ "c9c9e5211512629fd111cc071d745b8c79bf486b4ea95489eb5de08b5d786b8e" - , "20beb0ee30dfd323ade790ce9a46ae7a174f9ea44ce22a17c4d4eb23b7016f51" - , "d4cb7dd741e78a8f57e12f6c8ddb0361ff2a5bf9365bd7d7df761060847daf9a" - , "ddbfa6fdd29d4b47aeaadf82a4bf0a93d58cd7d8401fabf860a1ae8eeb51f42e" - , "9d82bafe44abee248b968c86f165051c8413482c232659795335c52922dab471" - , "86035372d31b53efd848cea7231aa9738c209aff64d3c59b1619341afb5b6ba3" - , "11e7a7393d9658813dfaebc04fa6d4b73bac8d641bffa7067da879523d43d030" - , "2f676b9aa5bc0ebf3395032c84c466e40cac29f80434cd1138e31c2d0fcc5c13" - , "37567d559fbfae07fda9a90de0ce30b202128bc8ebdfef5ad2b53e865a3478c2" - , "0b8e6c1200c454361e94e261738429e9c9b8dcffd85ec8511bbf5dc7e2e0ada8" - ] - ) - -- Block 00000000839a8e6886ab5951d76f411475428afc90947ee320161bbf18eb6048 - , ( "0e3e2357e806b6cdb1f70b54c3a3a17b6714ee1f0e68bebb44a74b1efd512098" - , [ "0e3e2357e806b6cdb1f70b54c3a3a17b6714ee1f0e68bebb44a74b1efd512098" ] - ) - -- Block 000000000004d160ac1f7b775d7c1823345aeadd5fcb29ca2ad2403bb7babd4c - , ( "aae018650f513fc42d55b2210ec3ceeeb194fb1261d37989de07451fc0cbac5c" - , [ "a4454f22831acd7904a9902c5070a3ee4bf4c2b13bc6b2dc66735dd3c4414028" - , "45297f334278885108dd38a0b689ed95a4373dd3f7e4413e6aebdc2654fb771b" - ] - ) - -- Block 000000000001d1b13a7e86ddb20da178f20d6da5cd037a29c2a15b8b84cc774e - , ( "ca3580505feb87544760ac14a5859659e23be05f765bbed9f86a3c9aad1a5d0c" - , [ "60702384c6e9d34ff03c2b3e726bdc649befe603216815bd0a2974921d0d9549" - , "11f40f58941d2a81a1616a3b84b7dd8b9d07e68750827de488c11a18f54220bb" - , "d78e82527aa8cf16e375010bc666362c0258d3c0da1885a1871121706da8b633" - ] - ) - -- Block 0000000000000630a4e2266a31776e952a19b7c99a6387917d9de9032f608021 - , ( "dcce8be0a9a41e7bb726c5b49d957d90b5308e3dc5dce070ccbc8996e265a6c2" - , [ "c0f58ff12cd1023b05f8f7035cc62bf50958ddb216a4e0eb5471deb7ef25fe81" - , "24e5bbf9008641b8fcf3d076fef66c28c695362ba9f6a6042f8275a98414ee92" - , "e8e1f72abad5e34dabc0f6de46a484b17a9af857d1c41de19482fadf6f7f4b27" - , "540e4d34d9fd9e5ec02853054be7ad9260379bc23388489049cca1b0f7cf518a" - , "324444835c5fe0545f98c4240011b75e6ea1bb76f41829e4cfbe7f75b6cee924" - , "e7d31437ac21bceb0c222a82b2723e2b8a7654147e33397679f041537022a4b2" - , "a8b5768d8b33525ee89d546a6a6897f8e42ba9d56a2c5e871a5d2ab40258dc95" - , "7ba712b31bae8d45810a5cda3838c7e7fb9abd6e88bb4b3ee79be9ea2f714bb4" - , "2ae1c4d927b06edaa626b230976ad8062bbae24da9378d1de2409da5ab08a26d" - , "3c417dc8087d6878003624b74431e17fec9ca761389034b1b1e0f32cbfb11f4f" - , "de6de7beae8d8c98c7d46b4409d5460e58e3204d8b4caed256c7471998595909" - , "c7c3c211402b7c4379f7b01fadc67260ee58d11e8d0bcce3d68cb45f3467e99d" - , "77aa2717e727a096d81074bd46ae59462692d20a1acc1a01b2535518ae5aeb53" - , "4859a710bb673aca46208bbd59d1000ae990dafff5f70b56f0853aeeaea3948b" - , "38deca6991988e461b83aa0d49ffef0f304c4b760371682d152eeb8c56a48174" - , "648f4f50dada3574e2dfe2dc68956b01dd97d543859a3540bbe1ef5418d0e494" - , "9cd7be42c2f0cd8bf38738c162cd05108e213ec7958bf2571cb627872963f5c4" - , "6740e0dd8b97e23864af41839fc197238d2f0dbefce9a82c657556be65c465fa" - , "f75c2e4b70db4b0aabc44b77af1ae75d305340fcf6e7b5f806ddcba4aa42b55d" - , "e125c488636749da68e6696b97525a77146c0777c7946927e37afd513d74a4e6" - , "c20526f119aea10880af631eba7f0b60385a22e0b0c402fe8508d41952e58be9" - , "6456c023c7e245f5c57a168633a23f57f4fadb651115f807694a6bed14ae3b55" - , "98b26e364e2888c9f264e4b5e13103c89608609774eb07ce933d8a2a45d19776" - , "2efaa4f167bb65ba5684f8076cd9279fd67fd9c67388c8862809bab5542e637d" - , "ec44eeb84d8d976d77079a822710b4dfdb11a2d9a03d8cc00bab0ae424e84666" - , "410730d9f807d81ac48b8eafac6f1d36642c1c370241b367a35f0bac6ac7c05f" - , "e95a7d0d477fd3db22756a3fd390a50c7bc48dc9e946fea9d24bd0866b3bb0e9" - , "a72fec99d14939216628aaf7a0afc4c017113bcae964e777e6b508864eeaacc4" - , "8548433310fcf75dbbc042121e8318c678e0a017534786dd322a91cebe8d213f" - ] - ) + -- Block 000000000000cd7e8cf6510303dde76121a1a791c15dba0be4be7022b07cf9e1 + [ + ( "fb6698ac95b754256c5e71b4fbe07638cb6ca83ee67f44e181b91727f09f4b1f" + , + [ "dd96fdcfaec994bf583af650ff6022980ee0ba1686d84d0a3a2d24eabf34bc52" + , "1bc216f786a564378710ae589916fc8e092ddfb9f24fe6c47b733550d476d5d9" + , "a1db0b0194426064b067899ff2d975fb277fd52dbb1a38370800c76dd6503d41" + , "d69f7fb0e668fbd437d1bf5211cc34d7eb8746f50cfddf705fe10bc2f8f7035f" + , "5b4057cd80be7df5ed2ac42b776897ed3c26e3a01e4072075b8129c587094ef6" + , "ed6dabcfba0ef43c50d89a8a0e4b236b1bc6585d4c3bbf49728b55f44312d6bc" + , "056aaa9a3c635909c794e9b0acc7dccb0456c59a84c6b08417335bee4515e3d3" + , "05bae5f1d1c874171692e1fc06f664e63eb143d3f096601ef938e4a9012eee66" + , "b5e48e94e3f2fba197b3f591e01f47e185d7834d669529d44078e41c671aab0f" + , "3b56aeadfc0c5484fd507bc89f13f2e5f61c42e0a4ae9062eda9a9aeef7db6a4" + , "2affa187e1ebb94a2a86578b9f64951e854ff3d346fef259acfb6d0f5212e0d3" + ] + ) + , -- Block 00000000000007cc4b6f07bfed72bccc1ed8dd031a93969a4c22211f784457d4 + + ( "886fea311d2dc64c315519f2d647e43998d780d2170f77e53dc0d85bf2ee680c" + , + [ "c9c9e5211512629fd111cc071d745b8c79bf486b4ea95489eb5de08b5d786b8e" + , "20beb0ee30dfd323ade790ce9a46ae7a174f9ea44ce22a17c4d4eb23b7016f51" + , "d4cb7dd741e78a8f57e12f6c8ddb0361ff2a5bf9365bd7d7df761060847daf9a" + , "ddbfa6fdd29d4b47aeaadf82a4bf0a93d58cd7d8401fabf860a1ae8eeb51f42e" + , "9d82bafe44abee248b968c86f165051c8413482c232659795335c52922dab471" + , "86035372d31b53efd848cea7231aa9738c209aff64d3c59b1619341afb5b6ba3" + , "11e7a7393d9658813dfaebc04fa6d4b73bac8d641bffa7067da879523d43d030" + , "2f676b9aa5bc0ebf3395032c84c466e40cac29f80434cd1138e31c2d0fcc5c13" + , "37567d559fbfae07fda9a90de0ce30b202128bc8ebdfef5ad2b53e865a3478c2" + , "0b8e6c1200c454361e94e261738429e9c9b8dcffd85ec8511bbf5dc7e2e0ada8" + ] + ) + , -- Block 00000000839a8e6886ab5951d76f411475428afc90947ee320161bbf18eb6048 + + ( "0e3e2357e806b6cdb1f70b54c3a3a17b6714ee1f0e68bebb44a74b1efd512098" + , ["0e3e2357e806b6cdb1f70b54c3a3a17b6714ee1f0e68bebb44a74b1efd512098"] + ) + , -- Block 000000000004d160ac1f7b775d7c1823345aeadd5fcb29ca2ad2403bb7babd4c + + ( "aae018650f513fc42d55b2210ec3ceeeb194fb1261d37989de07451fc0cbac5c" + , + [ "a4454f22831acd7904a9902c5070a3ee4bf4c2b13bc6b2dc66735dd3c4414028" + , "45297f334278885108dd38a0b689ed95a4373dd3f7e4413e6aebdc2654fb771b" + ] + ) + , -- Block 000000000001d1b13a7e86ddb20da178f20d6da5cd037a29c2a15b8b84cc774e + + ( "ca3580505feb87544760ac14a5859659e23be05f765bbed9f86a3c9aad1a5d0c" + , + [ "60702384c6e9d34ff03c2b3e726bdc649befe603216815bd0a2974921d0d9549" + , "11f40f58941d2a81a1616a3b84b7dd8b9d07e68750827de488c11a18f54220bb" + , "d78e82527aa8cf16e375010bc666362c0258d3c0da1885a1871121706da8b633" + ] + ) + , -- Block 0000000000000630a4e2266a31776e952a19b7c99a6387917d9de9032f608021 + + ( "dcce8be0a9a41e7bb726c5b49d957d90b5308e3dc5dce070ccbc8996e265a6c2" + , + [ "c0f58ff12cd1023b05f8f7035cc62bf50958ddb216a4e0eb5471deb7ef25fe81" + , "24e5bbf9008641b8fcf3d076fef66c28c695362ba9f6a6042f8275a98414ee92" + , "e8e1f72abad5e34dabc0f6de46a484b17a9af857d1c41de19482fadf6f7f4b27" + , "540e4d34d9fd9e5ec02853054be7ad9260379bc23388489049cca1b0f7cf518a" + , "324444835c5fe0545f98c4240011b75e6ea1bb76f41829e4cfbe7f75b6cee924" + , "e7d31437ac21bceb0c222a82b2723e2b8a7654147e33397679f041537022a4b2" + , "a8b5768d8b33525ee89d546a6a6897f8e42ba9d56a2c5e871a5d2ab40258dc95" + , "7ba712b31bae8d45810a5cda3838c7e7fb9abd6e88bb4b3ee79be9ea2f714bb4" + , "2ae1c4d927b06edaa626b230976ad8062bbae24da9378d1de2409da5ab08a26d" + , "3c417dc8087d6878003624b74431e17fec9ca761389034b1b1e0f32cbfb11f4f" + , "de6de7beae8d8c98c7d46b4409d5460e58e3204d8b4caed256c7471998595909" + , "c7c3c211402b7c4379f7b01fadc67260ee58d11e8d0bcce3d68cb45f3467e99d" + , "77aa2717e727a096d81074bd46ae59462692d20a1acc1a01b2535518ae5aeb53" + , "4859a710bb673aca46208bbd59d1000ae990dafff5f70b56f0853aeeaea3948b" + , "38deca6991988e461b83aa0d49ffef0f304c4b760371682d152eeb8c56a48174" + , "648f4f50dada3574e2dfe2dc68956b01dd97d543859a3540bbe1ef5418d0e494" + , "9cd7be42c2f0cd8bf38738c162cd05108e213ec7958bf2571cb627872963f5c4" + , "6740e0dd8b97e23864af41839fc197238d2f0dbefce9a82c657556be65c465fa" + , "f75c2e4b70db4b0aabc44b77af1ae75d305340fcf6e7b5f806ddcba4aa42b55d" + , "e125c488636749da68e6696b97525a77146c0777c7946927e37afd513d74a4e6" + , "c20526f119aea10880af631eba7f0b60385a22e0b0c402fe8508d41952e58be9" + , "6456c023c7e245f5c57a168633a23f57f4fadb651115f807694a6bed14ae3b55" + , "98b26e364e2888c9f264e4b5e13103c89608609774eb07ce933d8a2a45d19776" + , "2efaa4f167bb65ba5684f8076cd9279fd67fd9c67388c8862809bab5542e637d" + , "ec44eeb84d8d976d77079a822710b4dfdb11a2d9a03d8cc00bab0ae424e84666" + , "410730d9f807d81ac48b8eafac6f1d36642c1c370241b367a35f0bac6ac7c05f" + , "e95a7d0d477fd3db22756a3fd390a50c7bc48dc9e946fea9d24bd0866b3bb0e9" + , "a72fec99d14939216628aaf7a0afc4c017113bcae964e777e6b508864eeaacc4" + , "8548433310fcf75dbbc042121e8318c678e0a017534786dd322a91cebe8d213f" + ] + ) ] testSubsidy :: Network -> Assertion @@ -370,7 +387,7 @@ readAsertVector :: FilePath -> IO AsertVector readAsertVector p = do - (d:ah:apt:ab:_:_:_:_:xs) <- lines <$> readFile ("data/" ++ p) + (d : ah : apt : ab : _ : _ : _ : _ : xs) <- lines <$> readFile ("data/" ++ p) let desc = drop 16 d anchor_height = read (words ah !! 3) anchor_parent_time = read (words apt !! 4) @@ -378,13 +395,13 @@ blocks = map (f . words) (init xs) return $ AsertVector - desc - anchor_height - anchor_parent_time - anchor_nbits - blocks + desc + anchor_height + anchor_parent_time + anchor_nbits + blocks where - f [i,h,t,g] = AsertBlock (read i) (read h) (read t) (read g) + f [i, h, t, g] = AsertBlock (read i) (read h) (read t) (read g) f _ = undefined asertTests :: FilePath -> SpecWith () @@ -400,5 +417,4 @@ anchor_bits (t - anchor_parent_time) (h - anchor_height) - `shouldBe` - g + `shouldBe` g diff --git a/test/Haskoin/Crypto/HashSpec.hs b/test/Haskoin/Crypto/HashSpec.hs --- a/test/Haskoin/Crypto/HashSpec.hs +++ b/test/Haskoin/Crypto/HashSpec.hs @@ -1,28 +1,29 @@ {-# LANGUAGE OverloadedStrings #-} + module Haskoin.Crypto.HashSpec (spec) where -import Data.Bits -import Data.ByteString (ByteString) -import Data.ByteString.Builder -import qualified Data.ByteString.Char8 as C -import qualified Data.ByteString.Lazy as BL -import qualified Data.ByteString.Short as BSS -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import Data.Maybe (fromJust) -import Data.String (fromString) -import Data.String.Conversions -import Data.Text (Text) -import Data.Word -import Haskoin.Block -import Haskoin.Crypto -import Haskoin.Util -import Haskoin.Util.Arbitrary -import Test.HUnit -import Test.Hspec -import Test.Hspec.QuickCheck -import Test.QuickCheck +import Data.Bits +import Data.ByteString (ByteString) +import Data.ByteString.Builder +import qualified Data.ByteString.Char8 as C +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Short as BSS +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.Maybe (fromJust) +import Data.String (fromString) +import Data.String.Conversions +import Data.Text (Text) +import Data.Word +import Haskoin.Block +import Haskoin.Crypto +import Haskoin.Util +import Haskoin.Util.Arbitrary +import Test.HUnit +import Test.Hspec +import Test.Hspec.QuickCheck +import Test.QuickCheck serialVals :: [SerialBox] serialVals = @@ -90,18 +91,18 @@ -- https://github.com/bitcoin/bitcoin/blob/master/src/test/crypto_tests.cpp testVector :: - (ByteString -> a) - -> (a -> BSS.ShortByteString) - -> (ByteString, Text) - -> Assertion + (ByteString -> a) -> + (a -> BSS.ShortByteString) -> + (ByteString, Text) -> + Assertion testVector f1 f2 (i, res) = assertEqual "Hash matches" res (encodeHex (BSS.fromShort $ f2 $ f1 i)) testHMACVector :: - (ByteString -> ByteString -> a) - -> (a -> BSS.ShortByteString) - -> (Text, Text, Text) - -> Assertion + (ByteString -> ByteString -> a) -> + (a -> BSS.ShortByteString) -> + (Text, Text, Text) -> + Assertion testHMACVector f1 f2 (k, m, res) = assertEqual "Hash matches" res (encodeHex (BSS.fromShort $ f2 $ f1 bsK bsM)) where @@ -114,7 +115,7 @@ where go :: [Word32] -> Builder go [] = mempty - go (i:is) = + go (i : is) = let i1 = fromIntegral $! i i2 = fromIntegral $! i `shiftR` 4 i3 = fromIntegral $! i `shiftR` 8 @@ -128,14 +129,22 @@ , ("abc", "8eb208f7e05d987a9b044a8e98c6b087f15a0bfc") , ("message digest", "5d0689ef49d2fae572b881b123a85ffa21595f36") , ("secure hash algorithm", "20397528223b6a5f4cbc2808aba0464e645544f9") - , ( "RIPEMD160 is considered to be safe" - , "a7d78608c7af8a8e728778e81576870734122b66") - , ( "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" - , "12a053384a9c0c88e405a06c27dcf49ada62eb2b") - , ( "For this sample, this 63-byte string will be used as input data" - , "de90dbfee14b63fb5abf27c2ad4a82aaa5f27a11") - , ( "This is exactly 64 bytes long, not counting the terminating byte" - , "eda31d51d3a623b81e19eb02e24ff65d27d67b37") + , + ( "RIPEMD160 is considered to be safe" + , "a7d78608c7af8a8e728778e81576870734122b66" + ) + , + ( "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" + , "12a053384a9c0c88e405a06c27dcf49ada62eb2b" + ) + , + ( "For this sample, this 63-byte string will be used as input data" + , "de90dbfee14b63fb5abf27c2ad4a82aaa5f27a11" + ) + , + ( "This is exactly 64 bytes long, not counting the terminating byte" + , "eda31d51d3a623b81e19eb02e24ff65d27d67b37" + ) , (C.replicate 1000000 'a', "52783243c1697bdbe16d37f97f68f08325dc1528") , (longTestString, "464243587bd146ea835cdf57bdae582f25ec45f1") ] @@ -146,14 +155,22 @@ , ("abc", "a9993e364706816aba3e25717850c26c9cd0d89d") , ("message digest", "c12252ceda8be8994d5fa0290a47231c1d16aae3") , ("secure hash algorithm", "d4d6d2f0ebe317513bbd8d967d89bac5819c2f60") - , ( "SHA1 is considered to be safe" - , "f2b6650569ad3a8720348dd6ea6c497dee3a842a") - , ( "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" - , "84983e441c3bd26ebaae4aa1f95129e5e54670f1") - , ( "For this sample, this 63-byte string will be used as input data" - , "4f0ea5cd0585a23d028abdc1a6684e5a8094dc49") - , ( "This is exactly 64 bytes long, not counting the terminating byte" - , "fb679f23e7d1ce053313e66e127ab1b444397057") + , + ( "SHA1 is considered to be safe" + , "f2b6650569ad3a8720348dd6ea6c497dee3a842a" + ) + , + ( "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" + , "84983e441c3bd26ebaae4aa1f95129e5e54670f1" + ) + , + ( "For this sample, this 63-byte string will be used as input data" + , "4f0ea5cd0585a23d028abdc1a6684e5a8094dc49" + ) + , + ( "This is exactly 64 bytes long, not counting the terminating byte" + , "fb679f23e7d1ce053313e66e127ab1b444397057" + ) , (C.replicate 1000000 'a', "34aa973cd4c4daa4f61eeb2bdbad27316534016f") , (longTestString, "b7755760681cbfd971451668f32af5774f4656b5") ] @@ -161,182 +178,260 @@ sha256Vectors :: [(ByteString, Text)] sha256Vectors = [ ("", "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855") - , ( "abc" - , "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad") - , ( "message digest" - , "f7846f55cf23e14eebeab5b4e1550cad5b509e3348fbc4efa3a1413d393cb650") - , ( "secure hash algorithm" - , "f30ceb2bb2829e79e4ca9753d35a8ecc00262d164cc077080295381cbd643f0d") - , ( "SHA256 is considered to be safe" - , "6819d915c73f4d1e77e4e1b52d1fa0f9cf9beaead3939f15874bd988e2a23630") - , ( "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" - , "248d6a61d20638b8e5c026930c3e6039a33ce45964ff2167f6ecedd419db06c1") - , ( "For this sample, this 63-byte string will be used as input data" - , "f08a78cbbaee082b052ae0708f32fa1e50c5c421aa772ba5dbb406a2ea6be342") - , ( "This is exactly 64 bytes long, not counting the terminating byte" - , "ab64eff7e88e2e46165e29f2bce41826bd4c7b3552f6b382a9e7d3af47c245f8") - , ( "As Bitcoin relies on 80 byte header hashes, we want to have an example for that." - , "7406e8de7d6e4fffc573daef05aefb8806e7790f55eab5576f31349743cca743") - , ( C.replicate 1000000 'a' - , "cdc76e5c9914fb9281a1c7e284d73e67f1809a48a497200e046d39ccc7112cd0") - , ( longTestString - , "a316d55510b49662420f49d145d42fb83f31ef8dc016aa4e32df049991a91e26") + , + ( "abc" + , "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad" + ) + , + ( "message digest" + , "f7846f55cf23e14eebeab5b4e1550cad5b509e3348fbc4efa3a1413d393cb650" + ) + , + ( "secure hash algorithm" + , "f30ceb2bb2829e79e4ca9753d35a8ecc00262d164cc077080295381cbd643f0d" + ) + , + ( "SHA256 is considered to be safe" + , "6819d915c73f4d1e77e4e1b52d1fa0f9cf9beaead3939f15874bd988e2a23630" + ) + , + ( "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" + , "248d6a61d20638b8e5c026930c3e6039a33ce45964ff2167f6ecedd419db06c1" + ) + , + ( "For this sample, this 63-byte string will be used as input data" + , "f08a78cbbaee082b052ae0708f32fa1e50c5c421aa772ba5dbb406a2ea6be342" + ) + , + ( "This is exactly 64 bytes long, not counting the terminating byte" + , "ab64eff7e88e2e46165e29f2bce41826bd4c7b3552f6b382a9e7d3af47c245f8" + ) + , + ( "As Bitcoin relies on 80 byte header hashes, we want to have an example for that." + , "7406e8de7d6e4fffc573daef05aefb8806e7790f55eab5576f31349743cca743" + ) + , + ( C.replicate 1000000 'a' + , "cdc76e5c9914fb9281a1c7e284d73e67f1809a48a497200e046d39ccc7112cd0" + ) + , + ( longTestString + , "a316d55510b49662420f49d145d42fb83f31ef8dc016aa4e32df049991a91e26" + ) ] sha512Vectors :: [(ByteString, Text)] sha512Vectors = - [ ( "" - , "cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d1\ - \3c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e") - , ( "abc" - , "ddaf35a193617abacc417349ae20413112e6fa4e89a97ea20a9eeee64b55d39a219299\ - \2a274fc1a836ba3c23a3feebbd454d4423643ce80e2a9ac94fa54ca49f") - , ( "message digest" - , "107dbf389d9e9f71a3a95f6c055b9251bc5268c2be16d6c13492ea45b0199f3309e164\ - \55ab1e96118e8a905d5597b72038ddb372a89826046de66687bb420e7c") - , ( "secure hash algorithm" - , "7746d91f3de30c68cec0dd693120a7e8b04d8073cb699bdce1a3f64127bca7a3d5db50\ - \2e814bb63c063a7a5043b2df87c61133395f4ad1edca7fcf4b30c3236e") - , ( "SHA512 is considered to be safe" - , "099e6468d889e1c79092a89ae925a9499b5408e01b66cb5b0a3bd0dfa51a99646b4a39\ - \01caab1318189f74cd8cf2e941829012f2449df52067d3dd5b978456c2") - , ( "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" - , "204a8fc6dda82f0a0ced7beb8e08a41657c16ef468b228a8279be331a703c33596fd15\ - \c13b1b07f9aa1d3bea57789ca031ad85c7a71dd70354ec631238ca3445") - , ( "For this sample, this 63-byte string will be used as input data" - , "b3de4afbc516d2478fe9b518d063bda6c8dd65fc38402dd81d1eb7364e72fb6e6663cf\ - \6d2771c8f5a6da09601712fb3d2a36c6ffea3e28b0818b05b0a8660766") - , ( "This is exactly 64 bytes long, not counting the terminating byte" - , "70aefeaa0e7ac4f8fe17532d7185a289bee3b428d950c14fa8b713ca09814a387d2458\ - \70e007a80ad97c369d193e41701aa07f3221d15f0e65a1ff970cedf030") - , ( "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmn\ - \opjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu" - , "8e959b75dae313da8cf4f72814fc143f8f7779c6eb9f7fa17299aeadb6889018501d28\ - \9e4900f7e4331b99dec4b5433ac7d329eeb6dd26545e96e55b874be909") - , ( C.replicate 1000000 'a' - , "e718483d0ce769644e2e42c7bc15b4638e1f98b13b2044285632a803afa973ebde0ff2\ - \44877ea60a4cb0432ce577c31beb009c5c2c49aa2e4eadb217ad8cc09b") - , ( longTestString - , "40cac46c147e6131c5193dd5f34e9d8bb4951395f27b08c558c65ff4ba2de59437de8c\ - \3ef5459d76a52cedc02dc499a3c9ed9dedbfb3281afd9653b8a112fafc") + [ + ( "" + , "cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d1\ + \3c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e" + ) + , + ( "abc" + , "ddaf35a193617abacc417349ae20413112e6fa4e89a97ea20a9eeee64b55d39a219299\ + \2a274fc1a836ba3c23a3feebbd454d4423643ce80e2a9ac94fa54ca49f" + ) + , + ( "message digest" + , "107dbf389d9e9f71a3a95f6c055b9251bc5268c2be16d6c13492ea45b0199f3309e164\ + \55ab1e96118e8a905d5597b72038ddb372a89826046de66687bb420e7c" + ) + , + ( "secure hash algorithm" + , "7746d91f3de30c68cec0dd693120a7e8b04d8073cb699bdce1a3f64127bca7a3d5db50\ + \2e814bb63c063a7a5043b2df87c61133395f4ad1edca7fcf4b30c3236e" + ) + , + ( "SHA512 is considered to be safe" + , "099e6468d889e1c79092a89ae925a9499b5408e01b66cb5b0a3bd0dfa51a99646b4a39\ + \01caab1318189f74cd8cf2e941829012f2449df52067d3dd5b978456c2" + ) + , + ( "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" + , "204a8fc6dda82f0a0ced7beb8e08a41657c16ef468b228a8279be331a703c33596fd15\ + \c13b1b07f9aa1d3bea57789ca031ad85c7a71dd70354ec631238ca3445" + ) + , + ( "For this sample, this 63-byte string will be used as input data" + , "b3de4afbc516d2478fe9b518d063bda6c8dd65fc38402dd81d1eb7364e72fb6e6663cf\ + \6d2771c8f5a6da09601712fb3d2a36c6ffea3e28b0818b05b0a8660766" + ) + , + ( "This is exactly 64 bytes long, not counting the terminating byte" + , "70aefeaa0e7ac4f8fe17532d7185a289bee3b428d950c14fa8b713ca09814a387d2458\ + \70e007a80ad97c369d193e41701aa07f3221d15f0e65a1ff970cedf030" + ) + , + ( "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmn\ + \opjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu" + , "8e959b75dae313da8cf4f72814fc143f8f7779c6eb9f7fa17299aeadb6889018501d28\ + \9e4900f7e4331b99dec4b5433ac7d329eeb6dd26545e96e55b874be909" + ) + , + ( C.replicate 1000000 'a' + , "e718483d0ce769644e2e42c7bc15b4638e1f98b13b2044285632a803afa973ebde0ff2\ + \44877ea60a4cb0432ce577c31beb009c5c2c49aa2e4eadb217ad8cc09b" + ) + , + ( longTestString + , "40cac46c147e6131c5193dd5f34e9d8bb4951395f27b08c558c65ff4ba2de59437de8c\ + \3ef5459d76a52cedc02dc499a3c9ed9dedbfb3281afd9653b8a112fafc" + ) ] -- test cases 1, 2, 3, 4, 6 and 7 of RFC 4231 hmacSha256Vectors :: [(Text, Text, Text)] hmacSha256Vectors = - [ ( "0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b" - , "4869205468657265" - , "b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7") - , ( "4a656665" - , "7768617420646f2079612077616e7420666f72206e6f7468696e673f" - , "5bdcc146bf60754e6a042426089575c75a003f089d2739839dec58b964ec3843") - , ( "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" - , "dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd\ - \dddddddddddddddddddddddddddddd" - , "773ea91e36800e46854db8ebd09181a72959098b3ef8c122d9635514ced565fe") - , ( "0102030405060708090a0b0c0d0e0f10111213141516171819" - , "cdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcd\ - \cdcdcdcdcdcdcdcdcdcdcdcdcdcdcd" - , "82558a389a443c0ea4cc819899f2083a85f0faa3e578f8077a2e3ff46729665b") - , ( "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ - \aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ - \aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ - \aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" - , "54657374205573696e67204c6172676572205468616e20426c6f636b2d53697a65204b\ - \6579202d2048617368204b6579204669727374" - , "60e431591ee0b67f0d8a26aacbf5b77f8e0bc6213728c5140546040f0ee37f54") - , ( "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ - \aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ - \aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ - \aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" - , "5468697320697320612074657374207573696e672061206c6172676572207468616e20\ - \626c6f636b2d73697a65206b657920616e642061206c6172676572207468616e20626c\ - \6f636b2d73697a6520646174612e20546865206b6579206e6565647320746f20626520\ - \686173686564206265666f7265206265696e6720757365642062792074686520484d41\ - \4320616c676f726974686d2e" - , "9b09ffa71b942fcb27635fbcd5b0e944bfdc63644f0713938a7f51535c3a35e2") - -- Test case with key length 63 bytes. - , ( "4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a6566654a6566\ - \654a6566654a6566654a6566654a6566654a6566654a6566654a6566" - , "7768617420646f2079612077616e7420666f72206e6f7468696e673f" - , "9de4b546756c83516720a4ad7fe7bdbeac4298c6fdd82b15f895a6d10b0769a6") - -- Test case with key length 64 bytes. - , ( "4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a6566654a6566\ - \654a6566654a6566654a6566654a6566654a6566654a6566654a656665" - , "7768617420646f2079612077616e7420666f72206e6f7468696e673f" - , "528c609a4c9254c274585334946b7c2661bad8f1fc406b20f6892478d19163dd") - -- Test case with key length 65 bytes. - , ( "4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a6566654a6566\ - \654a6566654a6566654a6566654a6566654a6566654a6566654a6566654a" - , "7768617420646f2079612077616e7420666f72206e6f7468696e673f" - , "d06af337f359a2330deffb8e3cbe4b5b7aa8ca1f208528cdbd245d5dc63c4483") + [ + ( "0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b" + , "4869205468657265" + , "b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7" + ) + , + ( "4a656665" + , "7768617420646f2079612077616e7420666f72206e6f7468696e673f" + , "5bdcc146bf60754e6a042426089575c75a003f089d2739839dec58b964ec3843" + ) + , + ( "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + , "dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd\ + \dddddddddddddddddddddddddddddd" + , "773ea91e36800e46854db8ebd09181a72959098b3ef8c122d9635514ced565fe" + ) + , + ( "0102030405060708090a0b0c0d0e0f10111213141516171819" + , "cdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcd\ + \cdcdcdcdcdcdcdcdcdcdcdcdcdcdcd" + , "82558a389a443c0ea4cc819899f2083a85f0faa3e578f8077a2e3ff46729665b" + ) + , + ( "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ + \aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ + \aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ + \aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + , "54657374205573696e67204c6172676572205468616e20426c6f636b2d53697a65204b\ + \6579202d2048617368204b6579204669727374" + , "60e431591ee0b67f0d8a26aacbf5b77f8e0bc6213728c5140546040f0ee37f54" + ) + , + ( "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ + \aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ + \aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ + \aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + , "5468697320697320612074657374207573696e672061206c6172676572207468616e20\ + \626c6f636b2d73697a65206b657920616e642061206c6172676572207468616e20626c\ + \6f636b2d73697a6520646174612e20546865206b6579206e6565647320746f20626520\ + \686173686564206265666f7265206265696e6720757365642062792074686520484d41\ + \4320616c676f726974686d2e" + , "9b09ffa71b942fcb27635fbcd5b0e944bfdc63644f0713938a7f51535c3a35e2" + ) + , -- Test case with key length 63 bytes. + + ( "4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a6566654a6566\ + \654a6566654a6566654a6566654a6566654a6566654a6566654a6566" + , "7768617420646f2079612077616e7420666f72206e6f7468696e673f" + , "9de4b546756c83516720a4ad7fe7bdbeac4298c6fdd82b15f895a6d10b0769a6" + ) + , -- Test case with key length 64 bytes. + + ( "4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a6566654a6566\ + \654a6566654a6566654a6566654a6566654a6566654a6566654a656665" + , "7768617420646f2079612077616e7420666f72206e6f7468696e673f" + , "528c609a4c9254c274585334946b7c2661bad8f1fc406b20f6892478d19163dd" + ) + , -- Test case with key length 65 bytes. + + ( "4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a6566654a6566\ + \654a6566654a6566654a6566654a6566654a6566654a6566654a6566654a" + , "7768617420646f2079612077616e7420666f72206e6f7468696e673f" + , "d06af337f359a2330deffb8e3cbe4b5b7aa8ca1f208528cdbd245d5dc63c4483" + ) ] -- test cases 1, 2, 3, 4, 6 and 7 of RFC 4231 hmacSha512Vectors :: [(Text, Text, Text)] hmacSha512Vectors = - [ ( "0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b" - , "4869205468657265" - , "87aa7cdea5ef619d4ff0b4241a1d6cb02379f4e2ce4ec2787ad0b30545e17cde\ - \daa833b7d6b8a702038b274eaea3f4e4be9d914eeb61f1702e696c203a126854") - , ( "4a656665" - , "7768617420646f2079612077616e7420666f72206e6f7468696e673f" - , "164b7a7bfcf819e2e395fbe73b56e0a387bd64222e831fd610270cd7ea250554\ - \9758bf75c05a994a6d034f65f8f0e6fdcaeab1a34d4a6b4b636e070a38bce737") - , ( "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" - , "dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd\ - \dddddddddddddddddddddddddddddddddddd" - , "fa73b0089d56a284efb0f0756c890be9b1b5dbdd8ee81a3655f83e33b2279d39\ - \bf3e848279a722c806b485a47e67c807b946a337bee8942674278859e13292fb") - , ( "0102030405060708090a0b0c0d0e0f10111213141516171819" - , "cdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcd\ - \cdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcd" - , "b0ba465637458c6990e5a8c5f61d4af7e576d97ff94b872de76f8050361ee3db\ - \a91ca5c11aa25eb4d679275cc5788063a5f19741120c4f2de2adebeb10a298dd") - , ( "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ - \aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ - \aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ - \aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ - \aaaaaa" - , "54657374205573696e67204c6172676572205468616e20426c6f636b2d53697a\ - \65204b6579202d2048617368204b6579204669727374" - , "80b24263c7c1a3ebb71493c1dd7be8b49b46d1f41b4aeec1121b013783f8f352\ - \6b56d037e05f2598bd0fd2215d6a1e5295e64f73f63f0aec8b915a985d786598") - , ( "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ - \aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ - \aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ - \aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ - \aaaaaa" - , "5468697320697320612074657374207573696e672061206c6172676572207468\ - \616e20626c6f636b2d73697a65206b657920616e642061206c61726765722074\ - \68616e20626c6f636b2d73697a6520646174612e20546865206b6579206e6565\ - \647320746f20626520686173686564206265666f7265206265696e6720757365\ - \642062792074686520484d414320616c676f726974686d2e" - , "e37b6a775dc87dbaa4dfa9f96e5e3ffddebd71f8867289865df5a32d20cdc944\ - \b6022cac3c4982b10d5eeb55c3e4de15134676fb6de0446065c97440fa8c6a58") - -- Test case with key length 127 bytes. - , ( "4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a656665\ - \4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a656665\ - \4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a656665\ - \4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a6566" - , "7768617420646f2079612077616e7420666f72206e6f7468696e673f" - , "267424dfb8eeb999f3e5ec39a4fe9fd14c923e6187e0897063e5c9e02b2e624a\ - \c04413e762977df71a9fb5d562b37f89dfdfb930fce2ed1fa783bbc2a203d80e") - -- Test case with key length 128 bytes. - , ( "4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a656665\ - \4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a656665\ - \4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a656665\ - \4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a656665" - , "7768617420646f2079612077616e7420666f72206e6f7468696e673f" - , "43aaac07bb1dd97c82c04df921f83b16a68d76815cd1a30d3455ad43a3d80484\ - \2bb35462be42cc2e4b5902de4d204c1c66d93b47d1383e3e13a3788687d61258") - -- Test case with key length 129 bytes. - , ( "4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a656665\ - \4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a656665\ - \4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a656665\ - \4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a656665\ - \4a" - , "7768617420646f2079612077616e7420666f72206e6f7468696e673f" - , "0b273325191cfc1b4b71d5075c8fcad67696309d292b1dad2cd23983a35feb8e\ - \fb29795e79f2ef27f68cb1e16d76178c307a67beaad9456fac5fdffeadb16e2c") + [ + ( "0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b" + , "4869205468657265" + , "87aa7cdea5ef619d4ff0b4241a1d6cb02379f4e2ce4ec2787ad0b30545e17cde\ + \daa833b7d6b8a702038b274eaea3f4e4be9d914eeb61f1702e696c203a126854" + ) + , + ( "4a656665" + , "7768617420646f2079612077616e7420666f72206e6f7468696e673f" + , "164b7a7bfcf819e2e395fbe73b56e0a387bd64222e831fd610270cd7ea250554\ + \9758bf75c05a994a6d034f65f8f0e6fdcaeab1a34d4a6b4b636e070a38bce737" + ) + , + ( "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + , "dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd\ + \dddddddddddddddddddddddddddddddddddd" + , "fa73b0089d56a284efb0f0756c890be9b1b5dbdd8ee81a3655f83e33b2279d39\ + \bf3e848279a722c806b485a47e67c807b946a337bee8942674278859e13292fb" + ) + , + ( "0102030405060708090a0b0c0d0e0f10111213141516171819" + , "cdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcd\ + \cdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcd" + , "b0ba465637458c6990e5a8c5f61d4af7e576d97ff94b872de76f8050361ee3db\ + \a91ca5c11aa25eb4d679275cc5788063a5f19741120c4f2de2adebeb10a298dd" + ) + , + ( "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ + \aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ + \aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ + \aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ + \aaaaaa" + , "54657374205573696e67204c6172676572205468616e20426c6f636b2d53697a\ + \65204b6579202d2048617368204b6579204669727374" + , "80b24263c7c1a3ebb71493c1dd7be8b49b46d1f41b4aeec1121b013783f8f352\ + \6b56d037e05f2598bd0fd2215d6a1e5295e64f73f63f0aec8b915a985d786598" + ) + , + ( "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ + \aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ + \aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ + \aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\ + \aaaaaa" + , "5468697320697320612074657374207573696e672061206c6172676572207468\ + \616e20626c6f636b2d73697a65206b657920616e642061206c61726765722074\ + \68616e20626c6f636b2d73697a6520646174612e20546865206b6579206e6565\ + \647320746f20626520686173686564206265666f7265206265696e6720757365\ + \642062792074686520484d414320616c676f726974686d2e" + , "e37b6a775dc87dbaa4dfa9f96e5e3ffddebd71f8867289865df5a32d20cdc944\ + \b6022cac3c4982b10d5eeb55c3e4de15134676fb6de0446065c97440fa8c6a58" + ) + , -- Test case with key length 127 bytes. + + ( "4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a656665\ + \4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a656665\ + \4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a656665\ + \4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a6566" + , "7768617420646f2079612077616e7420666f72206e6f7468696e673f" + , "267424dfb8eeb999f3e5ec39a4fe9fd14c923e6187e0897063e5c9e02b2e624a\ + \c04413e762977df71a9fb5d562b37f89dfdfb930fce2ed1fa783bbc2a203d80e" + ) + , -- Test case with key length 128 bytes. + + ( "4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a656665\ + \4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a656665\ + \4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a656665\ + \4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a656665" + , "7768617420646f2079612077616e7420666f72206e6f7468696e673f" + , "43aaac07bb1dd97c82c04df921f83b16a68d76815cd1a30d3455ad43a3d80484\ + \2bb35462be42cc2e4b5902de4d204c1c66d93b47d1383e3e13a3788687d61258" + ) + , -- Test case with key length 129 bytes. + + ( "4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a656665\ + \4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a656665\ + \4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a656665\ + \4a6566654a6566654a6566654a6566654a6566654a6566654a6566654a656665\ + \4a" + , "7768617420646f2079612077616e7420666f72206e6f7468696e673f" + , "0b273325191cfc1b4b71d5075c8fcad67696309d292b1dad2cd23983a35feb8e\ + \fb29795e79f2ef27f68cb1e16d76178c307a67beaad9456fac5fdffeadb16e2c" + ) ] diff --git a/test/Haskoin/Crypto/SignatureSpec.hs b/test/Haskoin/Crypto/SignatureSpec.hs --- a/test/Haskoin/Crypto/SignatureSpec.hs +++ b/test/Haskoin/Crypto/SignatureSpec.hs @@ -1,29 +1,30 @@ {-# LANGUAGE OverloadedStrings #-} + module Haskoin.Crypto.SignatureSpec (spec) where -import Control.Monad -import Data.Bits (testBit) -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import Data.Map.Strict (Map) -import qualified Data.Map.Strict as Map -import Data.Maybe -import Data.Serialize as S -import Data.String.Conversions (cs) -import Data.Text (Text) -import Haskoin.Address -import Haskoin.Transaction -import Haskoin.Keys -import Haskoin.Crypto -import Haskoin.Script -import Haskoin.Constants -import Haskoin.Util -import Haskoin.Util.Arbitrary -import Haskoin.UtilSpec (readTestFile) -import Test.Hspec -import Test.Hspec.QuickCheck -import Test.HUnit -import Test.QuickCheck +import Control.Monad +import Data.Bits (testBit) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Maybe +import Data.Serialize as S +import Data.String.Conversions (cs) +import Data.Text (Text) +import Haskoin.Address +import Haskoin.Constants +import Haskoin.Crypto +import Haskoin.Keys +import Haskoin.Script +import Haskoin.Transaction +import Haskoin.Util +import Haskoin.Util.Arbitrary +import Haskoin.UtilSpec (readTestFile) +import Test.HUnit +import Test.Hspec +import Test.Hspec.QuickCheck +import Test.QuickCheck spec :: Spec spec = do @@ -37,13 +38,13 @@ forAll arbitrarySignature $ testIsCanonical . lst3 prop "decodeStrictSig . exportSig identity" $ forAll arbitrarySignature $ - (\s -> decodeStrictSig (exportSig s) == Just s) . lst3 + (\s -> decodeStrictSig (exportSig s) == Just s) . lst3 prop "importSig . exportSig identity" $ forAll arbitrarySignature $ - (\s -> importSig (exportSig s) == Just s) . lst3 + (\s -> importSig (exportSig s) == Just s) . lst3 prop "getSig . putSig identity" $ forAll arbitrarySignature $ - (\s -> runGet getSig (runPut $ putSig s) == Right s) . lst3 + (\s -> runGet getSig (runPut $ putSig s) == Right s) . lst3 describe "Signature vectors" $ checkDistSig $ \file1 file2 -> do vectors <- runIO (readTestFile file1 :: IO [(Text, Text, Text)]) @@ -61,42 +62,55 @@ -- github.com/bitcoin/bitcoin/blob/master/src/script.cpp -- from function IsCanonicalSignature testIsCanonical :: Sig -> Bool -testIsCanonical sig = not $ - -- Non-canonical signature: too short - (len < 8) || - -- Non-canonical signature: too long - (len > 72) || - -- Non-canonical signature: wrong type - (BS.index s 0 /= 0x30) || - -- Non-canonical signature: wrong length marker - (BS.index s 1 /= len - 2) || - -- Non-canonical signature: S length misplaced - (5 + rlen >= len) || - -- Non-canonical signature: R+S length mismatch - (rlen + slen + 6 /= len) || - -- Non-canonical signature: R value type mismatch - (BS.index s 2 /= 0x02) || - - -- Non-canonical signature: R length is zero - (rlen == 0) || - -- Non-canonical signature: R value negative - testBit (BS.index s 4) 7 || - -- Non-canonical signature: R value excessively padded - ( rlen > 1 - && BS.index s 4 == 0 - && not (testBit (BS.index s 5) 7) - ) || - -- Non-canonical signature: S value type mismatch - (BS.index s (fromIntegral rlen + 4) /= 0x02) || - -- Non-canonical signature: S length is zero - (slen == 0) || - -- Non-canonical signature: S value negative - testBit (BS.index s (fromIntegral rlen+6)) 7 || - -- Non-canonical signature: S value excessively padded - ( slen > 1 - && BS.index s (fromIntegral rlen + 6) == 0 - && not (testBit (BS.index s (fromIntegral rlen + 7)) 7) - ) +testIsCanonical sig = + not $ + -- Non-canonical signature: too short + (len < 8) + || + -- Non-canonical signature: too long + (len > 72) + || + -- Non-canonical signature: wrong type + (BS.index s 0 /= 0x30) + || + -- Non-canonical signature: wrong length marker + (BS.index s 1 /= len - 2) + || + -- Non-canonical signature: S length misplaced + (5 + rlen >= len) + || + -- Non-canonical signature: R+S length mismatch + (rlen + slen + 6 /= len) + || + -- Non-canonical signature: R value type mismatch + (BS.index s 2 /= 0x02) + || + -- Non-canonical signature: R length is zero + (rlen == 0) + || + -- Non-canonical signature: R value negative + testBit (BS.index s 4) 7 + || + -- Non-canonical signature: R value excessively padded + ( rlen > 1 + && BS.index s 4 == 0 + && not (testBit (BS.index s 5) 7) + ) + || + -- Non-canonical signature: S value type mismatch + (BS.index s (fromIntegral rlen + 4) /= 0x02) + || + -- Non-canonical signature: S length is zero + (slen == 0) + || + -- Non-canonical signature: S value negative + testBit (BS.index s (fromIntegral rlen + 6)) 7 + || + -- Non-canonical signature: S value excessively padded + ( slen > 1 + && BS.index s (fromIntegral rlen + 6) == 0 + && not (testBit (BS.index s (fromIntegral rlen + 7)) 7) + ) where s = exportSig sig len = fromIntegral $ BS.length s @@ -115,23 +129,27 @@ implSig :: Text implSig = encodeHex $ - exportSig $ - signMsg - "0000000000000000000000000000000000000000000000000000000000000001" - "0000000000000000000000000000000000000000000000000000000000000000" + exportSig $ + signMsg + "0000000000000000000000000000000000000000000000000000000000000001" + "0000000000000000000000000000000000000000000000000000000000000000" -- We have test vectors for these cases validImplMap :: Map Text ValidImpl validImplMap = Map.fromList - [ ( "3045022100a0b37f8fba683cc68f6574cd43b39f0343a50008bf6ccea9d13231\ - \d9e7e2e1e4022011edc8d307254296264aebfc3dc76cd8b668373a072fd64665\ - \b50000e9fcce52" - , ImplCore) - , ( "304402200581361d23e645be9e3efe63a9a2ac2e8dd0c70ba3ac8554c9befe06\ - \0ad0b36202207d8172f1e259395834793d81b17e986f1e6131e4734969d2f4ae\ - \3a9c8bc42965" - , ImplABC) + [ + ( "3045022100a0b37f8fba683cc68f6574cd43b39f0343a50008bf6ccea9d13231\ + \d9e7e2e1e4022011edc8d307254296264aebfc3dc76cd8b668373a072fd64665\ + \b50000e9fcce52" + , ImplCore + ) + , + ( "304402200581361d23e645be9e3efe63a9a2ac2e8dd0c70ba3ac8554c9befe06\ + \0ad0b36202207d8172f1e259395834793d81b17e986f1e6131e4734969d2f4ae\ + \3a9c8bc42965" + , ImplABC + ) ] getImpl :: Maybe ValidImpl @@ -147,7 +165,7 @@ Just (file1, file2) -> go file1 file2 _ -> it "Passes rfc6979 test vectors" $ - void $ assertFailure "Invalid rfc6979 signature" + void $ assertFailure "Invalid rfc6979 signature" {- Trezor RFC 6979 Test Vectors -} -- github.com/trezor/python-ecdsa/blob/master/ecdsa/test_pyecdsa.py diff --git a/test/Haskoin/Keys/ExtendedSpec.hs b/test/Haskoin/Keys/ExtendedSpec.hs --- a/test/Haskoin/Keys/ExtendedSpec.hs +++ b/test/Haskoin/Keys/ExtendedSpec.hs @@ -1,30 +1,31 @@ -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} + module Haskoin.Keys.ExtendedSpec (spec) where -import Control.Monad (forM_) -import Data.Aeson as A -import Data.Bits ((.&.)) +import Control.Monad (forM_) +import Data.Aeson as A +import Data.Bits ((.&.)) import qualified Data.ByteString.Lazy.Char8 as B8 -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import Data.Either (isLeft) -import Data.Maybe (fromJust, isJust, isNothing) -import Data.String (fromString) -import Data.String.Conversions (cs) -import Data.Text (Text) -import Data.Word (Word32) -import Haskoin.Address -import Haskoin.Constants -import Haskoin.Keys -import Haskoin.Util -import Haskoin.Util.Arbitrary -import Haskoin.UtilSpec (customCerealID) -import Test.HUnit (Assertion, assertBool, assertEqual) -import Test.Hspec -import Test.Hspec.QuickCheck -import Test.QuickCheck hiding ((.&.)) +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.Either (isLeft) +import Data.Maybe (fromJust, isJust, isNothing) +import Data.String (fromString) +import Data.String.Conversions (cs) +import Data.Text (Text) +import Data.Word (Word32) +import Haskoin.Address +import Haskoin.Constants +import Haskoin.Keys +import Haskoin.Util +import Haskoin.Util.Arbitrary +import Haskoin.UtilSpec (customCerealID) +import Test.HUnit (Assertion, assertBool, assertEqual) +import Test.Hspec +import Test.Hspec.QuickCheck +import Test.QuickCheck hiding ((.&.)) serialVals :: [SerialBox] serialVals = @@ -55,15 +56,17 @@ netVals :: [NetBox] netVals = [ NetBox - ( xPrvToJSON - , xPrvToEncoding - , xPrvFromJSON - , genNetData arbitraryXPrvKey) + ( xPrvToJSON + , xPrvToEncoding + , xPrvFromJSON + , genNetData arbitraryXPrvKey + ) , NetBox - ( xPubToJSON - , xPubToEncoding - , xPubFromJSON - , genNetData (snd <$> arbitraryXPubKey)) + ( xPubToJSON + , xPubToEncoding + , xPubFromJSON + , genNetData (snd <$> arbitraryXPubKey) + ) ] spec :: Spec @@ -73,11 +76,11 @@ prop "encodes and decodes extended private key" $ forAll arbitraryNetwork $ \net -> forAll arbitraryXPrvKey $ - customCerealID (getXPrvKey net) (putXPrvKey net) + customCerealID (getXPrvKey net) (putXPrvKey net) prop "encodes and decodes extended public key" $ forAll arbitraryNetwork $ \net -> forAll arbitraryXPubKey $ - customCerealID (getXPubKey net) (putXPubKey net) . snd + customCerealID (getXPubKey net) (putXPubKey net) . snd describe "bip32 subkey derivation vector 1" $ vectorSpec m1 vector1 describe "bip32 subkey derivation vector 2" $ vectorSpec m2 vector2 describe "bip32 subkey derivation vector 3" $ vectorSpec m3 vector3 @@ -203,7 +206,7 @@ (key, path, final) <- derivePubPathVectors return $ assertEqual path final $ - derivePubPath (fromString path :: SoftPath) key + derivePubPath (fromString path :: SoftPath) key testDerivePrvPath :: Assertion testDerivePrvPath = @@ -211,76 +214,101 @@ (key, path, final) <- derivePrvPathVectors return $ assertEqual path final $ - derivePath (fromString path :: DerivPath) key + derivePath (fromString path :: DerivPath) key derivePubPathVectors :: [(XPubKey, String, XPubKey)] derivePubPathVectors = - [ ( xpub, "M", xpub ) - , ( xpub, "M/8", pubSubKey xpub 8 ) - , ( xpub, "M/8/30/1", foldl pubSubKey xpub [8,30,1] ) + [ (xpub, "M", xpub) + , (xpub, "M/8", pubSubKey xpub 8) + , (xpub, "M/8/30/1", foldl pubSubKey xpub [8, 30, 1]) ] where - xprv = fromJust $ xPrvImport btc - "xprv9s21ZrQH143K46iDVRSyFfGfMgQjzC4BV3ZUfNbG7PHQrJjE53ofAn5gYkp6KQ\ - \WzGmb8oageSRxBY8s4rjr9VXPVp2HQDbwPt4H31Gg4LpB" + xprv = + fromJust $ + xPrvImport + btc + "xprv9s21ZrQH143K46iDVRSyFfGfMgQjzC4BV3ZUfNbG7PHQrJjE53ofAn5gYkp6KQ\ + \WzGmb8oageSRxBY8s4rjr9VXPVp2HQDbwPt4H31Gg4LpB" xpub = deriveXPubKey xprv derivePrvPathVectors :: [(XPrvKey, String, XPrvKey)] derivePrvPathVectors = - [ ( xprv, "m", xprv ) - , ( xprv, "M", xprv ) - , ( xprv, "m/8'", hardSubKey xprv 8 ) - , ( xprv, "M/8'", hardSubKey xprv 8 ) - , ( xprv, "m/8'/30/1" - , foldl prvSubKey (hardSubKey xprv 8) [30,1] - ) - , ( xprv, "M/8'/30/1" - , foldl prvSubKey (hardSubKey xprv 8) [30,1] - ) - , ( xprv, "m/3/20" - , foldl prvSubKey xprv [3,20] - ) - , ( xprv, "M/3/20" - , foldl prvSubKey xprv [3,20] - ) + [ (xprv, "m", xprv) + , (xprv, "M", xprv) + , (xprv, "m/8'", hardSubKey xprv 8) + , (xprv, "M/8'", hardSubKey xprv 8) + , + ( xprv + , "m/8'/30/1" + , foldl prvSubKey (hardSubKey xprv 8) [30, 1] + ) + , + ( xprv + , "M/8'/30/1" + , foldl prvSubKey (hardSubKey xprv 8) [30, 1] + ) + , + ( xprv + , "m/3/20" + , foldl prvSubKey xprv [3, 20] + ) + , + ( xprv + , "M/3/20" + , foldl prvSubKey xprv [3, 20] + ) ] where - xprv = fromJust $ xPrvImport btc - "xprv9s21ZrQH143K46iDVRSyFfGfMgQjzC4BV3ZUfNbG7PHQrJjE53ofAn5gYkp6KQ\ - \WzGmb8oageSRxBY8s4rjr9VXPVp2HQDbwPt4H31Gg4LpB" + xprv = + fromJust $ + xPrvImport + btc + "xprv9s21ZrQH143K46iDVRSyFfGfMgQjzC4BV3ZUfNbG7PHQrJjE53ofAn5gYkp6KQ\ + \WzGmb8oageSRxBY8s4rjr9VXPVp2HQDbwPt4H31Gg4LpB" applyPathVectors :: [(XKey, String, Either String XKey)] applyPathVectors = [ (XPrv xprv btc, "m", Right (XPrv xprv btc)) , (XPrv xprv btc, "M", Right (XPub xpub btc)) , (XPrv xprv btc, "m/8'", Right (XPrv (hardSubKey xprv 8) btc)) - , ( XPrv xprv btc - , "M/8'" - , Right (XPub (deriveXPubKey (hardSubKey xprv 8)) btc)) - , ( XPrv xprv btc - , "m/8'/30/1" - , Right (XPrv (foldl prvSubKey (hardSubKey xprv 8) [30, 1]) btc)) - , ( XPrv xprv btc - , "M/8'/30/1" - , Right - (XPub - (deriveXPubKey (foldl prvSubKey (hardSubKey xprv 8) [30, 1])) - btc)) + , + ( XPrv xprv btc + , "M/8'" + , Right (XPub (deriveXPubKey (hardSubKey xprv 8)) btc) + ) + , + ( XPrv xprv btc + , "m/8'/30/1" + , Right (XPrv (foldl prvSubKey (hardSubKey xprv 8) [30, 1]) btc) + ) + , + ( XPrv xprv btc + , "M/8'/30/1" + , Right + ( XPub + (deriveXPubKey (foldl prvSubKey (hardSubKey xprv 8) [30, 1])) + btc + ) + ) , (XPrv xprv btc, "m/3/20", Right (XPrv (foldl prvSubKey xprv [3, 20]) btc)) - , ( XPrv xprv btc - , "M/3/20" - , Right (XPub (deriveXPubKey (foldl prvSubKey xprv [3, 20])) btc)) - , ( XPub xpub btc - , "M/3/20" - , Right (XPub (deriveXPubKey (foldl prvSubKey xprv [3, 20])) btc)) + , + ( XPrv xprv btc + , "M/3/20" + , Right (XPub (deriveXPubKey (foldl prvSubKey xprv [3, 20])) btc) + ) + , + ( XPub xpub btc + , "M/3/20" + , Right (XPub (deriveXPubKey (foldl prvSubKey xprv [3, 20])) btc) + ) ] where xprv = fromJust $ - xPrvImport - btc - "xprv9s21ZrQH143K46iDVRSyFfGfMgQjzC4BV3ZUfNbG7PHQrJjE53ofAn5gYkp6KQ\ - \WzGmb8oageSRxBY8s4rjr9VXPVp2HQDbwPt4H31Gg4LpB" + xPrvImport + btc + "xprv9s21ZrQH143K46iDVRSyFfGfMgQjzC4BV3ZUfNbG7PHQrJjE53ofAn5gYkp6KQ\ + \WzGmb8oageSRxBY8s4rjr9VXPVp2HQDbwPt4H31Gg4LpB" xpub = deriveXPubKey xprv badApplyPathVectors :: [(XKey, String)] @@ -292,10 +320,10 @@ where xprv = fromJust $ - xPrvImport - btc - "xprv9s21ZrQH143K46iDVRSyFfGfMgQjzC4BV3ZUfNbG7PHQrJjE53ofAn5gYkp6KQ\ - \WzGmb8oageSRxBY8s4rjr9VXPVp2HQDbwPt4H31Gg4LpB" + xPrvImport + btc + "xprv9s21ZrQH143K46iDVRSyFfGfMgQjzC4BV3ZUfNbG7PHQrJjE53ofAn5gYkp6KQ\ + \WzGmb8oageSRxBY8s4rjr9VXPVp2HQDbwPt4H31Gg4LpB" xpub = deriveXPubKey xprv -- BIP 0032 Test Vectors @@ -306,7 +334,7 @@ vectorSpec :: TestKey -> [TestVector] -> Spec vectorSpec mTxt vecTxt = - forM_ (parseVector mTxt vecTxt) $ \(d,m,v) -> + forM_ (parseVector mTxt vecTxt) $ \(d, m, v) -> it ("chain " <> cs d) $ runVector m v runVector :: XPrvKey -> TestVector -> Assertion @@ -316,8 +344,8 @@ assertBool "xPrvAddr" $ addrToText btc (xPubAddr $ deriveXPubKey m) == Just (v !! 2) assertBool "bip44Addr" $ - addrToText btc (xPubAddr $ deriveXPubKey $ derivePath bip44Addr m) == - Just (v !! 3) + addrToText btc (xPubAddr $ deriveXPubKey $ derivePath bip44Addr m) + == Just (v !! 3) assertBool "prvKey" $ encodeHex (getSecKey $ xPrvKey m) == v !! 4 assertBool "xPrvWIF" $ xPrvWif btc m == v !! 5 assertBool "pubKey" $ @@ -335,9 +363,11 @@ [ ("xPrvID", encodeHex (runPutS . serialize $ xPrvID m)) , ("xPrvFP", encodeHex (runPutS . serialize $ xPrvFP m)) , ("xPrvAddr", fromJust $ addrToText btc (xPubAddr $ deriveXPubKey m)) - , ( "bip44Addr" - , fromJust $ - addrToText btc (xPubAddr $ deriveXPubKey $ derivePath bip44Addr m)) + , + ( "bip44Addr" + , fromJust $ + addrToText btc (xPubAddr $ deriveXPubKey $ derivePath bip44Addr m) + ) , ("prvKey", encodeHex (getSecKey $ xPrvKey m)) , ("xPrvWIF", xPrvWif btc m) , ("pubKey", encodeHex (exportPubKey True $ xPubKey $ deriveXPubKey m)) @@ -351,7 +381,7 @@ go <$> vs where mast = makeXPrvKey $ fromJust $ decodeHex mTxt - go (d:vec) = + go (d : vec) = let deriv = getParsedPath $ fromJust $ parsePath $ cs d in (d, derivePath deriv mast, vec) go _ = undefined @@ -365,90 +395,95 @@ vector1 :: [TestVector] vector1 = [ - [ "m" - , "3442193e1bb70916e914552172cd4e2dbc9df811" - , "3442193e" - , "15mKKb2eos1hWa6tisdPwwDC1a5J1y9nma" - , "1NQpH6Nf8QtR2HphLRcvuVqfhXBXsiWn8r" - , "e8f32e723decf4051aefac8e2c93c9c5b214313817cdb01a1494b917c8436b35" - , "L52XzL2cMkHxqxBXRyEpnPQZGUs3uKiL3R11XbAdHigRzDozKZeW" - , "0339a36013301597daef41fbe593a02cc513d0b55527ec2df1050e2e8ff49c85c2" - , "873dff81c02f525623fd1fe5167eac3a55a049de3d314bb42ee227ffed37d508" - , "0488b21e000000000000000000873dff81c02f525623fd1fe5167eac3a55a049de3d314bb42ee227ffed37d5080339a36013301597daef41fbe593a02cc513d0b55527ec2df1050e2e8ff49c85c2" - , "0488ade4000000000000000000873dff81c02f525623fd1fe5167eac3a55a049de3d314bb42ee227ffed37d50800e8f32e723decf4051aefac8e2c93c9c5b214313817cdb01a1494b917c8436b35" - , "xpub661MyMwAqRbcFtXgS5sYJABqqG9YLmC4Q1Rdap9gSE8NqtwybGhePY2gZ29ESFjqJoCu1Rupje8YtGqsefD265TMg7usUDFdp6W1EGMcet8" - , "xprv9s21ZrQH143K3QTDL4LXw2F7HEK3wJUD2nW2nRk4stbPy6cq3jPPqjiChkVvvNKmPGJxWUtg6LnF5kejMRNNU3TGtRBeJgk33yuGBxrMPHi" - ] - , [ "m/0'" - , "5c1bd648ed23aa5fd50ba52b2457c11e9e80a6a7" - , "5c1bd648" - , "19Q2WoS5hSS6T8GjhK8KZLMgmWaq4neXrh" - , "1DDVw6BRKUv9U8Hzg5rGsia13nDrgJQpBd" - , "edb2e14f9ee77d26dd93b4ecede8d16ed408ce149b6cd80b0715a2d911a0afea" - , "L5BmPijJjrKbiUfG4zbiFKNqkvuJ8usooJmzuD7Z8dkRoTThYnAT" - , "035a784662a4a20a65bf6aab9ae98a6c068a81c52e4b032c0fb5400c706cfccc56" - , "47fdacbd0f1097043b78c63c20c34ef4ed9a111d980047ad16282c7ae6236141" - , "0488b21e013442193e8000000047fdacbd0f1097043b78c63c20c34ef4ed9a111d980047ad16282c7ae6236141035a784662a4a20a65bf6aab9ae98a6c068a81c52e4b032c0fb5400c706cfccc56" - , "0488ade4013442193e8000000047fdacbd0f1097043b78c63c20c34ef4ed9a111d980047ad16282c7ae623614100edb2e14f9ee77d26dd93b4ecede8d16ed408ce149b6cd80b0715a2d911a0afea" - , "xpub68Gmy5EdvgibQVfPdqkBBCHxA5htiqg55crXYuXoQRKfDBFA1WEjWgP6LHhwBZeNK1VTsfTFUHCdrfp1bgwQ9xv5ski8PX9rL2dZXvgGDnw" - , "xprv9uHRZZhk6KAJC1avXpDAp4MDc3sQKNxDiPvvkX8Br5ngLNv1TxvUxt4cV1rGL5hj6KCesnDYUhd7oWgT11eZG7XnxHrnYeSvkzY7d2bhkJ7" - ] - , [ "m/0'/1" - , "bef5a2f9a56a94aab12459f72ad9cf8cf19c7bbe" - , "bef5a2f9" - , "1JQheacLPdM5ySCkrZkV66G2ApAXe1mqLj" - , "1KMg6dRggXSkpz9fFyU76ru83TUSwPePEZ" - , "3c6cb8d0f6a264c91ea8b5030fadaa8e538b020f0a387421a12de9319dc93368" - , "KyFAjQ5rgrKvhXvNMtFB5PCSKUYD1yyPEe3xr3T34TZSUHycXtMM" - , "03501e454bf00751f24b1b489aa925215d66af2234e3891c3b21a52bedb3cd711c" - , "2a7857631386ba23dacac34180dd1983734e444fdbf774041578e9b6adb37c19" - , "0488b21e025c1bd648000000012a7857631386ba23dacac34180dd1983734e444fdbf774041578e9b6adb37c1903501e454bf00751f24b1b489aa925215d66af2234e3891c3b21a52bedb3cd711c" - , "0488ade4025c1bd648000000012a7857631386ba23dacac34180dd1983734e444fdbf774041578e9b6adb37c19003c6cb8d0f6a264c91ea8b5030fadaa8e538b020f0a387421a12de9319dc93368" - , "xpub6ASuArnXKPbfEwhqN6e3mwBcDTgzisQN1wXN9BJcM47sSikHjJf3UFHKkNAWbWMiGj7Wf5uMash7SyYq527Hqck2AxYysAA7xmALppuCkwQ" - , "xprv9wTYmMFdV23N2TdNG573QoEsfRrWKQgWeibmLntzniatZvR9BmLnvSxqu53Kw1UmYPxLgboyZQaXwTCg8MSY3H2EU4pWcQDnRnrVA1xe8fs" - ] - , [ "m/0'/1/2'" - , "ee7ab90cde56a8c0e2bb086ac49748b8db9dce72" - , "ee7ab90c" - , "1NjxqbA9aZWnh17q1UW3rB4EPu79wDXj7x" - , "1WykKhR25y7VDT21nZEwUUKSKDz9pENJh" - , "cbce0d719ecf7431d88e6a89fa1483e02e35092af60c042b1df2ff59fa424dca" - , "L43t3od1Gh7Lj55Bzjj1xDAgJDcL7YFo2nEcNaMGiyRZS1CidBVU" - , "0357bfe1e341d01c69fe5654309956cbea516822fba8a601743a012a7896ee8dc2" - , "04466b9cc8e161e966409ca52986c584f07e9dc81f735db683c3ff6ec7b1503f" - , "0488b21e03bef5a2f98000000204466b9cc8e161e966409ca52986c584f07e9dc81f735db683c3ff6ec7b1503f0357bfe1e341d01c69fe5654309956cbea516822fba8a601743a012a7896ee8dc2" - , "0488ade403bef5a2f98000000204466b9cc8e161e966409ca52986c584f07e9dc81f735db683c3ff6ec7b1503f00cbce0d719ecf7431d88e6a89fa1483e02e35092af60c042b1df2ff59fa424dca" - , "xpub6D4BDPcP2GT577Vvch3R8wDkScZWzQzMMUm3PWbmWvVJrZwQY4VUNgqFJPMM3No2dFDFGTsxxpG5uJh7n7epu4trkrX7x7DogT5Uv6fcLW5" - , "xprv9z4pot5VBttmtdRTWfWQmoH1taj2axGVzFqSb8C9xaxKymcFzXBDptWmT7FwuEzG3ryjH4ktypQSAewRiNMjANTtpgP4mLTj34bhnZX7UiM" - ] - , [ "m/0'/1/2'/2" - , "d880d7d893848509a62d8fb74e32148dac68412f" - , "d880d7d8" - , "1LjmJcdPnDHhNTUgrWyhLGnRDKxQjoxAgt" - , "1asQ3smHhv2nv5R6hPpiUfkEorJpsdwwx" - , "0f479245fb19a38a1954c5c7c0ebab2f9bdfd96a17563ef28a6a4b1a2a764ef4" - , "KwjQsVuMjbCP2Zmr3VaFaStav7NvevwjvvkqrWd5Qmh1XVnCteBR" - , "02e8445082a72f29b75ca48748a914df60622a609cacfce8ed0e35804560741d29" - , "cfb71883f01676f587d023cc53a35bc7f88f724b1f8c2892ac1275ac822a3edd" - , "0488b21e04ee7ab90c00000002cfb71883f01676f587d023cc53a35bc7f88f724b1f8c2892ac1275ac822a3edd02e8445082a72f29b75ca48748a914df60622a609cacfce8ed0e35804560741d29" - , "0488ade404ee7ab90c00000002cfb71883f01676f587d023cc53a35bc7f88f724b1f8c2892ac1275ac822a3edd000f479245fb19a38a1954c5c7c0ebab2f9bdfd96a17563ef28a6a4b1a2a764ef4" - , "xpub6FHa3pjLCk84BayeJxFW2SP4XRrFd1JYnxeLeU8EqN3vDfZmbqBqaGJAyiLjTAwm6ZLRQUMv1ZACTj37sR62cfN7fe5JnJ7dh8zL4fiyLHV" - , "xprvA2JDeKCSNNZky6uBCviVfJSKyQ1mDYahRjijr5idH2WwLsEd4Hsb2Tyh8RfQMuPh7f7RtyzTtdrbdqqsunu5Mm3wDvUAKRHSC34sJ7in334" - ] - , [ "m/0'/1/2'/2/1000000000" - , "d69aa102255fed74378278c7812701ea641fdf32" - , "d69aa102" - , "1LZiqrop2HGR4qrH1ULZPyBpU6AUP49Uam" - , "1HXJog342VFdc68AB9Cb6LwVmCjvcLMiwm" - , "471b76e389e528d6de6d816857e012c5455051cad6660850e58372a6c3e6e7c8" - , "Kybw8izYevo5xMh1TK7aUr7jHFCxXS1zv8p3oqFz3o2zFbhRXHYs" - , "022a471424da5e657499d1ff51cb43c47481a03b1e77f951fe64cec9f5a48f7011" - , "c783e67b921d2beb8f6b389cc646d7263b4145701dadd2161548a8b078e65e9e" - , "0488b21e05d880d7d83b9aca00c783e67b921d2beb8f6b389cc646d7263b4145701dadd2161548a8b078e65e9e022a471424da5e657499d1ff51cb43c47481a03b1e77f951fe64cec9f5a48f7011" - , "0488ade405d880d7d83b9aca00c783e67b921d2beb8f6b389cc646d7263b4145701dadd2161548a8b078e65e9e00471b76e389e528d6de6d816857e012c5455051cad6660850e58372a6c3e6e7c8" - , "xpub6H1LXWLaKsWFhvm6RVpEL9P4KfRZSW7abD2ttkWP3SSQvnyA8FSVqNTEcYFgJS2UaFcxupHiYkro49S8yGasTvXEYBVPamhGW6cFJodrTHy" - , "xprvA41z7zogVVwxVSgdKUHDy1SKmdb533PjDz7J6N6mV6uS3ze1ai8FHa8kmHScGpWmj4WggLyQjgPie1rFSruoUihUZREPSL39UNdE3BBDu76" - ] + [ "m" + , "3442193e1bb70916e914552172cd4e2dbc9df811" + , "3442193e" + , "15mKKb2eos1hWa6tisdPwwDC1a5J1y9nma" + , "1NQpH6Nf8QtR2HphLRcvuVqfhXBXsiWn8r" + , "e8f32e723decf4051aefac8e2c93c9c5b214313817cdb01a1494b917c8436b35" + , "L52XzL2cMkHxqxBXRyEpnPQZGUs3uKiL3R11XbAdHigRzDozKZeW" + , "0339a36013301597daef41fbe593a02cc513d0b55527ec2df1050e2e8ff49c85c2" + , "873dff81c02f525623fd1fe5167eac3a55a049de3d314bb42ee227ffed37d508" + , "0488b21e000000000000000000873dff81c02f525623fd1fe5167eac3a55a049de3d314bb42ee227ffed37d5080339a36013301597daef41fbe593a02cc513d0b55527ec2df1050e2e8ff49c85c2" + , "0488ade4000000000000000000873dff81c02f525623fd1fe5167eac3a55a049de3d314bb42ee227ffed37d50800e8f32e723decf4051aefac8e2c93c9c5b214313817cdb01a1494b917c8436b35" + , "xpub661MyMwAqRbcFtXgS5sYJABqqG9YLmC4Q1Rdap9gSE8NqtwybGhePY2gZ29ESFjqJoCu1Rupje8YtGqsefD265TMg7usUDFdp6W1EGMcet8" + , "xprv9s21ZrQH143K3QTDL4LXw2F7HEK3wJUD2nW2nRk4stbPy6cq3jPPqjiChkVvvNKmPGJxWUtg6LnF5kejMRNNU3TGtRBeJgk33yuGBxrMPHi" + ] + , + [ "m/0'" + , "5c1bd648ed23aa5fd50ba52b2457c11e9e80a6a7" + , "5c1bd648" + , "19Q2WoS5hSS6T8GjhK8KZLMgmWaq4neXrh" + , "1DDVw6BRKUv9U8Hzg5rGsia13nDrgJQpBd" + , "edb2e14f9ee77d26dd93b4ecede8d16ed408ce149b6cd80b0715a2d911a0afea" + , "L5BmPijJjrKbiUfG4zbiFKNqkvuJ8usooJmzuD7Z8dkRoTThYnAT" + , "035a784662a4a20a65bf6aab9ae98a6c068a81c52e4b032c0fb5400c706cfccc56" + , "47fdacbd0f1097043b78c63c20c34ef4ed9a111d980047ad16282c7ae6236141" + , "0488b21e013442193e8000000047fdacbd0f1097043b78c63c20c34ef4ed9a111d980047ad16282c7ae6236141035a784662a4a20a65bf6aab9ae98a6c068a81c52e4b032c0fb5400c706cfccc56" + , "0488ade4013442193e8000000047fdacbd0f1097043b78c63c20c34ef4ed9a111d980047ad16282c7ae623614100edb2e14f9ee77d26dd93b4ecede8d16ed408ce149b6cd80b0715a2d911a0afea" + , "xpub68Gmy5EdvgibQVfPdqkBBCHxA5htiqg55crXYuXoQRKfDBFA1WEjWgP6LHhwBZeNK1VTsfTFUHCdrfp1bgwQ9xv5ski8PX9rL2dZXvgGDnw" + , "xprv9uHRZZhk6KAJC1avXpDAp4MDc3sQKNxDiPvvkX8Br5ngLNv1TxvUxt4cV1rGL5hj6KCesnDYUhd7oWgT11eZG7XnxHrnYeSvkzY7d2bhkJ7" + ] + , + [ "m/0'/1" + , "bef5a2f9a56a94aab12459f72ad9cf8cf19c7bbe" + , "bef5a2f9" + , "1JQheacLPdM5ySCkrZkV66G2ApAXe1mqLj" + , "1KMg6dRggXSkpz9fFyU76ru83TUSwPePEZ" + , "3c6cb8d0f6a264c91ea8b5030fadaa8e538b020f0a387421a12de9319dc93368" + , "KyFAjQ5rgrKvhXvNMtFB5PCSKUYD1yyPEe3xr3T34TZSUHycXtMM" + , "03501e454bf00751f24b1b489aa925215d66af2234e3891c3b21a52bedb3cd711c" + , "2a7857631386ba23dacac34180dd1983734e444fdbf774041578e9b6adb37c19" + , "0488b21e025c1bd648000000012a7857631386ba23dacac34180dd1983734e444fdbf774041578e9b6adb37c1903501e454bf00751f24b1b489aa925215d66af2234e3891c3b21a52bedb3cd711c" + , "0488ade4025c1bd648000000012a7857631386ba23dacac34180dd1983734e444fdbf774041578e9b6adb37c19003c6cb8d0f6a264c91ea8b5030fadaa8e538b020f0a387421a12de9319dc93368" + , "xpub6ASuArnXKPbfEwhqN6e3mwBcDTgzisQN1wXN9BJcM47sSikHjJf3UFHKkNAWbWMiGj7Wf5uMash7SyYq527Hqck2AxYysAA7xmALppuCkwQ" + , "xprv9wTYmMFdV23N2TdNG573QoEsfRrWKQgWeibmLntzniatZvR9BmLnvSxqu53Kw1UmYPxLgboyZQaXwTCg8MSY3H2EU4pWcQDnRnrVA1xe8fs" + ] + , + [ "m/0'/1/2'" + , "ee7ab90cde56a8c0e2bb086ac49748b8db9dce72" + , "ee7ab90c" + , "1NjxqbA9aZWnh17q1UW3rB4EPu79wDXj7x" + , "1WykKhR25y7VDT21nZEwUUKSKDz9pENJh" + , "cbce0d719ecf7431d88e6a89fa1483e02e35092af60c042b1df2ff59fa424dca" + , "L43t3od1Gh7Lj55Bzjj1xDAgJDcL7YFo2nEcNaMGiyRZS1CidBVU" + , "0357bfe1e341d01c69fe5654309956cbea516822fba8a601743a012a7896ee8dc2" + , "04466b9cc8e161e966409ca52986c584f07e9dc81f735db683c3ff6ec7b1503f" + , "0488b21e03bef5a2f98000000204466b9cc8e161e966409ca52986c584f07e9dc81f735db683c3ff6ec7b1503f0357bfe1e341d01c69fe5654309956cbea516822fba8a601743a012a7896ee8dc2" + , "0488ade403bef5a2f98000000204466b9cc8e161e966409ca52986c584f07e9dc81f735db683c3ff6ec7b1503f00cbce0d719ecf7431d88e6a89fa1483e02e35092af60c042b1df2ff59fa424dca" + , "xpub6D4BDPcP2GT577Vvch3R8wDkScZWzQzMMUm3PWbmWvVJrZwQY4VUNgqFJPMM3No2dFDFGTsxxpG5uJh7n7epu4trkrX7x7DogT5Uv6fcLW5" + , "xprv9z4pot5VBttmtdRTWfWQmoH1taj2axGVzFqSb8C9xaxKymcFzXBDptWmT7FwuEzG3ryjH4ktypQSAewRiNMjANTtpgP4mLTj34bhnZX7UiM" + ] + , + [ "m/0'/1/2'/2" + , "d880d7d893848509a62d8fb74e32148dac68412f" + , "d880d7d8" + , "1LjmJcdPnDHhNTUgrWyhLGnRDKxQjoxAgt" + , "1asQ3smHhv2nv5R6hPpiUfkEorJpsdwwx" + , "0f479245fb19a38a1954c5c7c0ebab2f9bdfd96a17563ef28a6a4b1a2a764ef4" + , "KwjQsVuMjbCP2Zmr3VaFaStav7NvevwjvvkqrWd5Qmh1XVnCteBR" + , "02e8445082a72f29b75ca48748a914df60622a609cacfce8ed0e35804560741d29" + , "cfb71883f01676f587d023cc53a35bc7f88f724b1f8c2892ac1275ac822a3edd" + , "0488b21e04ee7ab90c00000002cfb71883f01676f587d023cc53a35bc7f88f724b1f8c2892ac1275ac822a3edd02e8445082a72f29b75ca48748a914df60622a609cacfce8ed0e35804560741d29" + , "0488ade404ee7ab90c00000002cfb71883f01676f587d023cc53a35bc7f88f724b1f8c2892ac1275ac822a3edd000f479245fb19a38a1954c5c7c0ebab2f9bdfd96a17563ef28a6a4b1a2a764ef4" + , "xpub6FHa3pjLCk84BayeJxFW2SP4XRrFd1JYnxeLeU8EqN3vDfZmbqBqaGJAyiLjTAwm6ZLRQUMv1ZACTj37sR62cfN7fe5JnJ7dh8zL4fiyLHV" + , "xprvA2JDeKCSNNZky6uBCviVfJSKyQ1mDYahRjijr5idH2WwLsEd4Hsb2Tyh8RfQMuPh7f7RtyzTtdrbdqqsunu5Mm3wDvUAKRHSC34sJ7in334" + ] + , + [ "m/0'/1/2'/2/1000000000" + , "d69aa102255fed74378278c7812701ea641fdf32" + , "d69aa102" + , "1LZiqrop2HGR4qrH1ULZPyBpU6AUP49Uam" + , "1HXJog342VFdc68AB9Cb6LwVmCjvcLMiwm" + , "471b76e389e528d6de6d816857e012c5455051cad6660850e58372a6c3e6e7c8" + , "Kybw8izYevo5xMh1TK7aUr7jHFCxXS1zv8p3oqFz3o2zFbhRXHYs" + , "022a471424da5e657499d1ff51cb43c47481a03b1e77f951fe64cec9f5a48f7011" + , "c783e67b921d2beb8f6b389cc646d7263b4145701dadd2161548a8b078e65e9e" + , "0488b21e05d880d7d83b9aca00c783e67b921d2beb8f6b389cc646d7263b4145701dadd2161548a8b078e65e9e022a471424da5e657499d1ff51cb43c47481a03b1e77f951fe64cec9f5a48f7011" + , "0488ade405d880d7d83b9aca00c783e67b921d2beb8f6b389cc646d7263b4145701dadd2161548a8b078e65e9e00471b76e389e528d6de6d816857e012c5455051cad6660850e58372a6c3e6e7c8" + , "xpub6H1LXWLaKsWFhvm6RVpEL9P4KfRZSW7abD2ttkWP3SSQvnyA8FSVqNTEcYFgJS2UaFcxupHiYkro49S8yGasTvXEYBVPamhGW6cFJodrTHy" + , "xprvA41z7zogVVwxVSgdKUHDy1SKmdb533PjDz7J6N6mV6uS3ze1ai8FHa8kmHScGpWmj4WggLyQjgPie1rFSruoUihUZREPSL39UNdE3BBDu76" + ] ] m2 :: TestKey @@ -457,90 +492,95 @@ vector2 :: [TestVector] vector2 = [ - [ "m" - , "bd16bee53961a47d6ad888e29545434a89bdfe95" - , "bd16bee5" - , "1JEoxevbLLG8cVqeoGKQiAwoWbNYSUyYjg" - , "148CGtv7bwcC933EHtcDfzDQVneur1R8Y1" - , "4b03d6fc340455b363f51020ad3ecca4f0850280cf436c70c727923f6db46c3e" - , "KyjXhyHF9wTphBkfpxjL8hkDXDUSbE3tKANT94kXSyh6vn6nKaoy" - , "03cbcaa9c98c877a26977d00825c956a238e8dddfbd322cce4f74b0b5bd6ace4a7" - , "60499f801b896d83179a4374aeb7822aaeaceaa0db1f85ee3e904c4defbd9689" - , "0488b21e00000000000000000060499f801b896d83179a4374aeb7822aaeaceaa0db1f85ee3e904c4defbd968903cbcaa9c98c877a26977d00825c956a238e8dddfbd322cce4f74b0b5bd6ace4a7" - , "0488ade400000000000000000060499f801b896d83179a4374aeb7822aaeaceaa0db1f85ee3e904c4defbd9689004b03d6fc340455b363f51020ad3ecca4f0850280cf436c70c727923f6db46c3e" - , "xpub661MyMwAqRbcFW31YEwpkMuc5THy2PSt5bDMsktWQcFF8syAmRUapSCGu8ED9W6oDMSgv6Zz8idoc4a6mr8BDzTJY47LJhkJ8UB7WEGuduB" - , "xprv9s21ZrQH143K31xYSDQpPDxsXRTUcvj2iNHm5NUtrGiGG5e2DtALGdso3pGz6ssrdK4PFmM8NSpSBHNqPqm55Qn3LqFtT2emdEXVYsCzC2U" - ] - , [ "m/0" - , "5a61ff8eb7aaca3010db97ebda76121610b78096" - , "5a61ff8e" - , "19EuDJdgfRkwCmRzbzVBHZWQG9QNWhftbZ" - , "1KVyTSpsBGYs7NdyZmArEpVTfWJQSgiDCx" - , "abe74a98f6c7eabee0428f53798f0ab8aa1bd37873999041703c742f15ac7e1e" - , "L2ysLrR6KMSAtx7uPqmYpoTeiRzydXBattRXjXz5GDFPrdfPzKbj" - , "02fc9e5af0ac8d9b3cecfe2a888e2117ba3d089d8585886c9c826b6b22a98d12ea" - , "f0909affaa7ee7abe5dd4e100598d4dc53cd709d5a5c2cac40e7412f232f7c9c" - , "0488b21e01bd16bee500000000f0909affaa7ee7abe5dd4e100598d4dc53cd709d5a5c2cac40e7412f232f7c9c02fc9e5af0ac8d9b3cecfe2a888e2117ba3d089d8585886c9c826b6b22a98d12ea" - , "0488ade401bd16bee500000000f0909affaa7ee7abe5dd4e100598d4dc53cd709d5a5c2cac40e7412f232f7c9c00abe74a98f6c7eabee0428f53798f0ab8aa1bd37873999041703c742f15ac7e1e" - , "xpub69H7F5d8KSRgmmdJg2KhpAK8SR3DjMwAdkxj3ZuxV27CprR9LgpeyGmXUbC6wb7ERfvrnKZjXoUmmDznezpbZb7ap6r1D3tgFxHmwMkQTPH" - , "xprv9vHkqa6EV4sPZHYqZznhT2NPtPCjKuDKGY38FBWLvgaDx45zo9WQRUT3dKYnjwih2yJD9mkrocEZXo1ex8G81dwSM1fwqWpWkeS3v86pgKt" - ] - , [ "m/0/2147483647'" - , "d8ab493736da02f11ed682f88339e720fb0379d1" - , "d8ab4937" - , "1Lke9bXGhn5VPrBuXgN12uGUphrttUErmk" - , "14MFLsfx1nc4RKiaH9khqDTNL9CRz3q347" - , "877c779ad9687164e9c2f4f0f4ff0340814392330693ce95a58fe18fd52e6e93" - , "L1m5VpbXmMp57P3knskwhoMTLdhAAaXiHvnGLMribbfwzVRpz2Sr" - , "03c01e7425647bdefa82b12d9bad5e3e6865bee0502694b94ca58b666abc0a5c3b" - , "be17a268474a6bb9c61e1d720cf6215e2a88c5406c4aee7b38547f585c9a37d9" - , "0488b21e025a61ff8effffffffbe17a268474a6bb9c61e1d720cf6215e2a88c5406c4aee7b38547f585c9a37d903c01e7425647bdefa82b12d9bad5e3e6865bee0502694b94ca58b666abc0a5c3b" - , "0488ade4025a61ff8effffffffbe17a268474a6bb9c61e1d720cf6215e2a88c5406c4aee7b38547f585c9a37d900877c779ad9687164e9c2f4f0f4ff0340814392330693ce95a58fe18fd52e6e93" - , "xpub6ASAVgeehLbnwdqV6UKMHVzgqAG8Gr6riv3Fxxpj8ksbH9ebxaEyBLZ85ySDhKiLDBrQSARLq1uNRts8RuJiHjaDMBU4Zn9h8LZNnBC5y4a" - , "xprv9wSp6B7kry3Vj9m1zSnLvN3xH8RdsPP1Mh7fAaR7aRLcQMKTR2vidYEeEg2mUCTAwCd6vnxVrcjfy2kRgVsFawNzmjuHc2YmYRmagcEPdU9" - ] - , [ "m/0/2147483647'/1" - , "78412e3a2296a40de124307b6485bd19833e2e34" - , "78412e3a" - , "1BxrAr2pHpeBheusmd6fHDP2tSLAUa3qsW" - , "19ou31MGyGW9VFx7woKBqwLe5JHhQBYaDD" - , "704addf544a06e5ee4bea37098463c23613da32020d604506da8c0518e1da4b7" - , "KzyzXnznxSv249b4KuNkBwowaN3akiNeEHy5FWoPCJpStZbEKXN2" - , "03a7d1d856deb74c508e05031f9895dab54626251b3806e16b4bd12e781a7df5b9" - , "f366f48f1ea9f2d1d3fe958c95ca84ea18e4c4ddb9366c336c927eb246fb38cb" - , "0488b21e03d8ab493700000001f366f48f1ea9f2d1d3fe958c95ca84ea18e4c4ddb9366c336c927eb246fb38cb03a7d1d856deb74c508e05031f9895dab54626251b3806e16b4bd12e781a7df5b9" - , "0488ade403d8ab493700000001f366f48f1ea9f2d1d3fe958c95ca84ea18e4c4ddb9366c336c927eb246fb38cb00704addf544a06e5ee4bea37098463c23613da32020d604506da8c0518e1da4b7" - , "xpub6DF8uhdarytz3FWdA8TvFSvvAh8dP3283MY7p2V4SeE2wyWmG5mg5EwVvmdMVCQcoNJxGoWaU9DCWh89LojfZ537wTfunKau47EL2dhHKon" - , "xprv9zFnWC6h2cLgpmSA46vutJzBcfJ8yaJGg8cX1e5StJh45BBciYTRXSd25UEPVuesF9yog62tGAQtHjXajPPdbRCHuWS6T8XA2ECKADdw4Ef" - ] - , [ "m/0/2147483647'/1/2147483646'" - , "31a507b815593dfc51ffc7245ae7e5aee304246e" - , "31a507b8" - , "15XVotxCAV7sRx1PSCkQNsGw3W9jT9A94R" - , "18GYmRm4nyjk8ydvoVXFxMWQvxhksEFDZR" - , "f1c7c871a54a804afe328b4c83a1c33b8e5ff48f5087273f04efa83b247d6a2d" - , "L5KhaMvPYRW1ZoFmRjUtxxPypQ94m6BcDrPhqArhggdaTbbAFJEF" - , "02d2b36900396c9282fa14628566582f206a5dd0bcc8d5e892611806cafb0301f0" - , "637807030d55d01f9a0cb3a7839515d796bd07706386a6eddf06cc29a65a0e29" - , "0488b21e0478412e3afffffffe637807030d55d01f9a0cb3a7839515d796bd07706386a6eddf06cc29a65a0e2902d2b36900396c9282fa14628566582f206a5dd0bcc8d5e892611806cafb0301f0" - , "0488ade40478412e3afffffffe637807030d55d01f9a0cb3a7839515d796bd07706386a6eddf06cc29a65a0e2900f1c7c871a54a804afe328b4c83a1c33b8e5ff48f5087273f04efa83b247d6a2d" - , "xpub6ERApfZwUNrhLCkDtcHTcxd75RbzS1ed54G1LkBUHQVHQKqhMkhgbmJbZRkrgZw4koxb5JaHWkY4ALHY2grBGRjaDMzQLcgJvLJuZZvRcEL" - , "xprvA1RpRA33e1JQ7ifknakTFpgNXPmW2YvmhqLQYMmrj4xJXXWYpDPS3xz7iAxn8L39njGVyuoseXzU6rcxFLJ8HFsTjSyQbLYnMpCqE2VbFWc" - ] - , [ "m/0/2147483647'/1/2147483646'/2" - , "26132fdbe7bf89cbc64cf8dafa3f9f88b8666220" - , "26132fdb" - , "14UKfRV9ZPUp6ZC9PLhqbRtxdihW9em3xt" - , "1758mgwNZhyzpRLe4u7FjqpJtqKpaGhXh7" - , "bb7d39bdb83ecf58f2fd82b6d918341cbef428661ef01ab97c28a4842125ac23" - , "L3WAYNAZPxx1fr7KCz7GN9nD5qMBnNiqEJNJMU1z9MMaannAt4aK" - , "024d902e1a2fc7a8755ab5b694c575fce742c48d9ff192e63df5193e4c7afe1f9c" - , "9452b549be8cea3ecb7a84bec10dcfd94afe4d129ebfd3b3cb58eedf394ed271" - , "0488b21e0531a507b8000000029452b549be8cea3ecb7a84bec10dcfd94afe4d129ebfd3b3cb58eedf394ed271024d902e1a2fc7a8755ab5b694c575fce742c48d9ff192e63df5193e4c7afe1f9c" - , "0488ade40531a507b8000000029452b549be8cea3ecb7a84bec10dcfd94afe4d129ebfd3b3cb58eedf394ed27100bb7d39bdb83ecf58f2fd82b6d918341cbef428661ef01ab97c28a4842125ac23" - , "xpub6FnCn6nSzZAw5Tw7cgR9bi15UV96gLZhjDstkXXxvCLsUXBGXPdSnLFbdpq8p9HmGsApME5hQTZ3emM2rnY5agb9rXpVGyy3bdW6EEgAtqt" - , "xprvA2nrNbFZABcdryreWet9Ea4LvTJcGsqrMzxHx98MMrotbir7yrKCEXw7nadnHM8Dq38EGfSh6dqA9QWTyefMLEcBYJUuekgW4BYPJcr9E7j" - ] + [ "m" + , "bd16bee53961a47d6ad888e29545434a89bdfe95" + , "bd16bee5" + , "1JEoxevbLLG8cVqeoGKQiAwoWbNYSUyYjg" + , "148CGtv7bwcC933EHtcDfzDQVneur1R8Y1" + , "4b03d6fc340455b363f51020ad3ecca4f0850280cf436c70c727923f6db46c3e" + , "KyjXhyHF9wTphBkfpxjL8hkDXDUSbE3tKANT94kXSyh6vn6nKaoy" + , "03cbcaa9c98c877a26977d00825c956a238e8dddfbd322cce4f74b0b5bd6ace4a7" + , "60499f801b896d83179a4374aeb7822aaeaceaa0db1f85ee3e904c4defbd9689" + , "0488b21e00000000000000000060499f801b896d83179a4374aeb7822aaeaceaa0db1f85ee3e904c4defbd968903cbcaa9c98c877a26977d00825c956a238e8dddfbd322cce4f74b0b5bd6ace4a7" + , "0488ade400000000000000000060499f801b896d83179a4374aeb7822aaeaceaa0db1f85ee3e904c4defbd9689004b03d6fc340455b363f51020ad3ecca4f0850280cf436c70c727923f6db46c3e" + , "xpub661MyMwAqRbcFW31YEwpkMuc5THy2PSt5bDMsktWQcFF8syAmRUapSCGu8ED9W6oDMSgv6Zz8idoc4a6mr8BDzTJY47LJhkJ8UB7WEGuduB" + , "xprv9s21ZrQH143K31xYSDQpPDxsXRTUcvj2iNHm5NUtrGiGG5e2DtALGdso3pGz6ssrdK4PFmM8NSpSBHNqPqm55Qn3LqFtT2emdEXVYsCzC2U" + ] + , + [ "m/0" + , "5a61ff8eb7aaca3010db97ebda76121610b78096" + , "5a61ff8e" + , "19EuDJdgfRkwCmRzbzVBHZWQG9QNWhftbZ" + , "1KVyTSpsBGYs7NdyZmArEpVTfWJQSgiDCx" + , "abe74a98f6c7eabee0428f53798f0ab8aa1bd37873999041703c742f15ac7e1e" + , "L2ysLrR6KMSAtx7uPqmYpoTeiRzydXBattRXjXz5GDFPrdfPzKbj" + , "02fc9e5af0ac8d9b3cecfe2a888e2117ba3d089d8585886c9c826b6b22a98d12ea" + , "f0909affaa7ee7abe5dd4e100598d4dc53cd709d5a5c2cac40e7412f232f7c9c" + , "0488b21e01bd16bee500000000f0909affaa7ee7abe5dd4e100598d4dc53cd709d5a5c2cac40e7412f232f7c9c02fc9e5af0ac8d9b3cecfe2a888e2117ba3d089d8585886c9c826b6b22a98d12ea" + , "0488ade401bd16bee500000000f0909affaa7ee7abe5dd4e100598d4dc53cd709d5a5c2cac40e7412f232f7c9c00abe74a98f6c7eabee0428f53798f0ab8aa1bd37873999041703c742f15ac7e1e" + , "xpub69H7F5d8KSRgmmdJg2KhpAK8SR3DjMwAdkxj3ZuxV27CprR9LgpeyGmXUbC6wb7ERfvrnKZjXoUmmDznezpbZb7ap6r1D3tgFxHmwMkQTPH" + , "xprv9vHkqa6EV4sPZHYqZznhT2NPtPCjKuDKGY38FBWLvgaDx45zo9WQRUT3dKYnjwih2yJD9mkrocEZXo1ex8G81dwSM1fwqWpWkeS3v86pgKt" + ] + , + [ "m/0/2147483647'" + , "d8ab493736da02f11ed682f88339e720fb0379d1" + , "d8ab4937" + , "1Lke9bXGhn5VPrBuXgN12uGUphrttUErmk" + , "14MFLsfx1nc4RKiaH9khqDTNL9CRz3q347" + , "877c779ad9687164e9c2f4f0f4ff0340814392330693ce95a58fe18fd52e6e93" + , "L1m5VpbXmMp57P3knskwhoMTLdhAAaXiHvnGLMribbfwzVRpz2Sr" + , "03c01e7425647bdefa82b12d9bad5e3e6865bee0502694b94ca58b666abc0a5c3b" + , "be17a268474a6bb9c61e1d720cf6215e2a88c5406c4aee7b38547f585c9a37d9" + , "0488b21e025a61ff8effffffffbe17a268474a6bb9c61e1d720cf6215e2a88c5406c4aee7b38547f585c9a37d903c01e7425647bdefa82b12d9bad5e3e6865bee0502694b94ca58b666abc0a5c3b" + , "0488ade4025a61ff8effffffffbe17a268474a6bb9c61e1d720cf6215e2a88c5406c4aee7b38547f585c9a37d900877c779ad9687164e9c2f4f0f4ff0340814392330693ce95a58fe18fd52e6e93" + , "xpub6ASAVgeehLbnwdqV6UKMHVzgqAG8Gr6riv3Fxxpj8ksbH9ebxaEyBLZ85ySDhKiLDBrQSARLq1uNRts8RuJiHjaDMBU4Zn9h8LZNnBC5y4a" + , "xprv9wSp6B7kry3Vj9m1zSnLvN3xH8RdsPP1Mh7fAaR7aRLcQMKTR2vidYEeEg2mUCTAwCd6vnxVrcjfy2kRgVsFawNzmjuHc2YmYRmagcEPdU9" + ] + , + [ "m/0/2147483647'/1" + , "78412e3a2296a40de124307b6485bd19833e2e34" + , "78412e3a" + , "1BxrAr2pHpeBheusmd6fHDP2tSLAUa3qsW" + , "19ou31MGyGW9VFx7woKBqwLe5JHhQBYaDD" + , "704addf544a06e5ee4bea37098463c23613da32020d604506da8c0518e1da4b7" + , "KzyzXnznxSv249b4KuNkBwowaN3akiNeEHy5FWoPCJpStZbEKXN2" + , "03a7d1d856deb74c508e05031f9895dab54626251b3806e16b4bd12e781a7df5b9" + , "f366f48f1ea9f2d1d3fe958c95ca84ea18e4c4ddb9366c336c927eb246fb38cb" + , "0488b21e03d8ab493700000001f366f48f1ea9f2d1d3fe958c95ca84ea18e4c4ddb9366c336c927eb246fb38cb03a7d1d856deb74c508e05031f9895dab54626251b3806e16b4bd12e781a7df5b9" + , "0488ade403d8ab493700000001f366f48f1ea9f2d1d3fe958c95ca84ea18e4c4ddb9366c336c927eb246fb38cb00704addf544a06e5ee4bea37098463c23613da32020d604506da8c0518e1da4b7" + , "xpub6DF8uhdarytz3FWdA8TvFSvvAh8dP3283MY7p2V4SeE2wyWmG5mg5EwVvmdMVCQcoNJxGoWaU9DCWh89LojfZ537wTfunKau47EL2dhHKon" + , "xprv9zFnWC6h2cLgpmSA46vutJzBcfJ8yaJGg8cX1e5StJh45BBciYTRXSd25UEPVuesF9yog62tGAQtHjXajPPdbRCHuWS6T8XA2ECKADdw4Ef" + ] + , + [ "m/0/2147483647'/1/2147483646'" + , "31a507b815593dfc51ffc7245ae7e5aee304246e" + , "31a507b8" + , "15XVotxCAV7sRx1PSCkQNsGw3W9jT9A94R" + , "18GYmRm4nyjk8ydvoVXFxMWQvxhksEFDZR" + , "f1c7c871a54a804afe328b4c83a1c33b8e5ff48f5087273f04efa83b247d6a2d" + , "L5KhaMvPYRW1ZoFmRjUtxxPypQ94m6BcDrPhqArhggdaTbbAFJEF" + , "02d2b36900396c9282fa14628566582f206a5dd0bcc8d5e892611806cafb0301f0" + , "637807030d55d01f9a0cb3a7839515d796bd07706386a6eddf06cc29a65a0e29" + , "0488b21e0478412e3afffffffe637807030d55d01f9a0cb3a7839515d796bd07706386a6eddf06cc29a65a0e2902d2b36900396c9282fa14628566582f206a5dd0bcc8d5e892611806cafb0301f0" + , "0488ade40478412e3afffffffe637807030d55d01f9a0cb3a7839515d796bd07706386a6eddf06cc29a65a0e2900f1c7c871a54a804afe328b4c83a1c33b8e5ff48f5087273f04efa83b247d6a2d" + , "xpub6ERApfZwUNrhLCkDtcHTcxd75RbzS1ed54G1LkBUHQVHQKqhMkhgbmJbZRkrgZw4koxb5JaHWkY4ALHY2grBGRjaDMzQLcgJvLJuZZvRcEL" + , "xprvA1RpRA33e1JQ7ifknakTFpgNXPmW2YvmhqLQYMmrj4xJXXWYpDPS3xz7iAxn8L39njGVyuoseXzU6rcxFLJ8HFsTjSyQbLYnMpCqE2VbFWc" + ] + , + [ "m/0/2147483647'/1/2147483646'/2" + , "26132fdbe7bf89cbc64cf8dafa3f9f88b8666220" + , "26132fdb" + , "14UKfRV9ZPUp6ZC9PLhqbRtxdihW9em3xt" + , "1758mgwNZhyzpRLe4u7FjqpJtqKpaGhXh7" + , "bb7d39bdb83ecf58f2fd82b6d918341cbef428661ef01ab97c28a4842125ac23" + , "L3WAYNAZPxx1fr7KCz7GN9nD5qMBnNiqEJNJMU1z9MMaannAt4aK" + , "024d902e1a2fc7a8755ab5b694c575fce742c48d9ff192e63df5193e4c7afe1f9c" + , "9452b549be8cea3ecb7a84bec10dcfd94afe4d129ebfd3b3cb58eedf394ed271" + , "0488b21e0531a507b8000000029452b549be8cea3ecb7a84bec10dcfd94afe4d129ebfd3b3cb58eedf394ed271024d902e1a2fc7a8755ab5b694c575fce742c48d9ff192e63df5193e4c7afe1f9c" + , "0488ade40531a507b8000000029452b549be8cea3ecb7a84bec10dcfd94afe4d129ebfd3b3cb58eedf394ed27100bb7d39bdb83ecf58f2fd82b6d918341cbef428661ef01ab97c28a4842125ac23" + , "xpub6FnCn6nSzZAw5Tw7cgR9bi15UV96gLZhjDstkXXxvCLsUXBGXPdSnLFbdpq8p9HmGsApME5hQTZ3emM2rnY5agb9rXpVGyy3bdW6EEgAtqt" + , "xprvA2nrNbFZABcdryreWet9Ea4LvTJcGsqrMzxHx98MMrotbir7yrKCEXw7nadnHM8Dq38EGfSh6dqA9QWTyefMLEcBYJUuekgW4BYPJcr9E7j" + ] ] m3 :: TestKey @@ -549,32 +589,33 @@ vector3 :: [TestVector] vector3 = [ - [ "m" - , "41d63b50d8dd5e730cdf4c79a56fc929a757c548" - , "41d63b50" - , "1717ZYpXhZW5CqAbWSjDJbCey3FyKUmCSf" - , "17rxURoF96VhmkcEGCj5LNQkmN9HVhWb7F" - , "00ddb80b067e0d4993197fe10f2657a844a384589847602d56f0c629c81aae32" - , "KwFPqAq9SKx1sPg15Qk56mqkHwrfGPuywtLUxoWPkiTSBoxCs8am" - , "03683af1ba5743bdfc798cf814efeeab2735ec52d95eced528e692b8e34c4e5669" - , "01d28a3e53cffa419ec122c968b3259e16b65076495494d97cae10bbfec3c36f" - , "0488b21e00000000000000000001d28a3e53cffa419ec122c968b3259e16b65076495494d97cae10bbfec3c36f03683af1ba5743bdfc798cf814efeeab2735ec52d95eced528e692b8e34c4e5669" - , "0488ade400000000000000000001d28a3e53cffa419ec122c968b3259e16b65076495494d97cae10bbfec3c36f0000ddb80b067e0d4993197fe10f2657a844a384589847602d56f0c629c81aae32" - , "xpub661MyMwAqRbcEZVB4dScxMAdx6d4nFc9nvyvH3v4gJL378CSRZiYmhRoP7mBy6gSPSCYk6SzXPTf3ND1cZAceL7SfJ1Z3GC8vBgp2epUt13" - , "xprv9s21ZrQH143K25QhxbucbDDuQ4naNntJRi4KUfWT7xo4EKsHt2QJDu7KXp1A3u7Bi1j8ph3EGsZ9Xvz9dGuVrtHHs7pXeTzjuxBrCmmhgC6" - ] - , [ "m/0'" - , "c61368bb50e066acd95bd04a0b23d3837fb75698" - , "c61368bb" - , "1K4L3YxEwg8HkSEapM4iSiGuR6HeQ53KPX" - , "13QeQVJNNakdUU55P1fc8xPMkkeYVzn4o6" - , "491f7a2eebc7b57028e0d3faa0acda02e75c33b03c48fb288c41e2ea44e1daef" - , "KyfrPaeirL5yYAoZvfzyoKXSdszeLqg5vb6dNy9ymvjzZrMZY8GW" - , "026557fdda1d5d43d79611f784780471f086d58e8126b8c40acb82272a7712e7f2" - , "e5fea12a97b927fc9dc3d2cb0d1ea1cf50aa5a1fdc1f933e8906bb38df3377bd" - , "0488b21e0141d63b5080000000e5fea12a97b927fc9dc3d2cb0d1ea1cf50aa5a1fdc1f933e8906bb38df3377bd026557fdda1d5d43d79611f784780471f086d58e8126b8c40acb82272a7712e7f2" - , "0488ade40141d63b5080000000e5fea12a97b927fc9dc3d2cb0d1ea1cf50aa5a1fdc1f933e8906bb38df3377bd00491f7a2eebc7b57028e0d3faa0acda02e75c33b03c48fb288c41e2ea44e1daef" - , "xpub68NZiKmJWnxxS6aaHmn81bvJeTESw724CRDs6HbuccFQN9Ku14VQrADWgqbhhTHBaohPX4CjNLf9fq9MYo6oDaPPLPxSb7gwQN3ih19Zm4Y" - , "xprv9uPDJpEQgRQfDcW7BkF7eTya6RPxXeJCqCJGHuCJ4GiRVLzkTXBAJMu2qaMWPrS7AANYqdq6vcBcBUdJCVVFceUvJFjaPdGZ2y9WACViL4L" - ] + [ "m" + , "41d63b50d8dd5e730cdf4c79a56fc929a757c548" + , "41d63b50" + , "1717ZYpXhZW5CqAbWSjDJbCey3FyKUmCSf" + , "17rxURoF96VhmkcEGCj5LNQkmN9HVhWb7F" + , "00ddb80b067e0d4993197fe10f2657a844a384589847602d56f0c629c81aae32" + , "KwFPqAq9SKx1sPg15Qk56mqkHwrfGPuywtLUxoWPkiTSBoxCs8am" + , "03683af1ba5743bdfc798cf814efeeab2735ec52d95eced528e692b8e34c4e5669" + , "01d28a3e53cffa419ec122c968b3259e16b65076495494d97cae10bbfec3c36f" + , "0488b21e00000000000000000001d28a3e53cffa419ec122c968b3259e16b65076495494d97cae10bbfec3c36f03683af1ba5743bdfc798cf814efeeab2735ec52d95eced528e692b8e34c4e5669" + , "0488ade400000000000000000001d28a3e53cffa419ec122c968b3259e16b65076495494d97cae10bbfec3c36f0000ddb80b067e0d4993197fe10f2657a844a384589847602d56f0c629c81aae32" + , "xpub661MyMwAqRbcEZVB4dScxMAdx6d4nFc9nvyvH3v4gJL378CSRZiYmhRoP7mBy6gSPSCYk6SzXPTf3ND1cZAceL7SfJ1Z3GC8vBgp2epUt13" + , "xprv9s21ZrQH143K25QhxbucbDDuQ4naNntJRi4KUfWT7xo4EKsHt2QJDu7KXp1A3u7Bi1j8ph3EGsZ9Xvz9dGuVrtHHs7pXeTzjuxBrCmmhgC6" + ] + , + [ "m/0'" + , "c61368bb50e066acd95bd04a0b23d3837fb75698" + , "c61368bb" + , "1K4L3YxEwg8HkSEapM4iSiGuR6HeQ53KPX" + , "13QeQVJNNakdUU55P1fc8xPMkkeYVzn4o6" + , "491f7a2eebc7b57028e0d3faa0acda02e75c33b03c48fb288c41e2ea44e1daef" + , "KyfrPaeirL5yYAoZvfzyoKXSdszeLqg5vb6dNy9ymvjzZrMZY8GW" + , "026557fdda1d5d43d79611f784780471f086d58e8126b8c40acb82272a7712e7f2" + , "e5fea12a97b927fc9dc3d2cb0d1ea1cf50aa5a1fdc1f933e8906bb38df3377bd" + , "0488b21e0141d63b5080000000e5fea12a97b927fc9dc3d2cb0d1ea1cf50aa5a1fdc1f933e8906bb38df3377bd026557fdda1d5d43d79611f784780471f086d58e8126b8c40acb82272a7712e7f2" + , "0488ade40141d63b5080000000e5fea12a97b927fc9dc3d2cb0d1ea1cf50aa5a1fdc1f933e8906bb38df3377bd00491f7a2eebc7b57028e0d3faa0acda02e75c33b03c48fb288c41e2ea44e1daef" + , "xpub68NZiKmJWnxxS6aaHmn81bvJeTESw724CRDs6HbuccFQN9Ku14VQrADWgqbhhTHBaohPX4CjNLf9fq9MYo6oDaPPLPxSb7gwQN3ih19Zm4Y" + , "xprv9uPDJpEQgRQfDcW7BkF7eTya6RPxXeJCqCJGHuCJ4GiRVLzkTXBAJMu2qaMWPrS7AANYqdq6vcBcBUdJCVVFceUvJFjaPdGZ2y9WACViL4L" + ] ] diff --git a/test/Haskoin/Keys/MnemonicSpec.hs b/test/Haskoin/Keys/MnemonicSpec.hs --- a/test/Haskoin/Keys/MnemonicSpec.hs +++ b/test/Haskoin/Keys/MnemonicSpec.hs @@ -1,22 +1,23 @@ {-# LANGUAGE OverloadedStrings #-} + module Haskoin.Keys.MnemonicSpec (spec) where -import Control.Monad (zipWithM_) -import Data.Bits (shiftR, (.&.)) -import qualified Data.ByteString as BS -import Data.Either (fromRight) -import Data.List (isPrefixOf) -import Data.Maybe (fromJust) -import Data.Serialize (Serialize, encode) -import Data.Text (Text) -import qualified Data.Text as T -import Data.Word (Word32, Word64) -import Haskoin.Keys -import Haskoin.Util -import Haskoin.Util.Arbitrary -import Test.Hspec -import Test.HUnit -import Test.QuickCheck hiding ((.&.)) +import Control.Monad (zipWithM_) +import Data.Bits (shiftR, (.&.)) +import qualified Data.ByteString as BS +import Data.Either (fromRight) +import Data.List (isPrefixOf) +import Data.Maybe (fromJust) +import Data.Serialize (Serialize, encode) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Word (Word32, Word64) +import Haskoin.Keys +import Haskoin.Util +import Haskoin.Util.Arbitrary +import Test.HUnit +import Test.Hspec +import Test.QuickCheck hiding ((.&.)) spec :: Spec spec = @@ -49,40 +50,43 @@ where f e m = assertEqual "" m . h $ e h = - fromRight (error "Could not decode mnemonic sentence") . - toMnemonic . fromJust . decodeHex + fromRight (error "Could not decode mnemonic sentence") + . toMnemonic + . fromJust + . decodeHex fromMnemonicTest :: Assertion fromMnemonicTest = zipWithM_ f ents mss where f e = assertEqual "" e . h h = - encodeHex . - fromRight (error "Could not decode mnemonic sentence") . fromMnemonic + encodeHex + . fromRight (error "Could not decode mnemonic sentence") + . fromMnemonic mnemonicToSeedTest :: Assertion mnemonicToSeedTest = zipWithM_ f mss seeds where f m s = assertEqual "" s . h $ m h = - encodeHex . - fromRight (error "Could not decode mnemonic seed") . - mnemonicToSeed "TREZOR" + encodeHex + . fromRight (error "Could not decode mnemonic seed") + . mnemonicToSeed "TREZOR" fromMnemonicInvalidTest :: Assertion fromMnemonicInvalidTest = mapM_ f invalidMss where f = assertBool "" . h h m = case fromMnemonic m of - Right _ -> False - Left err -> "fromMnemonic: checksum failed:" `isPrefixOf` err + Right _ -> False + Left err -> "fromMnemonic: checksum failed:" `isPrefixOf` err emptyMnemonicTest :: Assertion emptyMnemonicTest = assertBool "" $ - case fromMnemonic "" of - Right _ -> False - Left err -> "fromMnemonic: empty mnemonic" `isPrefixOf` err + case fromMnemonic "" of + Right _ -> False + Left err -> "fromMnemonic: empty mnemonic" `isPrefixOf` err ents :: [Text] ents = @@ -290,27 +294,30 @@ where bs = encode a `BS.append` encode b l = - length . - T.words . fromRight (error "Could not decode mnemonic senttence") $ - toMnemonic bs + length + . T.words + . fromRight (error "Could not decode mnemonic senttence") + $ toMnemonic bs toMnemonic160 :: (Word32, Word64, Word64) -> Bool toMnemonic160 (a, b, c) = l == 15 where bs = BS.concat [encode a, encode b, encode c] l = - length . - T.words . fromRight (error "Could not decode mnemonic sentence") $ - toMnemonic bs + length + . T.words + . fromRight (error "Could not decode mnemonic sentence") + $ toMnemonic bs toMnemonic256 :: (Word64, Word64, Word64, Word64) -> Bool toMnemonic256 (a, b, c, d) = l == 24 where bs = BS.concat [encode a, encode b, encode c, encode d] l = - length . - T.words . fromRight (error "Could not decode mnemonic sentence") $ - toMnemonic bs + length + . T.words + . fromRight (error "Could not decode mnemonic sentence") + $ toMnemonic bs toMnemonic512 :: ((Word64, Word64, Word64, Word64), (Word64, Word64, Word64, Word64)) -> Bool @@ -328,9 +335,10 @@ , encode h ] l = - length . - T.words . fromRight (error "Could not decode mnemonic sentence") $ - toMnemonic bs + length + . T.words + . fromRight (error "Could not decode mnemonic sentence") + $ toMnemonic bs toMnemonicVar :: [Word32] -> Property toMnemonicVar ls = not (null ls) && length ls <= 8 ==> l == wc @@ -340,9 +348,9 @@ cb = bl `div` 4 wc = (cb + bl * 8) `div` 11 l = - length . T.words . - fromRight (error "Could not decode mnemonic sentence") $ - toMnemonic bs + length . T.words + . fromRight (error "Could not decode mnemonic sentence") + $ toMnemonic bs {- Encode/Decode -} @@ -467,7 +475,7 @@ {- Get bits from ByteString -} -data ByteCountGen = ByteCountGen BS.ByteString Int deriving Show +data ByteCountGen = ByteCountGen BS.ByteString Int deriving (Show) instance Arbitrary ByteCountGen where arbitrary = do diff --git a/test/Haskoin/KeysSpec.hs b/test/Haskoin/KeysSpec.hs --- a/test/Haskoin/KeysSpec.hs +++ b/test/Haskoin/KeysSpec.hs @@ -1,32 +1,33 @@ {-# LANGUAGE OverloadedStrings #-} + module Haskoin.KeysSpec (spec) where -import Control.Lens -import Control.Monad -import Data.Aeson as A -import Data.Aeson.Lens -import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as C -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import Data.Maybe -import qualified Data.Serialize as S -import Data.String (fromString) -import Data.String.Conversions (cs) -import Data.Text (Text) -import Haskoin.Address -import Haskoin.Constants -import Haskoin.Crypto -import Haskoin.Keys -import Haskoin.Script -import Haskoin.Util -import Haskoin.Util.Arbitrary -import Haskoin.UtilSpec (readTestFile) -import Test.HUnit -import Test.Hspec -import Test.Hspec.QuickCheck -import Test.QuickCheck +import Control.Lens +import Control.Monad +import Data.Aeson as A +import Data.Aeson.Lens +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as C +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.Maybe +import qualified Data.Serialize as S +import Data.String (fromString) +import Data.String.Conversions (cs) +import Data.Text (Text) +import Haskoin.Address +import Haskoin.Constants +import Haskoin.Crypto +import Haskoin.Keys +import Haskoin.Script +import Haskoin.Util +import Haskoin.Util.Arbitrary +import Haskoin.UtilSpec (readTestFile) +import Test.HUnit +import Test.Hspec +import Test.Hspec.QuickCheck +import Test.QuickCheck serialVals :: [SerialBox] serialVals = @@ -56,9 +57,9 @@ fromString (cs . encodeHex $ runPutS $ serialize k) == k describe "SecKey properties" $ prop "fromWif . toWif identity" $ - forAll arbitraryNetwork $ \net -> - forAll arbitraryKeyPair $ \(pk, _) -> - fromWif net (toWif net pk) == Just pk + forAll arbitraryNetwork $ \net -> + forAll arbitraryKeyPair $ \(pk, _) -> + fromWif net (toWif net pk) == Just pk describe "Bitcoin core vectors /src/test/key_tests.cpp" $ do it "Passes WIF decoding tests" testPrivkey it "Passes SecKey compression tests" testPrvKeyCompressed @@ -80,15 +81,19 @@ -- github.com/bitcoin/bitcoin/blob/master/src/script.cpp -- from function IsCanonicalPubKey isCanonicalPubKey :: PubKeyI -> Bool -isCanonicalPubKey p = not $ - -- Non-canonical public key: too short - (BS.length bs < 33) || - -- Non-canonical public key: invalid length for uncompressed key - (BS.index bs 0 == 4 && BS.length bs /= 65) || - -- Non-canonical public key: invalid length for compressed key - (BS.index bs 0 `elem` [2,3] && BS.length bs /= 33) || - -- Non-canonical public key: compressed nor uncompressed - (BS.index bs 0 `notElem` [2,3,4]) +isCanonicalPubKey p = + not $ + -- Non-canonical public key: too short + (BS.length bs < 33) + || + -- Non-canonical public key: invalid length for uncompressed key + (BS.index bs 0 == 4 && BS.length bs /= 65) + || + -- Non-canonical public key: invalid length for compressed key + (BS.index bs 0 `elem` [2, 3] && BS.length bs /= 33) + || + -- Non-canonical public key: compressed nor uncompressed + (BS.index bs 0 `notElem` [2, 3, 4]) where bs = runPutS $ serialize p @@ -127,8 +132,9 @@ assertEqual "Address matches payload" (Just payload) scriptM let pubAsWifM = fromWif net a pubAsSecM = - eitherToMaybe . runGetS S.get =<< - decodeHex a :: Maybe SecKey + eitherToMaybe . runGetS S.get + =<< decodeHex a :: + Maybe SecKey assertBool "Address is invalid Wif" $ isNothing pubAsWifM assertBool "Address is invalid PrvKey" $ isNothing pubAsSecM -- Test Script to Addr @@ -141,10 +147,10 @@ chain = obj ^?! key "chain" . _String net = case chain of - "main" -> btc - "test" -> btcTest + "main" -> btc + "test" -> btcTest "regtest" -> btcRegTest - _ -> error "Invalid chain key in key_io_valid.json" + _ -> error "Invalid chain key in key_io_valid.json" testKeyIOInvalidVector :: [Text] -> Assertion testKeyIOInvalidVector [a] = do @@ -161,8 +167,8 @@ testPrivkey :: Assertion testPrivkey = do - assertBool "Key 1" $ isJust $ fromWif btc strSecret1 - assertBool "Key 2" $ isJust $ fromWif btc strSecret2 + assertBool "Key 1" $ isJust $ fromWif btc strSecret1 + assertBool "Key 2" $ isJust $ fromWif btc strSecret2 assertBool "Key 1C" $ isJust $ fromWif btc strSecret1C assertBool "Key 2C" $ isJust $ fromWif btc strSecret2C assertBool "Bad key" $ isNothing $ fromWif btc strAddressBad @@ -194,29 +200,29 @@ sigMsg :: [BS.ByteString] sigMsg = [ mconcat ["Very secret message ", C.pack (show (i :: Int)), ": 11"] - | i <- [0..15] + | i <- [0 .. 15] ] testSignature :: Hash256 -> Assertion testSignature h = do - let sign1 = signHash (secKeyData sec1) h - sign2 = signHash (secKeyData sec2) h + let sign1 = signHash (secKeyData sec1) h + sign2 = signHash (secKeyData sec2) h sign1C = signHash (secKeyData sec1C) h sign2C = signHash (secKeyData sec2C) h - assertBool "Key 1, Sign1" $ verifyHashSig h sign1 (pubKeyPoint pub1) - assertBool "Key 1, Sign2" $ not $ verifyHashSig h sign2 (pubKeyPoint pub1) - assertBool "Key 1, Sign1C" $ verifyHashSig h sign1C (pubKeyPoint pub1) - assertBool "Key 1, Sign2C" $ not $ verifyHashSig h sign2C (pubKeyPoint pub1) - assertBool "Key 2, Sign1" $ not $ verifyHashSig h sign1 (pubKeyPoint pub2) - assertBool "Key 2, Sign2" $ verifyHashSig h sign2 (pubKeyPoint pub2) - assertBool "Key 2, Sign1C" $ not $ verifyHashSig h sign1C (pubKeyPoint pub2) - assertBool "Key 2, Sign2C" $ verifyHashSig h sign2C (pubKeyPoint pub2) - assertBool "Key 1C, Sign1" $ verifyHashSig h sign1 (pubKeyPoint pub1C) - assertBool "Key 1C, Sign2" $ not $ verifyHashSig h sign2 (pubKeyPoint pub1C) + assertBool "Key 1, Sign1" $ verifyHashSig h sign1 (pubKeyPoint pub1) + assertBool "Key 1, Sign2" $ not $ verifyHashSig h sign2 (pubKeyPoint pub1) + assertBool "Key 1, Sign1C" $ verifyHashSig h sign1C (pubKeyPoint pub1) + assertBool "Key 1, Sign2C" $ not $ verifyHashSig h sign2C (pubKeyPoint pub1) + assertBool "Key 2, Sign1" $ not $ verifyHashSig h sign1 (pubKeyPoint pub2) + assertBool "Key 2, Sign2" $ verifyHashSig h sign2 (pubKeyPoint pub2) + assertBool "Key 2, Sign1C" $ not $ verifyHashSig h sign1C (pubKeyPoint pub2) + assertBool "Key 2, Sign2C" $ verifyHashSig h sign2C (pubKeyPoint pub2) + assertBool "Key 1C, Sign1" $ verifyHashSig h sign1 (pubKeyPoint pub1C) + assertBool "Key 1C, Sign2" $ not $ verifyHashSig h sign2 (pubKeyPoint pub1C) assertBool "Key 1C, Sign1C" $ verifyHashSig h sign1C (pubKeyPoint pub1C) assertBool "Key 1C, Sign2C" $ not $ verifyHashSig h sign2C (pubKeyPoint pub1C) - assertBool "Key 2C, Sign1" $ not $ verifyHashSig h sign1 (pubKeyPoint pub2C) - assertBool "Key 2C, Sign2" $ verifyHashSig h sign2 (pubKeyPoint pub2C) + assertBool "Key 2C, Sign1" $ not $ verifyHashSig h sign1 (pubKeyPoint pub2C) + assertBool "Key 2C, Sign2" $ verifyHashSig h sign2 (pubKeyPoint pub2C) assertBool "Key 2C, Sign1C" $ not $ verifyHashSig h sign1C (pubKeyPoint pub2C) assertBool "Key 2C, Sign2C" $ verifyHashSig h sign2C (pubKeyPoint pub2C) @@ -233,8 +239,8 @@ (signHash (secKeyData sec2C) m) strSecret1, strSecret2, strSecret1C, strSecret2C :: Text -strSecret1 = "5HxWvvfubhXpYYpS3tJkw6fq9jE9j18THftkZjHHfmFiWtmAbrj" -strSecret2 = "5KC4ejrDjv152FGwP386VD1i2NYc5KkfSMyv1nGy1VGDxGHqVY3" +strSecret1 = "5HxWvvfubhXpYYpS3tJkw6fq9jE9j18THftkZjHHfmFiWtmAbrj" +strSecret2 = "5KC4ejrDjv152FGwP386VD1i2NYc5KkfSMyv1nGy1VGDxGHqVY3" strSecret1C = "Kwr371tjA9u2rFSMZjTNun2PXXP3WPZu2afRHTcta6KxEUdm1vEw" strSecret2C = "L3Hq7a8FEQwJkW1M2GNKDW28546Vp5miewcCzSqUD9kCAXrJdS3g" @@ -245,8 +251,8 @@ sec2C = fromJust $ fromWif btc strSecret2C addr1, addr2, addr1C, addr2C :: Text -addr1 = "1QFqqMUD55ZV3PJEJZtaKCsQmjLT6JkjvJ" -addr2 = "1F5y5E5FMc5YzdJtB9hLaUe43GDxEKXENJ" +addr1 = "1QFqqMUD55ZV3PJEJZtaKCsQmjLT6JkjvJ" +addr2 = "1F5y5E5FMc5YzdJtB9hLaUe43GDxEKXENJ" addr1C = "1NoJrossxPBKfCHuJXT4HadJrXRE9Fxiqs" addr2C = "1CRj2HyM1CXWzHAXLQtiGLyggNT9WQqsDs" @@ -254,8 +260,7 @@ strAddressBad = "1HV9Lc3sNHZxwj4Zk6fB38tEmBryq2cBiF" pub1, pub2, pub1C, pub2C :: PubKeyI -pub1 = derivePubKeyI sec1 -pub2 = derivePubKeyI sec2 +pub1 = derivePubKeyI sec1 +pub2 = derivePubKeyI sec2 pub1C = derivePubKeyI sec1C pub2C = derivePubKeyI sec2C - diff --git a/test/Haskoin/NetworkSpec.hs b/test/Haskoin/NetworkSpec.hs --- a/test/Haskoin/NetworkSpec.hs +++ b/test/Haskoin/NetworkSpec.hs @@ -1,24 +1,25 @@ {-# LANGUAGE OverloadedStrings #-} + module Haskoin.NetworkSpec (spec) where -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import Data.Maybe (fromJust) -import Data.Text (Text) -import Data.Word (Word32) -import Haskoin.Address -import Haskoin.Constants -import Haskoin.Keys -import Haskoin.Network -import Haskoin.Transaction -import Haskoin.Util -import Haskoin.Util.Arbitrary -import Haskoin.UtilSpec (customCerealID) -import Test.HUnit (Assertion, assertBool, assertEqual) -import Test.Hspec -import Test.Hspec.QuickCheck -import Test.QuickCheck +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.Maybe (fromJust) +import Data.Text (Text) +import Data.Word (Word32) +import Haskoin.Address +import Haskoin.Constants +import Haskoin.Keys +import Haskoin.Network +import Haskoin.Transaction +import Haskoin.Util +import Haskoin.Util.Arbitrary +import Haskoin.UtilSpec (customCerealID) +import Test.HUnit (Assertion, assertBool, assertEqual) +import Test.Hspec +import Test.Hspec.QuickCheck +import Test.QuickCheck serialVals :: [SerialBox] serialVals = @@ -52,7 +53,7 @@ prop "Data.Serialize Encoding for type Message" $ forAll arbitraryNetwork $ \net -> forAll (arbitraryMessage net) $ - customCerealID (getMessage net) (putMessage net) + customCerealID (getMessage net) (putMessage net) describe "bloom filters" $ do it "bloom filter vector 1" bloomFilter1 it "bloom filter vector 2" bloomFilter2 @@ -100,35 +101,39 @@ bs = fromJust $ decodeHex "038fc16b080000000000000001" relevantOutputUpdated :: Assertion -relevantOutputUpdated = assertBool "Bloom filter output updated" $ - any (bloomContains bf2) spendTxInput - where - bf0 = bloomCreate 10 0.000001 0 BloomUpdateAll - relevantOutputHash = fromJust $ decodeHex"03f47604ea2736334151081e13265b4fe38e6fa8" - bf1 = bloomInsert bf0 relevantOutputHash - bf2 = fromJust $ bloomRelevantUpdate bf1 relevantTx - spendTxInput = runPutS . serialize . prevOutput <$> txIn spendRelevantTx +relevantOutputUpdated = + assertBool "Bloom filter output updated" $ + any (bloomContains bf2) spendTxInput + where + bf0 = bloomCreate 10 0.000001 0 BloomUpdateAll + relevantOutputHash = fromJust $ decodeHex "03f47604ea2736334151081e13265b4fe38e6fa8" + bf1 = bloomInsert bf0 relevantOutputHash + bf2 = fromJust $ bloomRelevantUpdate bf1 relevantTx + spendTxInput = runPutS . serialize . prevOutput <$> txIn spendRelevantTx irrelevantOutputNotUpdated :: Assertion irrelevantOutputNotUpdated = assertEqual "Bloom filter not updated" Nothing bf2 - where - bf0 = bloomCreate 10 0.000001 0 BloomUpdateAll - relevantOutputHash = fromJust $ decodeHex"03f47604ea2736334151081e13265b4fe38e6fa8" - bf1 = bloomInsert bf0 relevantOutputHash - bf2 = bloomRelevantUpdate bf1 unrelatedTx + where + bf0 = bloomCreate 10 0.000001 0 BloomUpdateAll + relevantOutputHash = fromJust $ decodeHex "03f47604ea2736334151081e13265b4fe38e6fa8" + bf1 = bloomInsert bf0 relevantOutputHash + bf2 = bloomRelevantUpdate bf1 unrelatedTx -- Random transaction (57dc904f32ad4daab7b321dd469e8791ad09df784cdd273a73985150a4f225e9) relevantTx :: Tx -relevantTx = Tx +relevantTx = + Tx { txVersion = 1 - , txIn = [ TxIn - { prevOutput = OutPoint "35fe9017b7e3af592920b56fa06ac02faf0c52cdb19dcb416129ac71c95d060e" 1 - , scriptInput = fromJust $ decodeHex "473044022032fc8eef299b7e94b9a986a6aa2dcb9733ab804bef80df995e443b9c1f8c604202203335df7a2e2b4789451cdb4b2b05a786a81c51519eb6a567fd6fe8cd7b2d33fe014104272502dc63a512dad1473cb82a71be9baf4f4303abd1ff6028fc8a78e1f3aec1218907119dec14f07354850758ff0948e88a904fa411c4df7d5444414ec64ad6" - , txInSequence = 4294967295 - } ] + , txIn = + [ TxIn + { prevOutput = OutPoint "35fe9017b7e3af592920b56fa06ac02faf0c52cdb19dcb416129ac71c95d060e" 1 + , scriptInput = fromJust $ decodeHex "473044022032fc8eef299b7e94b9a986a6aa2dcb9733ab804bef80df995e443b9c1f8c604202203335df7a2e2b4789451cdb4b2b05a786a81c51519eb6a567fd6fe8cd7b2d33fe014104272502dc63a512dad1473cb82a71be9baf4f4303abd1ff6028fc8a78e1f3aec1218907119dec14f07354850758ff0948e88a904fa411c4df7d5444414ec64ad6" + , txInSequence = 4294967295 + } + ] , txOut = - [ TxOut { outValue = 100000000, scriptOutput = fromJust $ decodeHex "76a91403f47604ea2736334151081e13265b4fe38e6fa888ac" } - , TxOut { outValue = 107980000, scriptOutput = fromJust $ decodeHex "76a91481cc186a2f4a69f633ed4bf10ef4a78be13effdd88ac" } + [ TxOut{outValue = 100000000, scriptOutput = fromJust $ decodeHex "76a91403f47604ea2736334151081e13265b4fe38e6fa888ac"} + , TxOut{outValue = 107980000, scriptOutput = fromJust $ decodeHex "76a91481cc186a2f4a69f633ed4bf10ef4a78be13effdd88ac"} ] , txWitness = [] , txLockTime = 0 @@ -136,20 +141,24 @@ -- Transaction that spends above (fd6e3b693b844aa431fad46765c1aa019a6b13aebfa9dae916b3ffa43283a300) spendRelevantTx :: Tx -spendRelevantTx = Tx +spendRelevantTx = + Tx { txVersion = 1 - , txIn = [ TxIn - { prevOutput = OutPoint "57dc904f32ad4daab7b321dd469e8791ad09df784cdd273a73985150a4f225e9" 0 - , scriptInput = fromJust $ decodeHex "483045022100ecc334821e4e94cc2fdc841d5ad147d5bb942b993ba81460cc446e0410afa811022015fcbc542b734dbb61a05ec06012095096de5839c50808fe56f2b315e877c20d012103fb64e5792fa586172339b776b7017d3d529358cb73be6406a1fc994228d14f88" - , txInSequence = 4294967295 - }, TxIn - { prevOutput = OutPoint "cfee6a8d6e68e8fd16df6fff010afffcd19d7e075aa7b707dd1bae6adc420042" 0 - , scriptInput = fromJust $ decodeHex "47304402200e6bb95fa606f254d17089d83c4ceeb19c5d1699b4faddcd4f1f1568286e6b650220087fb8439f31e1b30e47710d095422405f601d6151f2f93e125e1a08a6e29ad4012103b49252e8fc6d5b49c8d14ee71fab45591df4a126a6c453c724f3d356e38f0cee" - , txInSequence = 4294967295 - } ] + , txIn = + [ TxIn + { prevOutput = OutPoint "57dc904f32ad4daab7b321dd469e8791ad09df784cdd273a73985150a4f225e9" 0 + , scriptInput = fromJust $ decodeHex "483045022100ecc334821e4e94cc2fdc841d5ad147d5bb942b993ba81460cc446e0410afa811022015fcbc542b734dbb61a05ec06012095096de5839c50808fe56f2b315e877c20d012103fb64e5792fa586172339b776b7017d3d529358cb73be6406a1fc994228d14f88" + , txInSequence = 4294967295 + } + , TxIn + { prevOutput = OutPoint "cfee6a8d6e68e8fd16df6fff010afffcd19d7e075aa7b707dd1bae6adc420042" 0 + , scriptInput = fromJust $ decodeHex "47304402200e6bb95fa606f254d17089d83c4ceeb19c5d1699b4faddcd4f1f1568286e6b650220087fb8439f31e1b30e47710d095422405f601d6151f2f93e125e1a08a6e29ad4012103b49252e8fc6d5b49c8d14ee71fab45591df4a126a6c453c724f3d356e38f0cee" + , txInSequence = 4294967295 + } + ] , txOut = - [ TxOut { outValue = 3851100, scriptOutput = fromJust $ decodeHex "76a914a297cae82a9a3b932bf023ae274fe2585295c9ca88ac" } - , TxOut { outValue = 111000000, scriptOutput = fromJust $ decodeHex "76a9148f952c38600a61385974acc30a64f74407f9801488ac" } + [ TxOut{outValue = 3851100, scriptOutput = fromJust $ decodeHex "76a914a297cae82a9a3b932bf023ae274fe2585295c9ca88ac"} + , TxOut{outValue = 111000000, scriptOutput = fromJust $ decodeHex "76a9148f952c38600a61385974acc30a64f74407f9801488ac"} ] , txWitness = [] , txLockTime = 0 @@ -157,15 +166,18 @@ -- This random transaction is unrelated to the others unrelatedTx :: Tx -unrelatedTx = Tx +unrelatedTx = + Tx { txVersion = 1 - , txIn = [ TxIn - { prevOutput = OutPoint "3ec3a71431c68e5d978a5fb4a0a1081d8bee8384d8aa4c06b1fbaf9413e2214f" 20 - , scriptInput = fromJust $ decodeHex "483045022100ec9c202c9d3140b973aca9d7f21a82138aa4cfa43fddc5419098ac5e26a6f152022010848fd688f290ae010fb5cb493410caa03145fc12445900ec1ad2bde33aecd9012102c7445e72d723f99a0064526c28269d07f47c8fd81531a94a8d3bf5ebd5e23ef1" - , txInSequence = 4294967295 - }] + , txIn = + [ TxIn + { prevOutput = OutPoint "3ec3a71431c68e5d978a5fb4a0a1081d8bee8384d8aa4c06b1fbaf9413e2214f" 20 + , scriptInput = fromJust $ decodeHex "483045022100ec9c202c9d3140b973aca9d7f21a82138aa4cfa43fddc5419098ac5e26a6f152022010848fd688f290ae010fb5cb493410caa03145fc12445900ec1ad2bde33aecd9012102c7445e72d723f99a0064526c28269d07f47c8fd81531a94a8d3bf5ebd5e23ef1" + , txInSequence = 4294967295 + } + ] , txOut = - [ TxOut { outValue = 12600000, scriptOutput = fromJust $ decodeHex "76a9148fef3b7051de8cc44e966159e7ea37f4520187e888ac" } + [ TxOut{outValue = 12600000, scriptOutput = fromJust $ decodeHex "76a9148fef3b7051de8cc44e966159e7ea37f4520187e888ac"} ] , txWitness = [] , txLockTime = 0 diff --git a/test/Haskoin/ScriptSpec.hs b/test/Haskoin/ScriptSpec.hs --- a/test/Haskoin/ScriptSpec.hs +++ b/test/Haskoin/ScriptSpec.hs @@ -1,33 +1,35 @@ {-# LANGUAGE OverloadedStrings #-} + module Haskoin.ScriptSpec (spec) where -import Control.Monad -import Data.Aeson as A -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import Data.Either -import Data.List -import Data.Maybe -import Data.String -import Data.String.Conversions (cs) -import Data.Text (Text) -import Data.Word -import Haskoin.Address -import Haskoin.Constants -import Haskoin.Keys -import Haskoin.Script -import Haskoin.Transaction -import Haskoin.Util -import Haskoin.Util.Arbitrary -import Haskoin.UtilSpec (readTestFile) -import Test.HUnit as HUnit -import Test.Hspec -import Test.Hspec.QuickCheck -import Test.QuickCheck -import Text.Read +import Control.Monad +import Data.Aeson as A +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.Either +import Data.List +import Data.Maybe +import Data.String +import Data.String.Conversions (cs) +import Data.Text (Text) +import Data.Word +import Haskoin.Address +import Haskoin.Constants +import Haskoin.Data +import Haskoin.Keys +import Haskoin.Script +import Haskoin.Transaction +import Haskoin.Util +import Haskoin.Util.Arbitrary +import Haskoin.UtilSpec (readTestFile) +import Test.HUnit as HUnit +import Test.Hspec +import Test.Hspec.QuickCheck +import Test.QuickCheck +import Text.Read serialVals :: [SerialBox] serialVals = @@ -64,7 +66,7 @@ zipWithM_ (curry (sigDecodeMap btc)) scriptSigSignatures [0 ..] describe "SigHashFlag fromEnum/toEnum" $ prop "fromEnum/toEnum" $ - forAll arbitrarySigHashFlag $ \f -> toEnum (fromEnum f) `shouldBe` f + forAll arbitrarySigHashFlag $ \f -> toEnum (fromEnum f) `shouldBe` f describe "Script vectors" $ it "Can encode script vectors" encodeScriptVector @@ -92,139 +94,145 @@ prop "can sort multisig scripts" $ forAll arbitraryMSOutput $ \out -> map - (runPutS . serialize) - (getOutputMulSigKeys (sortMulSig out)) - `shouldSatisfy` - \xs -> xs == sort xs + (runPutS . serialize) + (getOutputMulSigKeys (sortMulSig out)) + `shouldSatisfy` \xs -> xs == sort xs it "can decode inputs with empty signatures" $ do - decodeInput net (Script [OP_0]) `shouldBe` - Right (RegularInput (SpendPK TxSignatureEmpty)) - decodeInput net (Script [opPushData ""]) `shouldBe` - Right (RegularInput (SpendPK TxSignatureEmpty)) - let pk = derivePubKeyI $ - wrapSecKey True $ fromJust $ secKey $ B.replicate 32 1 + decodeInput net (Script [OP_0]) + `shouldBe` Right (RegularInput (SpendPK TxSignatureEmpty)) + decodeInput net (Script [opPushData ""]) + `shouldBe` Right (RegularInput (SpendPK TxSignatureEmpty)) + let pk = + derivePubKeyI $ + wrapSecKey True $ fromJust $ secKey $ B.replicate 32 1 decodeInput net (Script [OP_0, opPushData $ runPutS $ serialize pk]) - `shouldBe` - Right (RegularInput (SpendPKHash TxSignatureEmpty pk)) + `shouldBe` Right (RegularInput (SpendPKHash TxSignatureEmpty pk)) decodeInput net (Script [OP_0, OP_0]) - `shouldBe` - Right (RegularInput (SpendMulSig [TxSignatureEmpty])) + `shouldBe` Right (RegularInput (SpendMulSig [TxSignatureEmpty])) decodeInput net (Script [OP_0, OP_0, OP_0, OP_0]) - `shouldBe` - Right (RegularInput (SpendMulSig $ replicate 3 TxSignatureEmpty)) + `shouldBe` Right (RegularInput (SpendMulSig $ replicate 3 TxSignatureEmpty)) scriptSpec :: Network -> Spec scriptSpec net = when (getNetworkName net == "btc") $ - it "can verify standard scripts from script_tests.json file" $ do - xs <- readTestFile "script_tests.json" :: IO [A.Value] - let vectorsA = - mapMaybe (A.decode . A.encode) xs :: [( String - , String - , String - , String - , String)] - vectorsB = - mapMaybe (A.decode . A.encode) xs :: [( [Word64] - , String - , String - , String - , String - , String)] - vectors = - map (\(a, b, c, d, e) -> ([0], a, b, c, d, e)) vectorsA <> - vectorsB - length vectors `shouldBe` 86 - forM_ vectors $ \([val], siStr, soStr, flags, res, desc) - -- We can disable specific tests by adding a DISABLED flag in the data - -> - unless ("DISABLED" `isInfixOf` flags) $ do - let _strict = - "DERSIG" `isInfixOf` flags || - "STRICTENC" `isInfixOf` flags || - "NULLDUMMY" `isInfixOf` flags - scriptSig = parseScript siStr - scriptPubKey = parseScript soStr - decodedOutput = decodeOutputBS scriptPubKey - ver = either (const False) $ \so -> - verifyStdInput - net - (spendTx scriptPubKey 0 scriptSig) - 0 - so - (val * 100000000) - case res of - "OK" -> assertBool desc $ ver decodedOutput - _ -> assertBool desc (not $ ver decodedOutput) + it "can verify standard scripts from script_tests.json file" $ do + xs <- readTestFile "script_tests.json" :: IO [A.Value] + let vectorsA = + mapMaybe (A.decode . A.encode) xs :: + [ ( String + , String + , String + , String + , String + ) + ] + vectorsB = + mapMaybe (A.decode . A.encode) xs :: + [ ( [Word64] + , String + , String + , String + , String + , String + ) + ] + vectors = + map (\(a, b, c, d, e) -> ([0], a, b, c, d, e)) vectorsA + <> vectorsB + length vectors `shouldBe` 86 + forM_ vectors $ \([val], siStr, soStr, flags, res, desc) -> + -- We can disable specific tests by adding a DISABLED flag in the data + unless ("DISABLED" `isInfixOf` flags) $ do + let _strict = + "DERSIG" `isInfixOf` flags + || "STRICTENC" `isInfixOf` flags + || "NULLDUMMY" `isInfixOf` flags + scriptSig = parseScript siStr + scriptPubKey = parseScript soStr + decodedOutput = decodeOutputBS scriptPubKey + ver = either (const False) $ \so -> + verifyStdInput + net + (spendTx scriptPubKey 0 scriptSig) + 0 + so + (val * 100000000) + case res of + "OK" -> assertBool desc $ ver decodedOutput + _ -> assertBool desc (not $ ver decodedOutput) + forkIdScriptSpec :: Network -> Spec forkIdScriptSpec net = when (isJust (getSigHashForkId net)) $ - it "can verify scripts from forkid_script_tests.json file" $ do - xs <- readTestFile "forkid_script_tests.json" :: IO [A.Value] - let vectors = - mapMaybe (A.decode . A.encode) xs :: [( [Word64] - , String - , String - , String - , String - , String)] - length vectors `shouldBe` 3 - forM_ vectors $ \([valBTC], siStr, soStr, _, res, _) -> do - let val = valBTC * 100000000 - scriptSig = parseScript siStr - scriptPubKey = parseScript soStr - decodedOutput = - fromRight (error $ "Could not decode output: " <> soStr) $ - decodeOutputBS scriptPubKey - ver = - verifyStdInput - net - (spendTx scriptPubKey val scriptSig) - 0 - decodedOutput - val - case res of - "OK" -> ver `shouldBe` True - _ -> ver `shouldBe` False + it "can verify scripts from forkid_script_tests.json file" $ do + xs <- readTestFile "forkid_script_tests.json" :: IO [A.Value] + let vectors = + mapMaybe (A.decode . A.encode) xs :: + [ ( [Word64] + , String + , String + , String + , String + , String + ) + ] + length vectors `shouldBe` 3 + forM_ vectors $ \([valBTC], siStr, soStr, _, res, _) -> do + let val = valBTC * 100000000 + scriptSig = parseScript siStr + scriptPubKey = parseScript soStr + decodedOutput = + fromRight (error $ "Could not decode output: " <> soStr) $ + decodeOutputBS scriptPubKey + ver = + verifyStdInput + net + (spendTx scriptPubKey val scriptSig) + 0 + decodedOutput + val + case res of + "OK" -> ver `shouldBe` True + _ -> ver `shouldBe` False creditTx :: ByteString -> Word64 -> Tx creditTx scriptPubKey val = Tx 1 [txI] [txO] [] 0 where - txO = TxOut {outValue = val, scriptOutput = scriptPubKey} + txO = TxOut{outValue = val, scriptOutput = scriptPubKey} txI = TxIn - { prevOutput = nullOutPoint - , scriptInput = runPutS $ serialize $ Script [OP_0, OP_0] - , txInSequence = maxBound - } + { prevOutput = nullOutPoint + , scriptInput = runPutS $ serialize $ Script [OP_0, OP_0] + , txInSequence = maxBound + } spendTx :: ByteString -> Word64 -> ByteString -> Tx spendTx scriptPubKey val scriptSig = Tx 1 [txI] [txO] [] 0 where - txO = TxOut {outValue = val, scriptOutput = B.empty} + txO = TxOut{outValue = val, scriptOutput = B.empty} txI = TxIn - { prevOutput = OutPoint (txHash $ creditTx scriptPubKey val) 0 - , scriptInput = scriptSig - , txInSequence = maxBound - } + { prevOutput = OutPoint (txHash $ creditTx scriptPubKey val) 0 + , scriptInput = scriptSig + , txInSequence = maxBound + } parseScript :: String -> ByteString parseScript str = B.concat $ fromMaybe err $ mapM f $ words str where f = decodeHex . cs . dropHex . replaceToken - dropHex ('0':'x':xs) = xs - dropHex xs = xs + dropHex ('0' : 'x' : xs) = xs + dropHex xs = xs err = error $ "Could not decode script: " <> str replaceToken :: String -> String replaceToken str = case readMaybe $ "OP_" <> str of Just opcode -> "0x" <> cs (encodeHex $ runPutS $ serialize (opcode :: ScriptOp)) - _ -> str + _ -> str strictSigSpec :: Network -> Spec strictSigSpec net = @@ -245,47 +253,53 @@ txSigHashSpec :: Network -> Spec txSigHashSpec net = when (getNetworkName net == "btc") $ - it "can produce valid sighashes from sighash.json test vectors" $ do - xs <- readTestFile "sighash.json" :: IO [A.Value] - let vectors = - mapMaybe (A.decode . A.encode) xs :: [( String - , String - , Int - , Integer - , String)] - length vectors `shouldBe` 500 - forM_ vectors $ \(txStr, scpStr, i, shI, resStr) -> do - let tx = fromString txStr - s = - fromMaybe (error $ "Could not decode script: " <> cs scpStr) $ - eitherToMaybe . runGetS deserialize =<< decodeHex (cs scpStr) - sh = fromIntegral shI - res = - eitherToMaybe . runGetS deserialize . B.reverse =<< - decodeHex (cs resStr) - Just (txSigHash net tx s 0 i sh) `shouldBe` res + it "can produce valid sighashes from sighash.json test vectors" $ do + xs <- readTestFile "sighash.json" :: IO [A.Value] + let vectors = + mapMaybe (A.decode . A.encode) xs :: + [ ( String + , String + , Int + , Integer + , String + ) + ] + length vectors `shouldBe` 500 + forM_ vectors $ \(txStr, scpStr, i, shI, resStr) -> do + let tx = fromString txStr + s = + fromMaybe (error $ "Could not decode script: " <> cs scpStr) $ + eitherToMaybe . runGetS deserialize =<< decodeHex (cs scpStr) + sh = fromIntegral shI + res = + eitherToMaybe . runGetS deserialize . B.reverse + =<< decodeHex (cs resStr) + Just (txSigHash net tx s 0 i sh) `shouldBe` res txSigHashForkIdSpec :: Network -> Spec txSigHashForkIdSpec net = when (getNetworkName net == "btc") $ - it "can produce valid sighashes from forkid_sighash.json test vectors" $ do - xs <- readTestFile "forkid_sighash.json" :: IO [A.Value] - let vectors = - mapMaybe (A.decode . A.encode) xs :: [( String - , String - , Int - , Word64 - , Integer - , String)] - length vectors `shouldBe` 13 - forM_ vectors $ \(txStr, scpStr, i, val, shI, resStr) -> do - let tx = fromString txStr - s = - fromMaybe (error $ "Could not decode script: " <> cs scpStr) $ - eitherToMaybe . runGetS deserialize =<< decodeHex (cs scpStr) - sh = fromIntegral shI - res = eitherToMaybe . runGetS deserialize =<< decodeHex (cs resStr) - Just (txSigHashForkId net tx s val i sh) `shouldBe` res + it "can produce valid sighashes from forkid_sighash.json test vectors" $ do + xs <- readTestFile "forkid_sighash.json" :: IO [A.Value] + let vectors = + mapMaybe (A.decode . A.encode) xs :: + [ ( String + , String + , Int + , Word64 + , Integer + , String + ) + ] + length vectors `shouldBe` 13 + forM_ vectors $ \(txStr, scpStr, i, val, shI, resStr) -> do + let tx = fromString txStr + s = + fromMaybe (error $ "Could not decode script: " <> cs scpStr) $ + eitherToMaybe . runGetS deserialize =<< decodeHex (cs scpStr) + sh = fromIntegral shI + res = eitherToMaybe . runGetS deserialize =<< decodeHex (cs resStr) + Just (txSigHashForkId net tx s val i sh) `shouldBe` res sigHashSpec :: Network -> Spec sigHashSpec net = do @@ -293,8 +307,8 @@ show (0x00 :: SigHash) `shouldBe` "SigHash " <> show (0x00 :: Word32) show (0x01 :: SigHash) `shouldBe` "SigHash " <> show (0x01 :: Word32) show (0xff :: SigHash) `shouldBe` "SigHash " <> show (0xff :: Word32) - show (0xabac3344 :: SigHash) `shouldBe` "SigHash " <> - show (0xabac3344 :: Word32) + show (0xabac3344 :: SigHash) `shouldBe` "SigHash " + <> show (0xabac3344 :: Word32) it "can add a forkid" $ do 0x00 `sigHashAddForkId` 0x00 `shouldBe` 0x00 0xff `sigHashAddForkId` 0x00ffffff `shouldBe` 0xffffffff @@ -333,18 +347,18 @@ isSigHashUnknown 0x04 `shouldBe` True it "can decodeTxSig . encode a TxSignature" $ property $ - forAll (arbitraryTxSignature net) $ \(_, _, ts) -> - decodeTxSig net (encodeTxSig ts) `shouldBe` Right ts + forAll (arbitraryTxSignature net) $ \(_, _, ts) -> + decodeTxSig net (encodeTxSig ts) `shouldBe` Right ts it "can produce the sighash one" $ property $ - forAll (arbitraryTx net) $ forAll arbitraryScript . testSigHashOne net + forAll (arbitraryTx net) $ forAll arbitraryScript . testSigHashOne net testSigHashOne :: Network -> Tx -> Script -> Word64 -> Bool -> Property testSigHashOne net tx s val acp = - not (null $ txIn tx) ==> - if length (txIn tx) > length (txOut tx) - then res `shouldBe` one - else res `shouldNotBe` one + not (null $ txIn tx) + ==> if length (txIn tx) > length (txOut tx) + then res `shouldBe` one + else res `shouldNotBe` one where res = txSigHash net tx s val (length (txIn tx) - 1) (f sigHashSingle) one = "0100000000000000000000000000000000000000000000000000000000000000" @@ -382,30 +396,32 @@ testSigDecode net str = let bs = fromJust $ decodeHex str eitherSig = decodeTxSig net bs - in assertBool - (unwords + in assertBool + ( unwords [ "Decode failed:" , fromLeft (error "Decode did not fail") eitherSig - ]) $ - isRight eitherSig + ] + ) + $ isRight eitherSig mulSigVectors :: [(Text, Text)] mulSigVectors = - [ ( "3QJmV3qfvL9SuYo34YihAf3sRCW3qSinyC" - , "52410491bba2510912a5bd37da1fb5b1673010e43d2c6d812c514e91bfa9f2eb\ - \129e1c183329db55bd868e209aac2fbc02cb33d98fe74bf23f0c235d6126b1d8\ - \334f864104865c40293a680cb9c020e7b1e106d8c1916d3cef99aa431a56d253\ - \e69256dac09ef122b1a986818a7cb624532f062c1d1f8722084861c5c3291ccf\ - \fef4ec687441048d2455d2403e08708fc1f556002f1b6cd83f992d085097f997\ - \4ab08a28838f07896fbab08f39495e15fa6fad6edbfb1e754e35fa1c7844c41f\ - \322a1863d4621353ae" - ) + [ + ( "3QJmV3qfvL9SuYo34YihAf3sRCW3qSinyC" + , "52410491bba2510912a5bd37da1fb5b1673010e43d2c6d812c514e91bfa9f2eb\ + \129e1c183329db55bd868e209aac2fbc02cb33d98fe74bf23f0c235d6126b1d8\ + \334f864104865c40293a680cb9c020e7b1e106d8c1916d3cef99aa431a56d253\ + \e69256dac09ef122b1a986818a7cb624532f062c1d1f8722084861c5c3291ccf\ + \fef4ec687441048d2455d2403e08708fc1f556002f1b6cd83f992d085097f997\ + \4ab08a28838f07896fbab08f39495e15fa6fad6edbfb1e754e35fa1c7844c41f\ + \322a1863d4621353ae" + ) ] scriptSigSignatures :: [Text] scriptSigSignatures = - -- Signature in input of txid - -- 1983a69265920c24f89aac81942b1a59f7eb30821a8b3fb258f88882b6336053 + -- Signature in input of txid + -- 1983a69265920c24f89aac81942b1a59f7eb30821a8b3fb258f88882b6336053 [ "304402205ca6249f43538908151fe67b26d020306c0e59fa206cf9f3ccf641f333\ \57119d02206c82f244d04ac0a48024fb9cc246b66e58598acf206139bdb7b75a29\ \41a2b1e401" @@ -431,16 +447,17 @@ s = Script [ OP_1 - , opPushData $ d - "04cc71eb30d653c0c3163990c47b976f3fb3f37cccdcbedb169a1dfef5\ - \8bbfbfaff7d8a473e7e2e6d317b87bafe8bde97e3cf8f065dec022b51d\ - \11fcdd0d348ac4" - , opPushData $ d - "0461cbdcc5409fb4b4d42b51d33381354d80e550078cb532a34bfa2fcf\ - \deb7d76519aecc62770f5b0e4ef8551946d8a540911abe3e7854a26f39\ - \f58b25c15342af" + , opPushData $ + d + "04cc71eb30d653c0c3163990c47b976f3fb3f37cccdcbedb169a1dfef5\ + \8bbfbfaff7d8a473e7e2e6d317b87bafe8bde97e3cf8f065dec022b51d\ + \11fcdd0d348ac4" + , opPushData $ + d + "0461cbdcc5409fb4b4d42b51d33381354d80e550078cb532a34bfa2fcf\ + \deb7d76519aecc62770f5b0e4ef8551946d8a540911abe3e7854a26f39\ + \f58b25c15342af" , OP_2 , OP_CHECKMULTISIG ] d = fromJust . decodeHex - diff --git a/test/Haskoin/Transaction/PartialSpec.hs b/test/Haskoin/Transaction/PartialSpec.hs --- a/test/Haskoin/Transaction/PartialSpec.hs +++ b/test/Haskoin/Transaction/PartialSpec.hs @@ -2,30 +2,35 @@ module Haskoin.Transaction.PartialSpec (spec) where -import Control.Monad.Fail (MonadFail) -import Data.ByteString (ByteString) -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import Data.Either (fromRight, isLeft, isRight) -import Data.HashMap.Strict (fromList, singleton) -import Data.Maybe (fromJust, isJust) -import Data.Serialize as S -import Data.Text (Text) -import Test.HUnit (Assertion, assertBool, - assertEqual) -import Test.Hspec -import Test.QuickCheck +import Data.ByteString (ByteString) +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.Either (fromRight, isLeft, isRight) +import Data.HashMap.Strict (fromList, singleton) +import Data.Maybe (fromJust, isJust) +import Data.Serialize as S +import Data.Text (Text) +import Test.HUnit (Assertion, assertBool, assertEqual) +import Test.Hspec +import Test.QuickCheck -import Haskoin.Address -import Haskoin.Constants -import Haskoin.Crypto -import Haskoin.Keys -import Haskoin.Script -import Haskoin.Transaction -import Haskoin.Transaction.Partial -import Haskoin.Util -import Haskoin.Util.Arbitrary +import Control.Monad ((<=<)) +import Data.Aeson (FromJSON, parseJSON, withObject, (.:)) +import Data.Bifunctor (first) +import Data.ByteString.Base64 (decodeBase64) +import qualified Data.Text as Text +import Data.Text.Encoding (encodeUtf8) +import Haskoin.Address +import Haskoin.Constants +import Haskoin.Crypto +import Haskoin.Data +import Haskoin.Keys +import Haskoin.Script +import Haskoin.Transaction +import Haskoin.Util +import Haskoin.Util.Arbitrary +import Haskoin.UtilSpec (readTestFile) spec :: Spec spec = describe "partially signed bitcoin transaction unit tests" $ do @@ -40,16 +45,22 @@ it "encodes valid bip vecs" $ mapM_ (uncurry encodeVecTest) validEncodeVec it "decodes valid bip vecs" $ - mapM_ (uncurry decodeVecTest) $ zip [1..] validVec + mapM_ (uncurry decodeVecTest) $ zip [1 ..] validVec it "decodes vector 2" vec2Test it "decodes vector 3" vec3Test it "decodes vector 4" vec4Test it "decodes vector 5" vec5Test it "decodes vector 6" vec6Test - it "signed and finalized p2pkh PSBTs verify" $ property $ - forAll arbitraryKeyPair $ verifyNonWitnessPSBT btc . unfinalizedPkhPSBT btc - it "signed and finalized multisig PSBTs verify" $ property $ - forAll arbitraryMultiSig $ verifyNonWitnessPSBT btc . unfinalizedMsPSBT btc + it "signed and finalized p2pkh PSBTs verify" $ + property $ + forAll arbitraryKeyPair $ verifyNonWitnessPSBT btc . unfinalizedPkhPSBT btc + it "signed and finalized multisig PSBTs verify" $ + property $ + forAll arbitraryMultiSig $ verifyNonWitnessPSBT btc . unfinalizedMsPSBT btc + it "encodes and decodes psbt with final witness script" $ + (fmap (encodeHex . S.encode) . decodeHexPSBT) validVec7Hex == Right validVec7Hex + it "handles complex psbts correctly" complexPsbtTest + it "calculates keys properly" psbtSignerTest vec2Test :: Assertion vec2Test = do @@ -64,7 +75,7 @@ let scrptPubKey = witnessScriptPubKey $ inputs psbt !! 1 rdmScriptP2SH = toP2SH rdmScript assertEqual "redeem script pubkey equal" rdmScriptP2SH scrptPubKey - assertEqual "expected redeem script" expectedOut rdmScriptP2SH + assertEqual "expected redeem script" expectedOut rdmScriptP2SH mapM_ (assertEqual "outputs are empty" emptyOutput) (outputs psbt) @@ -78,8 +89,11 @@ Just utx = nonWitnessUtxo firstInput OutPoint prevHash prevVOut = prevOutput txInput assertEqual "txids of inputs match" prevHash (txHash utx) - let prevOutputKey = fromRight (error "Could not decode key") - . decodeOutputBS . scriptOutput $ txOut utx !! fromIntegral prevVOut + let prevOutputKey = + fromRight (error "Could not decode key") + . decodeOutputBS + . scriptOutput + $ txOut utx !! fromIntegral prevVOut assertBool "p2pkh" $ isPayPKHash prevOutputKey assertEqual "sighash type" sigHashAll (fromJust $ sigHashType firstInput) @@ -99,17 +113,15 @@ let scrptPubKey = witnessScriptPubKey secondInput rdmScriptP2SH = toP2SH rdmScript assertEqual "redeem script pubkey equal" rdmScriptP2SH scrptPubKey - assertEqual "expected redeem script" expectedOut rdmScriptP2SH + assertEqual "expected redeem script" expectedOut rdmScriptP2SH assertBool "all non-empty outputs" $ emptyOutput `notElem` outputs psbt vec5Test :: Assertion vec5Test = do psbt <- decodeHexPSBTM "Cannot parse validVec5" validVec5Hex - assertEqual "1 input" 1 (length $ inputs psbt) - assertEqual "1 output" 1 (length $ outputs psbt) + assertEqual "Correctly decode PSBT" expectedPsbt psbt let input = head $ inputs psbt - assertEqual "input not final script sig" Nothing (finalScriptSig input) let rdmScript = fromJust $ inputRedeemScript input assertBool "p2wsh" $ (isPayWitnessScriptHash <$> decodeOutput rdmScript) == Right True @@ -117,10 +129,105 @@ let scrptPubKey = witnessScriptPubKey input rdmScriptP2SH = toP2SH rdmScript assertEqual "redeem script pubkey equal" rdmScriptP2SH scrptPubKey - assertEqual "expected redeem script" expectedOut2 rdmScriptP2SH + assertEqual "expected redeem script" expectedOut2 rdmScriptP2SH where - expectedOut2 = fromRight (error "could not decode expected output") - . decodeOutputBS . fromJust $ decodeHex "a9146345200f68d189e1adc0df1c4d16ea8f14c0dbeb87" + expectedOut2 = + fromRight (error "could not decode expected output") + . decodeOutputBS + . fromJust + $ decodeHex "a9146345200f68d189e1adc0df1c4d16ea8f14c0dbeb87" + -- From the bitcoind decodepsbt rpc call + expectedPsbt = + PartiallySignedTransaction + { unsignedTransaction = + Tx + { txVersion = 2 + , txIn = + [ TxIn + { prevOutput = + OutPoint + { outPointHash = "39bc5c3b33d66ce3d7852a7942331e3ec10f8ba50f225fc41fb5dfa523239a27" + , outPointIndex = 0 + } + , scriptInput = "" + , txInSequence = 4294967295 + } + ] + , txOut = + [ TxOut + { outValue = 199908000 + , scriptOutput = (fromJust . decodeHex) "76a914ffe9c0061097cc3b636f2cb0460fa4fc427d2b4588ac" + } + ] + , txWitness = mempty + , txLockTime = 0 + } + , globalUnknown = mempty + , inputs = + [ Input + { nonWitnessUtxo = Nothing + , witnessUtxo = + Just + ( TxOut + { outValue = 199909013 + , scriptOutput = (fromJust . decodeHex) "a9146345200f68d189e1adc0df1c4d16ea8f14c0dbeb87" + } + ) + , partialSigs = + fromList + [ + ( PubKeyI + { pubKeyPoint = "03b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd46" + , pubKeyCompressed = True + } + , (fromJust . decodeHex) "304302200424b58effaaa694e1559ea5c93bbfd4a89064224055cdf070b6771469442d07021f5c8eb0fea6516d60b8acb33ad64ede60e8785bfb3aa94b99bdf86151db9a9a01" + ) + ] + , sigHashType = Nothing + , inputRedeemScript = + Just + . fromRight (error "vec5Test: Could not decode redeem script") + . decode + . fromJust + $ decodeHex "0020771fd18ad459666dd49f3d564e3dbc42f4c84774e360ada16816a8ed488d5681" + , inputWitnessScript = + Just + . fromRight (error "vec5Test: Could not decode witness script") + . decode + . fromJust + $ decodeHex "522103b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd462103de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd52ae" + , inputHDKeypaths = + fromList + [ + ( PubKeyI + { pubKeyPoint = "03b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd46" + , pubKeyCompressed = True + } + , ("b4a6ba67", [hardIndex 0, hardIndex 0, hardIndex 4]) + ) + , + ( PubKeyI + { pubKeyPoint = "03de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd" + , pubKeyCompressed = True + } + , ("b4a6ba67", [hardIndex 0, hardIndex 0, hardIndex 5]) + ) + ] + , finalScriptSig = Nothing + , finalScriptWitness = Nothing + , inputUnknown = mempty + } + ] + , outputs = + [ Output + { outputRedeemScript = Nothing + , outputWitnessScript = Nothing + , outputHDKeypaths = mempty + , outputUnknown = mempty + } + ] + } + hardIndex = (+ 2 ^ 31) vec6Test :: Assertion vec6Test = do @@ -133,17 +240,78 @@ assertEqual "correct unknowns" expectedUnknowns (inputUnknown . head $ inputs psbt) where - expectedUnknowns = UnknownMap $ singleton - (Key 0x0f (fromJust $ decodeHex "010203040506070809")) - (fromJust $ decodeHex "0102030405060708090a0b0c0d0e0f") + expectedUnknowns = + UnknownMap $ + singleton + (Key 0x0f (fromJust $ decodeHex "010203040506070809")) + (fromJust $ decodeHex "0102030405060708090a0b0c0d0e0f") +complexPsbtTest :: Assertion +complexPsbtTest = do + complexPsbtData <- readTestFile "complex_psbt.json" + + let computedCombinedPsbt = mergeMany $ complexSignedPsbts complexPsbtData + expectedCombinedPsbt = stripRedundantUtxos $ complexCombinedPsbt complexPsbtData + assertEqual "combined psbt" computedCombinedPsbt (Just expectedCombinedPsbt) + + let computedCompletePsbt = complete $ complexCombinedPsbt complexPsbtData + expectedCompletePsbt = complexCompletePsbt complexPsbtData + assertEqual "complete psbt" computedCompletePsbt expectedCompletePsbt + + let computedFinalTx = finalTransaction $ complexCompletePsbt complexPsbtData + assertEqual "final tx" computedFinalTx (complexFinalTx complexPsbtData) + where + stripRedundantUtxos psbt = psbt{inputs = stripRedundantUtxo <$> inputs psbt} + stripRedundantUtxo input + | Just{} <- witnessUtxo input = input{nonWitnessUtxo = Nothing} + | otherwise = input + +psbtSignerTest :: Assertion +psbtSignerTest = do + assertEqual "recover explicit secret key" (Just theSecKey) (getSignerKey signer thePubKey Nothing) + assertEqual + "recover key for origin path" + (Just originPathSecKey) + (getSignerKey signer originPathPubKey (Just (rootFP, originKeyPath))) + assertEqual + "recover key for direct path" + (Just directPathSecKey) + (getSignerKey signer directPathPubKey (Just (keyFP, directPath))) + where + signer = secKeySigner theSecKey <> xPrvSigner xprv (Just origin) + + Just theSecKey = secKey "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" + thePubKey = PubKeyI{pubKeyPoint = derivePubKey theSecKey, pubKeyCompressed = True} + + rootXPrv = makeXPrvKey "psbtSignerTest" + rootFP = xPubFP $ deriveXPubKey rootXPrv + xprv = derivePath keyPath rootXPrv + keyFP = xPubFP $ deriveXPubKey xprv + keyPath = Deriv :| 444 + origin = (rootFP, keyPath) + + originKeyPath = Deriv :| 444 :/ 0 + originPathSecKey = xPrvKey $ derivePath originKeyPath rootXPrv + originPathPubKey = PubKeyI{pubKeyPoint = derivePubKey originPathSecKey, pubKeyCompressed = True} + + directPath = Deriv :/ 1 + directPathSecKey = xPrvKey $ derivePath directPath xprv + directPathPubKey = PubKeyI{pubKeyPoint = derivePubKey directPathSecKey, pubKeyCompressed = True} + expectedOut :: ScriptOutput -expectedOut = fromRight (error "could not decode expected output") - . decodeOutputBS . fromJust $ decodeHex "a9143545e6e33b832c47050f24d3eeb93c9c03948bc787" +expectedOut = + fromRight (error "could not decode expected output") + . decodeOutputBS + . fromJust + $ decodeHex "a9143545e6e33b832c47050f24d3eeb93c9c03948bc787" witnessScriptPubKey :: Input -> ScriptOutput -witnessScriptPubKey = fromRight (error "could not decode witness utxo") - . decodeOutputBS . scriptOutput . fromJust . witnessUtxo +witnessScriptPubKey = + fromRight (error "could not decode witness utxo") + . decodeOutputBS + . scriptOutput + . fromJust + . witnessUtxo decodeHexPSBT :: Text -> Either String PartiallySignedTransaction decodeHexPSBT = S.decode . fromJust . decodeHex @@ -153,8 +321,10 @@ hexScript :: Text -> ByteString hexScript = - either (error "Could not decode script") encodeScript . - runGetS deserialize . fromJust . decodeHex + either (error "Could not decode script") encodeScript + . runGetS deserialize + . fromJust + . decodeHex where encodeScript :: Script -> ByteString encodeScript = runPutS . serialize @@ -169,12 +339,13 @@ encodeVecTest psbt hex = assertEqual "encodes correctly" (S.encode psbt) (fromJust $ decodeHex hex) trivialPSBT :: PartiallySignedTransaction -trivialPSBT = PartiallySignedTransaction - { unsignedTransaction = Tx { txVersion = 2, txIn = [], txOut = [], txWitness = [], txLockTime = 0 } - , globalUnknown = UnknownMap mempty - , inputs = [] - , outputs = [] - } +trivialPSBT = + PartiallySignedTransaction + { unsignedTransaction = Tx{txVersion = 2, txIn = [], txOut = [], txWitness = [], txLockTime = 0} + , globalUnknown = UnknownMap mempty + , inputs = [] + , outputs = [] + } trivialPSBTHex :: Text trivialPSBTHex = "70736274ff01000a0200000000000000000000" @@ -188,22 +359,24 @@ sigData = inputSigData =<< zip (inputs psbt) (txIn $ unsignedTransaction psbt) decodeOutScript = fromRight (error "Could not parse output script") . decodeOutputBS inputSigData (input, txInput) = - map (\(TxOut val script) -> (decodeOutScript script, val, prevOutput txInput)) + map + (\(TxOut val script) -> (decodeOutScript script, val, prevOutput txInput)) (txOut . fromJust $ nonWitnessUtxo input) unfinalizedPkhPSBT :: Network -> (SecKeyI, PubKeyI) -> PartiallySignedTransaction -unfinalizedPkhPSBT net (prvKey, pubKey) = (emptyPSBT currTx) - { inputs = [ emptyInput { nonWitnessUtxo = Just prevTx, partialSigs = singleton pubKey sig } ] } +unfinalizedPkhPSBT net (prvKey, pubKey) = + (emptyPSBT currTx) + { inputs = [emptyInput{nonWitnessUtxo = Just prevTx, partialSigs = singleton pubKey sig}] + } where currTx = unfinalizedTx (txHash prevTx) prevTx = testUtxo [prevOut] prevOutScript = addressToScript (pubKeyAddr pubKey) prevOut = TxOut - { - outValue = 200000000, - scriptOutput = runPutS (serialize prevOutScript) - } + { outValue = 200000000 + , scriptOutput = runPutS (serialize prevOutScript) + } h = txSigHash net currTx prevOutScript (outValue prevOut) 0 sigHashAll sig = encodeTxSig $ TxSignature (signHash (secKeyData prvKey) h) sigHashAll @@ -214,30 +387,39 @@ return (keys, m) unfinalizedMsPSBT :: Network -> ([(SecKeyI, PubKeyI)], Int) -> PartiallySignedTransaction -unfinalizedMsPSBT net (keys, m) = (emptyPSBT currTx) - { inputs = [ emptyInput { nonWitnessUtxo = Just prevTx, partialSigs = sigs - , inputRedeemScript = Just prevOutScript - } ] } +unfinalizedMsPSBT net (keys, m) = + (emptyPSBT currTx) + { inputs = + [ emptyInput + { nonWitnessUtxo = Just prevTx + , partialSigs = sigs + , inputRedeemScript = Just prevOutScript + } + ] + } where currTx = unfinalizedTx (txHash prevTx) prevTx = testUtxo [prevOut] prevOutScript = encodeOutput $ PayMulSig (map snd keys) m - prevOut = TxOut { outValue = 200000000, scriptOutput = encodeOutputBS (toP2SH prevOutScript) } + prevOut = TxOut{outValue = 200000000, scriptOutput = encodeOutputBS (toP2SH prevOutScript)} h = txSigHash net currTx prevOutScript (outValue prevOut) 0 sigHashAll sigs = fromList $ map sig keys sig (prvKey, pubKey) = (pubKey, encodeTxSig $ TxSignature (signHash (secKeyData prvKey) h) sigHashAll) unfinalizedTx :: TxHash -> Tx -unfinalizedTx prevHash = Tx +unfinalizedTx prevHash = + Tx { txVersion = 2 - , txIn = [ TxIn - { prevOutput = OutPoint prevHash 0 - , scriptInput = "" - , txInSequence = 4294967294 - } ] + , txIn = + [ TxIn + { prevOutput = OutPoint prevHash 0 + , scriptInput = "" + , txInSequence = 4294967294 + } + ] , txOut = - [ TxOut { outValue = 99999699, scriptOutput = hexScript "76a914d0c59903c5bac2868760e90fd521a4665aa7652088ac" } - , TxOut { outValue = 100000000, scriptOutput = hexScript "a9143545e6e33b832c47050f24d3eeb93c9c03948bc787" } + [ TxOut{outValue = 99999699, scriptOutput = hexScript "76a914d0c59903c5bac2868760e90fd521a4665aa7652088ac"} + , TxOut{outValue = 100000000, scriptOutput = hexScript "a9143545e6e33b832c47050f24d3eeb93c9c03948bc787"} ] , txWitness = [] , txLockTime = 1257139 @@ -265,28 +447,31 @@ , "70736274ff0100730200000001301ae986e516a1ec8ac5b4bc6573d32f83b465e23ad76167d68b38e730b4dbdb0000000000ffffffff02747b01000000000017a91403aa17ae882b5d0d54b25d63104e4ffece7b9ea2876043993b0000000017a914b921b1ba6f722e4bfa83b6557a3139986a42ec8387000000000001011f00ca9a3b00000000160014d2d94b64ae08587eefc8eeb187c601e939f9037c00010016001462e9e982fff34dd8239610316b090cd2a3b747cb000100220020876bad832f1d168015ed41232a9ea65a1815d9ef13c0ef8759f64b5b2b278a6521010025512103b7ce23a01c5b4bf00a642537cdfabb315b668332867478ef51309d2bd57f8a8751ae00" ] - validEncodeVec :: [(PartiallySignedTransaction, Text)] validEncodeVec = [(validVec1, validVec1Hex)] testTx1 :: Tx -testTx1 = Tx +testTx1 = + Tx { txVersion = 2 - , txIn = [ TxIn - { prevOutput = OutPoint "f61b1742ca13176464adb3cb66050c00787bb3a4eead37e985f2df1e37718126" 0 - , scriptInput = "" - , txInSequence = 4294967294 - } ] + , txIn = + [ TxIn + { prevOutput = OutPoint "f61b1742ca13176464adb3cb66050c00787bb3a4eead37e985f2df1e37718126" 0 + , scriptInput = "" + , txInSequence = 4294967294 + } + ] , txOut = - [ TxOut { outValue = 99999699, scriptOutput = hexScript "76a914d0c59903c5bac2868760e90fd521a4665aa7652088ac" } - , TxOut { outValue = 100000000, scriptOutput = hexScript "a9143545e6e33b832c47050f24d3eeb93c9c03948bc787" } + [ TxOut{outValue = 99999699, scriptOutput = hexScript "76a914d0c59903c5bac2868760e90fd521a4665aa7652088ac"} + , TxOut{outValue = 100000000, scriptOutput = hexScript "a9143545e6e33b832c47050f24d3eeb93c9c03948bc787"} ] , txWitness = [] , txLockTime = 1257139 } testUtxo :: [TxOut] -> Tx -testUtxo prevOuts = Tx +testUtxo prevOuts = + Tx { txVersion = 1 , txIn = [ TxIn @@ -303,24 +488,26 @@ , txOut = prevOuts , txWitness = [ - [ fromJust $ decodeHex "304402202712be22e0270f394f568311dc7ca9a68970b8025fdd3b240229f07f8a5f3a240220018b38d7dcd314e734c9276bd6fb40f673325bc4baa144c800d2f2f02db2765c01" - , fromJust $ decodeHex "03d2e15674941bad4a996372cb87e1856d3652606d98562fe39c5e9e7e413f2105" - ] - , [ fromJust $ decodeHex "3045022100d12b852d85dcd961d2f5f4ab660654df6eedcc794c0c33ce5cc309ffb5fce58d022067338a8e0e1725c197fb1a88af59f51e44e4255b20167c8684031c05d1f2592a01" - , fromJust $ decodeHex "0223b72beef0965d10be0778efecd61fcac6f79a4ea169393380734464f84f2ab3" - ] + [ fromJust $ decodeHex "304402202712be22e0270f394f568311dc7ca9a68970b8025fdd3b240229f07f8a5f3a240220018b38d7dcd314e734c9276bd6fb40f673325bc4baa144c800d2f2f02db2765c01" + , fromJust $ decodeHex "03d2e15674941bad4a996372cb87e1856d3652606d98562fe39c5e9e7e413f2105" + ] + , + [ fromJust $ decodeHex "3045022100d12b852d85dcd961d2f5f4ab660654df6eedcc794c0c33ce5cc309ffb5fce58d022067338a8e0e1725c197fb1a88af59f51e44e4255b20167c8684031c05d1f2592a01" + , fromJust $ decodeHex "0223b72beef0965d10be0778efecd61fcac6f79a4ea169393380734464f84f2ab3" + ] ] , txLockTime = 0 } testUtxo1 :: Tx -testUtxo1 = testUtxo - [ TxOut { outValue = 200000000, scriptOutput = hexScript "76a91485cff1097fd9e008bb34af709c62197b38978a4888ac" } - , TxOut { outValue = 190303501938, scriptOutput = hexScript "a914339725ba21efd62ac753a9bcd067d6c7a6a39d0587" } - ] +testUtxo1 = + testUtxo + [ TxOut{outValue = 200000000, scriptOutput = hexScript "76a91485cff1097fd9e008bb34af709c62197b38978a4888ac"} + , TxOut{outValue = 190303501938, scriptOutput = hexScript "a914339725ba21efd62ac753a9bcd067d6c7a6a39d0587"} + ] validVec1 :: PartiallySignedTransaction -validVec1 = (emptyPSBT testTx1) { inputs = [ emptyInput { nonWitnessUtxo = Just testUtxo1 } ] } +validVec1 = (emptyPSBT testTx1){inputs = [emptyInput{nonWitnessUtxo = Just testUtxo1}]} validVec :: [Text] validVec = [validVec1Hex, validVec2Hex, validVec3Hex, validVec4Hex, validVec5Hex, validVec6Hex] @@ -342,3 +529,40 @@ validVec6Hex :: Text validVec6Hex = "70736274ff01003f0200000001ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff0000000000ffffffff010000000000000000036a010000000000000a0f0102030405060708090f0102030405060708090a0b0c0d0e0f0000" + +-- Example of a PSBT with a `finalWitnessScript` +validVec7Hex :: Text +validVec7Hex = "70736274ff0100520200000001815dd29e16fd2f567a040ce24f5337fb9cfd0c05bacd8890714a33edc7cbbc920000000000ffffffff0192f1052a01000000160014ef9ade26f63015d57f4ecdb268d1a9b8d6cd8872000000000001008402000000010000000000000000000000000000000000000000000000000000000000000000ffffffff03510101ffffffff0200f2052a010000001600145f4ffa19dbbe464561c50fc4d8d8ac0b41009dd20000000000000000266a24aa21a9ede2f61c3f71d1defd3fa999dfa36953755c690689799962b48bebd836974e8cf90000000001011f00f2052a010000001600145f4ffa19dbbe464561c50fc4d8d8ac0b41009dd201086b02473044022026a9f7afdb0128970bb3577e536ec3d3dc10c1e82650d11c9da1df9003b31d0202202258b11f962f12e0897c642cd6f38a0181db17197f3693a530c9431eb44dde7d0121033dc786e9628bb6c41c08fceb9b37458ad7a95e7e6b04e0bde45b6879398c3ac100220203a6affb58dda998a4ffdce652feb91038fdfc78c748ae687372e11292af8d312d101c4c5bfc00000080000000800100008000" + +data ComplexPsbtData = ComplexPsbtData + { complexSignedPsbts :: [PartiallySignedTransaction] + , complexCombinedPsbt :: PartiallySignedTransaction + , complexCompletePsbt :: PartiallySignedTransaction + , complexFinalTx :: Tx + } + deriving (Eq, Show) + +instance FromJSON ComplexPsbtData where + parseJSON = withObject "ComplexPsbtData" $ \obj -> do + ComplexPsbtData + <$> sequence + [ psbtField "miner_psbt" obj + , psbtField "p2pkh_psbt" obj + , psbtField "p2sh_ms_1_psbt" obj + , psbtField "p2sh_ms_2_psbt" obj + , psbtField "p2sh_pk_psbt" obj + , psbtField "p2sh_wsh_pk_psbt" obj + , psbtField "p2sh_wsh_ms_1_psbt" obj + , psbtField "p2sh_wsh_ms_2_psbt" obj + , psbtField "p2wpkh_psbt" obj + , psbtField "p2wsh_pk_psbt" obj + , psbtField "p2wsh_ms_1_psbt" obj + , psbtField "p2wsh_ms_2_psbt" obj + ] + <*> psbtField "combined_psbt" obj + <*> psbtField "complete_psbt" obj + <*> (obj .: "final_tx" >>= parseTx) + where + parseTx = either fail pure . (S.decode <=< maybe (Left "hex") Right . decodeHex) + parsePsbt = either fail pure . (S.decode <=< first Text.unpack . decodeBase64) . encodeUtf8 + psbtField fieldName obj = obj .: fieldName >>= parsePsbt diff --git a/test/Haskoin/Transaction/TaprootSpec.hs b/test/Haskoin/Transaction/TaprootSpec.hs new file mode 100644 --- /dev/null +++ b/test/Haskoin/Transaction/TaprootSpec.hs @@ -0,0 +1,189 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +module Haskoin.Transaction.TaprootSpec (spec) where + +import Control.Applicative ((<|>)) +import Control.Monad (zipWithM, (<=<)) +import Data.Aeson (FromJSON (parseJSON), withObject, (.:), (.:?)) +import Data.Aeson.Types (Parser) +import qualified Data.ByteArray as BA +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.Bytes.Get (runGetS) +import Data.Bytes.Put (runPutS) +import Data.Bytes.Serial (deserialize, serialize) +import Data.Text (Text) +import Data.Word (Word8) +import Haskoin ( + MAST (..), + PubKey, + PubKeyI (PubKeyI), + ScriptOutput, + ScriptPathData (..), + TaprootOutput (TaprootOutput), + TaprootWitness (ScriptPathSpend), + XOnlyPubKey (..), + addrToText, + btc, + decodeHex, + encodeTaprootWitness, + getMerkleProofs, + mastCommitment, + outputAddress, + taprootInternalKey, + taprootMAST, + taprootOutputKey, + taprootScriptOutput, + verifyScriptPathData, + ) +import Haskoin.UtilSpec (readTestFile) +import Test.HUnit (assertBool, (@?=)) +import Test.Hspec (Spec, describe, it, runIO) + +spec :: Spec +spec = do + TestVector{testScriptPubKey} <- runIO $ readTestFile "bip341.json" + describe "Taproot" $ do + it "should calculate the correct hashes" $ mapM_ testHashes testScriptPubKey + it "should build the correct output key" $ mapM_ testOutputKey testScriptPubKey + it "should build the correct script output" $ mapM_ testScriptOutput testScriptPubKey + it "should calculate the correct control blocks" $ mapM_ testControlBlocks testScriptPubKey + it "should arrive at the correct address" $ mapM_ testAddress testScriptPubKey + +testHashes :: TestScriptPubKey -> IO () +testHashes testData = + mapM_ checkMASTDetails $ (taprootMAST . tspkGiven) testData + where + checkMASTDetails theMAST = do + -- Leaf hashes + (Just . getLeafHashes) theMAST @?= (spkiLeafHashes . tspkIntermediary) testData + -- Merkle root + (Just . BA.convert . mastCommitment) theMAST @?= (spkiMerkleRoot . tspkIntermediary) testData + + getLeafHashes = \case + MASTBranch branchL branchR -> getLeafHashes branchL <> getLeafHashes branchR + leaf@MASTLeaf{} -> [BA.convert $ mastCommitment leaf] + MASTCommitment{} -> mempty -- The test vectors have complete trees + +testOutputKey :: TestScriptPubKey -> IO () +testOutputKey testData = do + XOnlyPubKey (taprootOutputKey theOutput) @?= theOutputKey + where + theOutput = tspkGiven testData + theOutputKey = XOnlyPubKey . spkiTweakedPubKey $ tspkIntermediary testData + +testScriptOutput :: TestScriptPubKey -> IO () +testScriptOutput testData = + taprootScriptOutput (tspkGiven testData) @?= (spkeScriptPubKey . tspkExpected) testData + +testControlBlocks :: TestScriptPubKey -> IO () +testControlBlocks testData = do + mapM_ onExamples exampleControlBlocks + mapM_ checkVerification scriptPathSpends + where + theOutput = tspkGiven testData + theOutputKey = taprootOutputKey theOutput + exampleControlBlocks = spkeControlBlocks $ tspkExpected testData + calculatedControlBlocks = + (!! 1) . encodeTaprootWitness . ScriptPathSpend <$> scriptPathSpends + scriptPathSpends = + fmap mkScriptPathSpend + . maybe mempty getMerkleProofs + $ taprootMAST theOutput + mkScriptPathSpend (scriptPathLeafVersion, scriptPathScript, proof) = + ScriptPathData + { scriptPathAnnex = Nothing + , scriptPathStack = mempty + , scriptPathScript + , scriptPathExternalIsOdd = odd $ keyParity theOutputKey + , scriptPathLeafVersion + , scriptPathInternalKey = taprootInternalKey theOutput + , scriptPathControl = BA.convert <$> proof + } + onExamples = zipWithM (@?=) calculatedControlBlocks + checkVerification = assertBool "Script verifies" . verifyScriptPathData theOutputKey + +keyParity :: PubKey -> Word8 +keyParity key = case BS.unpack . runPutS . serialize $ PubKeyI key True of + 0x02 : _ -> 0x00 + _ -> 0x01 + +testAddress :: TestScriptPubKey -> IO () +testAddress testData = computedAddress @?= (Just . spkeAddress . tspkExpected) testData + where + computedAddress = (addrToText btc <=< outputAddress) . taprootScriptOutput $ tspkGiven testData + +newtype SpkGiven = SpkGiven {unSpkGiven :: TaprootOutput} + +instance FromJSON SpkGiven where + parseJSON = withObject "SpkGiven" $ \obj -> + fmap SpkGiven $ + TaprootOutput + <$> (xOnlyPubKey <$> obj .: "internalPubkey") + <*> (obj .:? "scriptTree" >>= traverse parseScriptTree) + where + parseScriptTree v = + parseScriptLeaf v + <|> parseScriptBranch v + <|> fail "Unable to parse scriptTree" + parseScriptLeaf = withObject "ScriptTree leaf" $ \obj -> + MASTLeaf + <$> obj .: "leafVersion" + <*> (obj .: "script" >>= hexScript) + parseScriptBranch v = + parseJSON v >>= \case + [v1, v2] -> MASTBranch <$> parseScriptTree v1 <*> parseScriptTree v2 + _ -> fail "ScriptTree branch" + hexScript = either fail pure . runGetS deserialize <=< jsonHex + +data SpkIntermediary = SpkIntermediary + { spkiLeafHashes :: Maybe [ByteString] + , spkiMerkleRoot :: Maybe ByteString + , spkiTweakedPubKey :: PubKey + } + +instance FromJSON SpkIntermediary where + parseJSON = withObject "SpkIntermediary" $ \obj -> + SpkIntermediary + <$> (obj .:? "leafHashes" >>= (traverse . traverse) jsonHex) + <*> (obj .: "merkleRoot" >>= traverse jsonHex) + <*> (xOnlyPubKey <$> obj .: "tweakedPubkey") + +data SpkExpected = SpkExpected + { spkeScriptPubKey :: ScriptOutput + , spkeControlBlocks :: Maybe [ByteString] + , spkeAddress :: Text + } + +instance FromJSON SpkExpected where + parseJSON = withObject "SpkExpected" $ \obj -> + SpkExpected + <$> obj .: "scriptPubKey" + <*> (obj .:? "scriptPathControlBlocks" >>= (traverse . traverse) jsonHex) + <*> obj .: "bip350Address" + +data TestScriptPubKey = TestScriptPubKey + { tspkGiven :: TaprootOutput + , tspkIntermediary :: SpkIntermediary + , tspkExpected :: SpkExpected + } + +instance FromJSON TestScriptPubKey where + parseJSON = withObject "TestScriptPubKey" $ \obj -> + TestScriptPubKey + <$> (unSpkGiven <$> obj .: "given") + <*> obj .: "intermediary" + <*> obj .: "expected" + +newtype TestVector = TestVector + { testScriptPubKey :: [TestScriptPubKey] + } + +instance FromJSON TestVector where + parseJSON = withObject "TestVector" $ \obj -> + TestVector <$> obj .: "scriptPubKey" + +jsonHex :: Text -> Parser ByteString +jsonHex = maybe (fail "Unable to decode hex") pure . decodeHex diff --git a/test/Haskoin/TransactionSpec.hs b/test/Haskoin/TransactionSpec.hs --- a/test/Haskoin/TransactionSpec.hs +++ b/test/Haskoin/TransactionSpec.hs @@ -2,27 +2,28 @@ module Haskoin.TransactionSpec (spec) where -import qualified Data.ByteString as B -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import Data.Either -import Data.Maybe -import Data.String (fromString) -import Data.String.Conversions -import Data.Text (Text) -import Data.Word (Word32, Word64) -import Haskoin.Address -import Haskoin.Constants -import Haskoin.Keys -import Haskoin.Script -import Haskoin.Transaction -import Haskoin.Util -import Haskoin.Util.Arbitrary -import Test.HUnit -import Test.Hspec -import Test.Hspec.QuickCheck -import Test.QuickCheck +import qualified Data.ByteString as B +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.Either +import Data.Maybe +import Data.String (fromString) +import Data.String.Conversions +import Data.Text (Text) +import Data.Word (Word32, Word64) +import Haskoin.Address +import Haskoin.Constants +import Haskoin.Data +import Haskoin.Keys +import Haskoin.Script +import Haskoin.Transaction +import Haskoin.Util +import Haskoin.Util.Arbitrary +import Test.HUnit +import Test.Hspec +import Test.Hspec.QuickCheck +import Test.QuickCheck serialVals :: [SerialBox] serialVals = @@ -45,7 +46,7 @@ jsonVals :: [JsonBox] jsonVals = - [ JsonBox arbitraryTxHash + [ JsonBox arbitraryTxHash , JsonBox $ arbitraryTx =<< arbitraryNetwork , JsonBox $ arbitraryWitnessTx =<< arbitraryNetwork , JsonBox $ arbitraryLegacyTx =<< arbitraryNetwork @@ -65,7 +66,7 @@ prop "building address tx" $ forAll arbitraryNetwork $ \net -> forAll arbitraryAddress $ - forAll (arbitrarySatoshi net) . testBuildAddrTx net + forAll (arbitrarySatoshi net) . testBuildAddrTx net prop "guess transaction size" $ forAll arbitraryNetwork $ \net -> forAll (arbitraryAddrOnlyTxFull net) (testGuessSize net) @@ -75,7 +76,7 @@ prop "choose multisig coins" $ forAll arbitraryNetwork $ \net -> forAll arbitraryMSParam $ - forAll (listOf (arbitrarySatoshi net)) . testChooseMSCoins + forAll (listOf (arbitrarySatoshi net)) . testChooseMSCoins prop "sign and validate transaction" $ forAll arbitraryNetwork $ \net -> forAll (arbitrarySigningData net) (testDetSignTx net) @@ -100,58 +101,62 @@ txidVectors :: [(Text, Text)] txidVectors = - [ ( "23b397edccd3740a74adb603c9756370fafcde9bcc4483eb271ecad09a94dd63" - , "0100000001b14bdcbc3e01bdaad36cc08e81e69c82e1060bc14e518db2b49aa4\ - \3ad90ba26000000000490047304402203f16c6f40162ab686621ef3000b04e75\ - \418a0c0cb2d8aebeac894ae360ac1e780220ddc15ecdfc3507ac48e1681a33eb\ - \60996631bf6bf5bc0a0682c4db743ce7ca2b01ffffffff0140420f0000000000\ - \1976a914660d4ef3a743e3e696ad990364e555c271ad504b88ac00000000" - ) - , ( "c99c49da4c38af669dea436d3e73780dfdb6c1ecf9958baa52960e8baee30e73" - , "01000000010276b76b07f4935c70acf54fbf1f438a4c397a9fb7e633873c4dd3\ - \bc062b6b40000000008c493046022100d23459d03ed7e9511a47d13292d3430a\ - \04627de6235b6e51a40f9cd386f2abe3022100e7d25b080f0bb8d8d5f878bba7\ - \d54ad2fda650ea8d158a33ee3cbd11768191fd004104b0e2c879e4daf7b9ab68\ - \350228c159766676a14f5815084ba166432aab46198d4cca98fa3e9981d0a90b\ - \2effc514b76279476550ba3663fdcaff94c38420e9d5000000000100093d0000\ - \0000001976a9149a7b0f3b80c6baaeedce0a0842553800f832ba1f88ac000000\ - \00" - ) - , ( "f7fdd091fa6d8f5e7a8c2458f5c38faffff2d3f1406b6e4fe2c99dcc0d2d1cbb" - , "01000000023d6cf972d4dff9c519eff407ea800361dd0a121de1da8b6f4138a2\ - \f25de864b4000000008a4730440220ffda47bfc776bcd269da4832626ac332ad\ - \fca6dd835e8ecd83cd1ebe7d709b0e022049cffa1cdc102a0b56e0e04913606c\ - \70af702a1149dc3b305ab9439288fee090014104266abb36d66eb4218a6dd31f\ - \09bb92cf3cfa803c7ea72c1fc80a50f919273e613f895b855fb7465ccbc8919a\ - \d1bd4a306c783f22cd3227327694c4fa4c1c439affffffff21ebc9ba20594737\ - \864352e95b727f1a565756f9d365083eb1a8596ec98c97b7010000008a473044\ - \0220503ff10e9f1e0de731407a4a245531c9ff17676eda461f8ceeb8c06049fa\ - \2c810220c008ac34694510298fa60b3f000df01caa244f165b727d4896eb84f8\ - \1e46bcc4014104266abb36d66eb4218a6dd31f09bb92cf3cfa803c7ea72c1fc8\ - \0a50f919273e613f895b855fb7465ccbc8919ad1bd4a306c783f22cd32273276\ - \94c4fa4c1c439affffffff01f0da5200000000001976a914857ccd42dded6df3\ - \2949d4646dfa10a92458cfaa88ac00000000" - ) - , ( "afd9c17f8913577ec3509520bd6e5d63e9c0fd2a5f70c787993b097ba6ca9fae" - , "010000000370ac0a1ae588aaf284c308d67ca92c69a39e2db81337e563bf40c5\ - \9da0a5cf63000000006a4730440220360d20baff382059040ba9be98947fd678\ - \fb08aab2bb0c172efa996fd8ece9b702201b4fb0de67f015c90e7ac8a193aeab\ - \486a1f587e0f54d0fb9552ef7f5ce6caec032103579ca2e6d107522f012cd00b\ - \52b9a65fb46f0c57b9b8b6e377c48f526a44741affffffff7d815b6447e35fbe\ - \a097e00e028fb7dfbad4f3f0987b4734676c84f3fcd0e804010000006b483045\ - \022100c714310be1e3a9ff1c5f7cacc65c2d8e781fc3a88ceb063c6153bf9506\ - \50802102200b2d0979c76e12bb480da635f192cc8dc6f905380dd4ac1ff35a4f\ - \68f462fffd032103579ca2e6d107522f012cd00b52b9a65fb46f0c57b9b8b6e3\ - \77c48f526a44741affffffff3f1f097333e4d46d51f5e77b53264db8f7f5d2e1\ - \8217e1099957d0f5af7713ee010000006c493046022100b663499ef73273a378\ - \8dea342717c2640ac43c5a1cf862c9e09b206fcb3f6bb8022100b09972e75972\ - \d9148f2bdd462e5cb69b57c1214b88fc55ca638676c07cfc10d8032103579ca2\ - \e6d107522f012cd00b52b9a65fb46f0c57b9b8b6e377c48f526a44741affffff\ - \ff0380841e00000000001976a914bfb282c70c4191f45b5a6665cad1682f2c9c\ - \fdfb88ac80841e00000000001976a9149857cc07bed33a5cf12b9c5e0500b675\ - \d500c81188ace0fd1c00000000001976a91443c52850606c872403c0601e69fa\ - \34b26f62db4a88ac00000000" - ) + [ + ( "23b397edccd3740a74adb603c9756370fafcde9bcc4483eb271ecad09a94dd63" + , "0100000001b14bdcbc3e01bdaad36cc08e81e69c82e1060bc14e518db2b49aa4\ + \3ad90ba26000000000490047304402203f16c6f40162ab686621ef3000b04e75\ + \418a0c0cb2d8aebeac894ae360ac1e780220ddc15ecdfc3507ac48e1681a33eb\ + \60996631bf6bf5bc0a0682c4db743ce7ca2b01ffffffff0140420f0000000000\ + \1976a914660d4ef3a743e3e696ad990364e555c271ad504b88ac00000000" + ) + , + ( "c99c49da4c38af669dea436d3e73780dfdb6c1ecf9958baa52960e8baee30e73" + , "01000000010276b76b07f4935c70acf54fbf1f438a4c397a9fb7e633873c4dd3\ + \bc062b6b40000000008c493046022100d23459d03ed7e9511a47d13292d3430a\ + \04627de6235b6e51a40f9cd386f2abe3022100e7d25b080f0bb8d8d5f878bba7\ + \d54ad2fda650ea8d158a33ee3cbd11768191fd004104b0e2c879e4daf7b9ab68\ + \350228c159766676a14f5815084ba166432aab46198d4cca98fa3e9981d0a90b\ + \2effc514b76279476550ba3663fdcaff94c38420e9d5000000000100093d0000\ + \0000001976a9149a7b0f3b80c6baaeedce0a0842553800f832ba1f88ac000000\ + \00" + ) + , + ( "f7fdd091fa6d8f5e7a8c2458f5c38faffff2d3f1406b6e4fe2c99dcc0d2d1cbb" + , "01000000023d6cf972d4dff9c519eff407ea800361dd0a121de1da8b6f4138a2\ + \f25de864b4000000008a4730440220ffda47bfc776bcd269da4832626ac332ad\ + \fca6dd835e8ecd83cd1ebe7d709b0e022049cffa1cdc102a0b56e0e04913606c\ + \70af702a1149dc3b305ab9439288fee090014104266abb36d66eb4218a6dd31f\ + \09bb92cf3cfa803c7ea72c1fc80a50f919273e613f895b855fb7465ccbc8919a\ + \d1bd4a306c783f22cd3227327694c4fa4c1c439affffffff21ebc9ba20594737\ + \864352e95b727f1a565756f9d365083eb1a8596ec98c97b7010000008a473044\ + \0220503ff10e9f1e0de731407a4a245531c9ff17676eda461f8ceeb8c06049fa\ + \2c810220c008ac34694510298fa60b3f000df01caa244f165b727d4896eb84f8\ + \1e46bcc4014104266abb36d66eb4218a6dd31f09bb92cf3cfa803c7ea72c1fc8\ + \0a50f919273e613f895b855fb7465ccbc8919ad1bd4a306c783f22cd32273276\ + \94c4fa4c1c439affffffff01f0da5200000000001976a914857ccd42dded6df3\ + \2949d4646dfa10a92458cfaa88ac00000000" + ) + , + ( "afd9c17f8913577ec3509520bd6e5d63e9c0fd2a5f70c787993b097ba6ca9fae" + , "010000000370ac0a1ae588aaf284c308d67ca92c69a39e2db81337e563bf40c5\ + \9da0a5cf63000000006a4730440220360d20baff382059040ba9be98947fd678\ + \fb08aab2bb0c172efa996fd8ece9b702201b4fb0de67f015c90e7ac8a193aeab\ + \486a1f587e0f54d0fb9552ef7f5ce6caec032103579ca2e6d107522f012cd00b\ + \52b9a65fb46f0c57b9b8b6e377c48f526a44741affffffff7d815b6447e35fbe\ + \a097e00e028fb7dfbad4f3f0987b4734676c84f3fcd0e804010000006b483045\ + \022100c714310be1e3a9ff1c5f7cacc65c2d8e781fc3a88ceb063c6153bf9506\ + \50802102200b2d0979c76e12bb480da635f192cc8dc6f905380dd4ac1ff35a4f\ + \68f462fffd032103579ca2e6d107522f012cd00b52b9a65fb46f0c57b9b8b6e3\ + \77c48f526a44741affffffff3f1f097333e4d46d51f5e77b53264db8f7f5d2e1\ + \8217e1099957d0f5af7713ee010000006c493046022100b663499ef73273a378\ + \8dea342717c2640ac43c5a1cf862c9e09b206fcb3f6bb8022100b09972e75972\ + \d9148f2bdd462e5cb69b57c1214b88fc55ca638676c07cfc10d8032103579ca2\ + \e6d107522f012cd00b52b9a65fb46f0c57b9b8b6e377c48f526a44741affffff\ + \ff0380841e00000000001976a914bfb282c70c4191f45b5a6665cad1682f2c9c\ + \fdfb88ac80841e00000000001976a9149857cc07bed33a5cf12b9c5e0500b675\ + \d500c81188ace0fd1c00000000001976a91443c52850606c872403c0601e69fa\ + \34b26f62db4a88ac00000000" + ) ] -- Build address transactions vectors generated from bitcoin-core raw tx API @@ -159,51 +164,74 @@ testPKHashVector :: ([(Text, Word32)], [(Text, Word64)], Text) -> Assertion testPKHashVector (is, os, res) = assertEqual - "Build PKHash Tx" - (Right res) - (encodeHex . runPutS . serialize <$> txE) + "Build PKHash Tx" + (Right res) + (encodeHex . runPutS . serialize <$> txE) where txE = buildAddrTx btc (map f is) os f (tid, ix) = OutPoint (fromJust $ hexToTxHash tid) ix pkHashVectors :: [([(Text, Word32)], [(Text, Word64)], Text)] pkHashVectors = - [ ( [ ( "eb29eba154166f6541ebcc9cbdf5088756e026af051f123bcfb526df594549db" - , 14) - ] - , [("14LsRquZfURNFrzpcLVGdaHTfAPjjwiSPb", 90000000)] - , "0100000001db494559df26b5cf3b121f05af26e0568708f5bd9ccceb41656f1654\ - \a1eb29eb0e00000000ffffffff01804a5d05000000001976a91424aa604689cc58\ - \2292b97668bedd91dd5bf9374c88ac00000000") - , ( [ ( "eb29eba154166f6541ebcc9cbdf5088756e026af051f123bcfb526df594549db" - , 0) - , ( "0001000000000000000000000000000000000000000000000000000000000000" - , 2147483647) - ] - , [ ("14LsRquZfURNFrzpcLVGdaHTfAPjjwiSPb", 1) - , ("19VCgS642vzEA1sdByoSn6GsWBwraV8D4n", 2100000000000000) - ] - , "0100000002db494559df26b5cf3b121f05af26e0568708f5bd9ccceb41656f1654\ - \a1eb29eb0000000000ffffffff0000000000000000000000000000000000000000\ - \000000000000000000000100ffffff7f00ffffffff0201000000000000001976a9\ - \1424aa604689cc582292b97668bedd91dd5bf9374c88ac0040075af07507001976\ - \a9145d16672f53981ff21c5f42b40d1954993cbca54f88ac00000000") - , ( [ ( "eb29eba154166f6541ebcc9cbdf5088756e026af051f123bcfb526df594549db" - , 0) - , ( "0001000000000000000000000000000000000000000000000000000000000000" - , 2147483647) - ] - , [] - , "0100000002db494559df26b5cf3b121f05af26e0568708f5bd9ccceb41656f1654a\ - \1eb29eb0000000000ffffffff000000000000000000000000000000000000000000\ - \0000000000000000000100ffffff7f00ffffffff0000000000") - , ( [] - , [ ("14LsRquZfURNFrzpcLVGdaHTfAPjjwiSPb", 1) - , ("19VCgS642vzEA1sdByoSn6GsWBwraV8D4n", 2100000000000000) - ] - , "01000000000201000000000000001976a91424aa604689cc582292b97668bedd91d\ - \d5bf9374c88ac0040075af07507001976a9145d16672f53981ff21c5f42b40d1954\ - \993cbca54f88ac00000000") + [ + ( + [ + ( "eb29eba154166f6541ebcc9cbdf5088756e026af051f123bcfb526df594549db" + , 14 + ) + ] + , [("14LsRquZfURNFrzpcLVGdaHTfAPjjwiSPb", 90000000)] + , "0100000001db494559df26b5cf3b121f05af26e0568708f5bd9ccceb41656f1654\ + \a1eb29eb0e00000000ffffffff01804a5d05000000001976a91424aa604689cc58\ + \2292b97668bedd91dd5bf9374c88ac00000000" + ) + , + ( + [ + ( "eb29eba154166f6541ebcc9cbdf5088756e026af051f123bcfb526df594549db" + , 0 + ) + , + ( "0001000000000000000000000000000000000000000000000000000000000000" + , 2147483647 + ) + ] + , + [ ("14LsRquZfURNFrzpcLVGdaHTfAPjjwiSPb", 1) + , ("19VCgS642vzEA1sdByoSn6GsWBwraV8D4n", 2100000000000000) + ] + , "0100000002db494559df26b5cf3b121f05af26e0568708f5bd9ccceb41656f1654\ + \a1eb29eb0000000000ffffffff0000000000000000000000000000000000000000\ + \000000000000000000000100ffffff7f00ffffffff0201000000000000001976a9\ + \1424aa604689cc582292b97668bedd91dd5bf9374c88ac0040075af07507001976\ + \a9145d16672f53981ff21c5f42b40d1954993cbca54f88ac00000000" + ) + , + ( + [ + ( "eb29eba154166f6541ebcc9cbdf5088756e026af051f123bcfb526df594549db" + , 0 + ) + , + ( "0001000000000000000000000000000000000000000000000000000000000000" + , 2147483647 + ) + ] + , [] + , "0100000002db494559df26b5cf3b121f05af26e0568708f5bd9ccceb41656f1654a\ + \1eb29eb0000000000ffffffff000000000000000000000000000000000000000000\ + \0000000000000000000100ffffff7f00ffffffff0000000000" + ) + , + ( [] + , + [ ("14LsRquZfURNFrzpcLVGdaHTfAPjjwiSPb", 1) + , ("19VCgS642vzEA1sdByoSn6GsWBwraV8D4n", 2100000000000000) + ] + , "01000000000201000000000000001976a91424aa604689cc582292b97668bedd91d\ + \d5bf9374c88ac0040075af07507001976a9145d16672f53981ff21c5f42b40d1954\ + \993cbca54f88ac00000000" + ) ] -- Transaction Properties -- @@ -217,8 +245,8 @@ tx = buildAddrTx net [] [(fromJust (addrToText net a), v)] out = decodeOutputBS $ - scriptOutput $ - head $ txOut (fromRight (error "Could not build transaction") tx) + scriptOutput $ + head $ txOut (fromRight (error "Could not build transaction") tx) -- We compute an upper bound but it should be close enough to the real size -- We give 2 bytes of slack on every signature (1 on r and 1 on s) @@ -232,43 +260,52 @@ ins = map f $ txIn tx f i = fromRight (error "Could not decode input") $ - decodeInputBS net $ scriptInput i + decodeInputBS net $ scriptInput i pki = length $ filter isSpendPKHash ins msi = concatMap shData ins shData (ScriptHashInput _ (PayMulSig keys r)) = [(r, length keys)] - shData _ = [] + shData _ = [] out = map - (fromRight (error "Could not decode transaction output") . - decodeOutputBS . scriptOutput) $ - txOut tx + ( fromRight (error "Could not decode transaction output") + . decodeOutputBS + . scriptOutput + ) + $ txOut tx pkout = length $ filter isPayPKHash out msout = length $ filter isPayScriptHash out testChooseCoins :: [TestCoin] -> Word64 -> Word64 -> Int -> Property -testChooseCoins coins target byteFee nOut = nOut >= 0 ==> - case chooseCoins target byteFee nOut True coins of - Right (chosen, change) -> - let outSum = sum $ map coinValue chosen - fee = guessTxFee byteFee nOut (length chosen) - in outSum == target + change + fee - Left _ -> - let fee = guessTxFee byteFee nOut (length coins) - in target == 0 || s < target + fee +testChooseCoins coins target byteFee nOut = + nOut >= 0 + ==> case chooseCoins target byteFee nOut True coins of + Right (chosen, change) -> + let outSum = sum $ map coinValue chosen + fee = guessTxFee byteFee nOut (length chosen) + in outSum == target + change + fee + Left _ -> + let fee = guessTxFee byteFee nOut (length coins) + in target == 0 || s < target + fee where - s = sum $ map coinValue coins + s = sum $ map coinValue coins -testChooseMSCoins :: (Int, Int) -> [TestCoin] - -> Word64 -> Word64 -> Int -> Property -testChooseMSCoins (m, n) coins target byteFee nOut = nOut >= 0 ==> - case chooseMSCoins target byteFee (m,n) nOut True coins of - Right (chosen,change) -> - let outSum = sum $ map coinValue chosen - fee = guessMSTxFee byteFee (m,n) nOut (length chosen) - in outSum == target + change + fee - Left _ -> - let fee = guessMSTxFee byteFee (m,n) nOut (length coins) - in target == 0 || s < target + fee +testChooseMSCoins :: + (Int, Int) -> + [TestCoin] -> + Word64 -> + Word64 -> + Int -> + Property +testChooseMSCoins (m, n) coins target byteFee nOut = + nOut >= 0 + ==> case chooseMSCoins target byteFee (m, n) nOut True coins of + Right (chosen, change) -> + let outSum = sum $ map coinValue chosen + fee = guessMSTxFee byteFee (m, n) nOut (length chosen) + in outSum == target + change + fee + Left _ -> + let fee = guessMSTxFee byteFee (m, n) nOut (length coins) + in target == 0 || s < target + fee where s = sum $ map coinValue coins @@ -276,44 +313,45 @@ testDetSignTx :: Network -> (Tx, [SigInput], [SecKeyI]) -> Bool testDetSignTx net (tx, sigis, prv) = - not (verifyStdTx net tx verData) && - not (verifyStdTx net txSigP verData) && - verifyStdTx net txSigC verData + not (verifyStdTx net tx verData) + && not (verifyStdTx net txSigP verData) + && verifyStdTx net txSigC verData where txSigP = fromRight (error "Could not decode transaction") $ - signTx net tx sigis (map secKeyData (tail prv)) + signTx net tx sigis (map secKeyData (tail prv)) txSigC = fromRight (error "Could not decode transaction") $ - signTx net txSigP sigis [secKeyData (head prv)] + signTx net txSigP sigis [secKeyData (head prv)] verData = map (\(SigInput s v o _ _) -> (s, v, o)) sigis testDetSignNestedTx :: Network -> (Tx, [SigInput], [SecKeyI]) -> Bool -testDetSignNestedTx net (tx, sigis, prv) = - not (verifyStdTx net tx verData) && - not (verifyStdTx net txSigP verData) && - verifyStdTx net txSigC verData +testDetSignNestedTx net (tx, sigis, prv) = + not (verifyStdTx net tx verData) + && not (verifyStdTx net txSigP verData) + && verifyStdTx net txSigC verData where txSigP = fromRight (error "Could not decode transaction") $ - signNestedWitnessTx net tx sigis (secKeyData <$> tail prv) + signNestedWitnessTx net tx sigis (secKeyData <$> tail prv) txSigC = fromRight (error "Could not decode transaction") $ - signNestedWitnessTx net txSigP sigis [secKeyData (head prv)] + signNestedWitnessTx net txSigP sigis [secKeyData (head prv)] verData = handleSegwit <$> sigis handleSegwit (SigInput s v o _ _) | isSegwit s = (toP2SH $ encodeOutput s, v, o) - | otherwise = (s, v, o) + | otherwise = (s, v, o) testMergeTx :: Network -> ([Tx], [(ScriptOutput, Word64, OutPoint, Int, Int)]) -> Bool testMergeTx net (txs, os) = - and [ isRight mergeRes + and + [ isRight mergeRes , length (txIn mergedTx) == length os , if enoughSigs - then isValid - else not isValid - -- Signature count == min (length txs) (sum required signatures) - , sum (map snd sigMap) == min (length txs) (sum (map fst sigMap)) + then isValid + else not isValid + , -- Signature count == min (length txs) (sum required signatures) + sum (map snd sigMap) == min (length txs) (sum (map fst sigMap)) ] where outs = map (\(so, val, op, _, _) -> (so, val, op)) os @@ -323,7 +361,7 @@ enoughSigs = all (\(m, c) -> c >= m) sigMap sigMap = map (\((_, _, _, m, _), inp) -> (m, sigCnt inp)) $ - zip os $ txIn mergedTx + zip os $ txIn mergedTx sigCnt inp = case decodeInputBS net $ scriptInput inp of Right (RegularInput (SpendMulSig sigs)) -> length sigs diff --git a/test/Haskoin/UtilSpec.hs b/test/Haskoin/UtilSpec.hs --- a/test/Haskoin/UtilSpec.hs +++ b/test/Haskoin/UtilSpec.hs @@ -1,26 +1,26 @@ -module Haskoin.UtilSpec - ( spec - , customCerealID - , readTestFile - ) where +module Haskoin.UtilSpec ( + spec, + customCerealID, + readTestFile, +) where -import Data.Aeson (FromJSON, ToJSON) -import qualified Data.Aeson as A -import Data.Aeson.Encoding (encodingToLazyByteString) -import Data.Aeson.Types (Parser, parseMaybe) -import qualified Data.ByteString as BS -import Data.Either (fromLeft, fromRight, isLeft, isRight) -import Data.Foldable (toList) -import Data.List (permutations) -import Data.Map.Strict (singleton) -import Data.Maybe -import qualified Data.Sequence as Seq -import Data.Serialize as S -import Haskoin.Util -import Haskoin.Util.Arbitrary -import Test.Hspec -import Test.Hspec.QuickCheck -import Test.QuickCheck +import Data.Aeson (FromJSON, ToJSON) +import qualified Data.Aeson as A +import Data.Aeson.Encoding (encodingToLazyByteString) +import Data.Aeson.Types (Parser, parseMaybe) +import qualified Data.ByteString as BS +import Data.Either (fromLeft, fromRight, isLeft, isRight) +import Data.Foldable (toList) +import Data.List (permutations) +import Data.Map.Strict (singleton) +import Data.Maybe +import qualified Data.Sequence as Seq +import Data.Serialize as S +import Haskoin.Util +import Haskoin.Util.Arbitrary +import Test.Hspec +import Test.Hspec.QuickCheck +import Test.QuickCheck spec :: Spec spec = @@ -74,7 +74,7 @@ customCerealID g p a = runGet g (runPut (p a)) == Right a readTestFile :: A.FromJSON a => FilePath -> IO a -readTestFile fp = do - fileM <- A.decodeFileStrict $ "data/" <> fp - maybe (error $ "Could not read test file " <> fp) return fileM - +readTestFile fp = + A.eitherDecodeFileStrict ("data/" <> fp) >>= either (error . message) return + where + message aesonErr = "Could not read test file " <> fp <> ": " <> aesonErr