haskoin-core 0.20.5 → 0.21.0
raw patch · 66 files changed
+11330/−6923 lines, 66 filesdep +base64PVP ok
version bump matches the API change (PVP)
Dependencies added: base64
API changes (from Hackage documentation)
- Haskoin.Address.Bech32: instance GHC.Arr.Ix Haskoin.Address.Bech32.Word5
- Haskoin.Constants: [getNetworkIdent] :: Network -> !String
- Haskoin.Constants: instance Control.DeepSeq.NFData Haskoin.Constants.Network
- Haskoin.Constants: instance Data.Binary.Class.Binary Haskoin.Constants.Network
- Haskoin.Constants: instance Data.Bytes.Serial.Serial Haskoin.Constants.Network
- Haskoin.Constants: instance Data.Serialize.Serialize Haskoin.Constants.Network
- Haskoin.Constants: instance Data.String.IsString Haskoin.Constants.Network
- Haskoin.Constants: instance GHC.Classes.Eq Haskoin.Constants.Network
- Haskoin.Constants: instance GHC.Generics.Generic Haskoin.Constants.Network
- Haskoin.Constants: instance GHC.Read.Read Haskoin.Constants.Network
- Haskoin.Constants: instance GHC.Show.Show Haskoin.Constants.Network
- Haskoin.Constants: netByIdent :: String -> Maybe Network
- Haskoin.Keys.Extended: type Fingerprint = Word32
+ Haskoin.Address.Bech32: instance GHC.Ix.Ix Haskoin.Address.Bech32.Word5
+ Haskoin.Constants: bchTest4 :: Network
+ Haskoin.Crypto.Hash: initTaggedHash :: ByteString -> Context SHA256
+ Haskoin.Data: Network :: !String -> !Word8 -> !Word8 -> !Word8 -> !Word32 -> !Word32 -> !Word32 -> !BlockHeader -> !Int -> !Word64 -> !ByteString -> !Int -> !Bool -> !Bool -> !Integer -> !(BlockHeight, BlockHash) -> !BlockHeight -> !BlockHeight -> !Word32 -> !Word32 -> ![(BlockHeight, BlockHash)] -> !Word32 -> ![String] -> !Maybe Word32 -> !Maybe Word32 -> !Maybe Word32 -> !Maybe Word32 -> !Integer -> !Bool -> !Maybe Text -> !Maybe Text -> !Bool -> !Word32 -> Network
+ Haskoin.Data: [getAddrPrefix] :: Network -> !Word8
+ Haskoin.Data: [getAllowMinDifficultyBlocks] :: Network -> !Bool
+ Haskoin.Data: [getAsertActivationTime] :: Network -> !Maybe Word32
+ Haskoin.Data: [getAsertHalfLife] :: Network -> !Integer
+ Haskoin.Data: [getBech32Prefix] :: Network -> !Maybe Text
+ Haskoin.Data: [getBip34Block] :: Network -> !(BlockHeight, BlockHash)
+ Haskoin.Data: [getBip44Coin] :: Network -> !Word32
+ Haskoin.Data: [getBip65Height] :: Network -> !BlockHeight
+ Haskoin.Data: [getBip66Height] :: Network -> !BlockHeight
+ Haskoin.Data: [getCashAddrPrefix] :: Network -> !Maybe Text
+ Haskoin.Data: [getCheckpoints] :: Network -> ![(BlockHeight, BlockHash)]
+ Haskoin.Data: [getDaaBlockHeight] :: Network -> !Maybe Word32
+ Haskoin.Data: [getDefaultPort] :: Network -> !Int
+ Haskoin.Data: [getEdaBlockHeight] :: Network -> !Maybe Word32
+ Haskoin.Data: [getExtPubKeyPrefix] :: Network -> !Word32
+ Haskoin.Data: [getExtSecretPrefix] :: Network -> !Word32
+ Haskoin.Data: [getGenesisHeader] :: Network -> !BlockHeader
+ Haskoin.Data: [getHalvingInterval] :: Network -> !Word32
+ Haskoin.Data: [getHaskoinUserAgent] :: Network -> !ByteString
+ Haskoin.Data: [getMaxBlockSize] :: Network -> !Int
+ Haskoin.Data: [getMaxSatoshi] :: Network -> !Word64
+ Haskoin.Data: [getNetworkMagic] :: Network -> !Word32
+ Haskoin.Data: [getNetworkName] :: Network -> !String
+ Haskoin.Data: [getPowLimit] :: Network -> !Integer
+ Haskoin.Data: [getPowNoRetargetting] :: Network -> !Bool
+ Haskoin.Data: [getReplaceByFee] :: Network -> !Bool
+ Haskoin.Data: [getScriptPrefix] :: Network -> !Word8
+ Haskoin.Data: [getSecretPrefix] :: Network -> !Word8
+ Haskoin.Data: [getSeeds] :: Network -> ![String]
+ Haskoin.Data: [getSegWit] :: Network -> !Bool
+ Haskoin.Data: [getSigHashForkId] :: Network -> !Maybe Word32
+ Haskoin.Data: [getTargetSpacing] :: Network -> !Word32
+ Haskoin.Data: [getTargetTimespan] :: Network -> !Word32
+ Haskoin.Data: data Network
+ Haskoin.Data: instance Control.DeepSeq.NFData Haskoin.Data.Network
+ Haskoin.Data: instance GHC.Classes.Eq Haskoin.Data.Network
+ Haskoin.Data: instance GHC.Generics.Generic Haskoin.Data.Network
+ Haskoin.Data: instance GHC.Read.Read Haskoin.Data.Network
+ Haskoin.Data: instance GHC.Show.Show Haskoin.Data.Network
+ Haskoin.Keys.Extended: data Fingerprint
+ Haskoin.Keys.Extended: fingerprintToText :: Fingerprint -> Text
+ Haskoin.Keys.Extended: textToFingerprint :: Text -> Either String Fingerprint
+ Haskoin.Transaction.Partial: data PsbtSigner
+ Haskoin.Transaction.Partial: getSignerKey :: PsbtSigner -> PubKeyI -> Maybe (Fingerprint, DerivPath) -> Maybe SecKey
+ Haskoin.Transaction.Partial: instance GHC.Base.Monoid Haskoin.Transaction.Partial.PsbtSigner
+ Haskoin.Transaction.Partial: instance GHC.Base.Semigroup Haskoin.Transaction.Partial.PsbtSigner
+ Haskoin.Transaction.Partial: mergeMany :: [PartiallySignedTransaction] -> Maybe PartiallySignedTransaction
+ Haskoin.Transaction.Partial: secKeySigner :: SecKey -> PsbtSigner
+ Haskoin.Transaction.Partial: signPSBT :: Network -> PsbtSigner -> PartiallySignedTransaction -> PartiallySignedTransaction
+ Haskoin.Transaction.Partial: xPrvSigner :: XPrvKey -> Maybe (Fingerprint, DerivPath) -> PsbtSigner
+ Haskoin.Transaction.Taproot: KeyPathSpend :: ByteString -> TaprootWitness
+ Haskoin.Transaction.Taproot: MASTBranch :: MAST -> MAST -> MAST
+ Haskoin.Transaction.Taproot: MASTCommitment :: Digest SHA256 -> MAST
+ Haskoin.Transaction.Taproot: MASTLeaf :: TapLeafVersion -> Script -> MAST
+ Haskoin.Transaction.Taproot: ScriptPathData :: Maybe ByteString -> [ByteString] -> Script -> Bool -> Word8 -> PubKey -> [ByteString] -> ScriptPathData
+ Haskoin.Transaction.Taproot: ScriptPathSpend :: ScriptPathData -> TaprootWitness
+ Haskoin.Transaction.Taproot: TaprootOutput :: PubKey -> Maybe MAST -> TaprootOutput
+ Haskoin.Transaction.Taproot: XOnlyPubKey :: PubKey -> XOnlyPubKey
+ Haskoin.Transaction.Taproot: [scriptPathAnnex] :: ScriptPathData -> Maybe ByteString
+ Haskoin.Transaction.Taproot: [scriptPathControl] :: ScriptPathData -> [ByteString]
+ Haskoin.Transaction.Taproot: [scriptPathExternalIsOdd] :: ScriptPathData -> Bool
+ Haskoin.Transaction.Taproot: [scriptPathInternalKey] :: ScriptPathData -> PubKey
+ Haskoin.Transaction.Taproot: [scriptPathLeafVersion] :: ScriptPathData -> Word8
+ Haskoin.Transaction.Taproot: [scriptPathScript] :: ScriptPathData -> Script
+ Haskoin.Transaction.Taproot: [scriptPathStack] :: ScriptPathData -> [ByteString]
+ Haskoin.Transaction.Taproot: [taprootInternalKey] :: TaprootOutput -> PubKey
+ Haskoin.Transaction.Taproot: [taprootMAST] :: TaprootOutput -> Maybe MAST
+ Haskoin.Transaction.Taproot: [xOnlyPubKey] :: XOnlyPubKey -> PubKey
+ Haskoin.Transaction.Taproot: data MAST
+ Haskoin.Transaction.Taproot: data ScriptPathData
+ Haskoin.Transaction.Taproot: data TaprootOutput
+ Haskoin.Transaction.Taproot: data TaprootWitness
+ Haskoin.Transaction.Taproot: encodeTaprootWitness :: TaprootWitness -> WitnessStack
+ Haskoin.Transaction.Taproot: getMerkleProofs :: MAST -> [(TapLeafVersion, Script, [Digest SHA256])]
+ Haskoin.Transaction.Taproot: instance Data.Aeson.Types.FromJSON.FromJSON Haskoin.Transaction.Taproot.XOnlyPubKey
+ Haskoin.Transaction.Taproot: instance Data.Aeson.Types.ToJSON.ToJSON Haskoin.Transaction.Taproot.XOnlyPubKey
+ Haskoin.Transaction.Taproot: instance Data.Binary.Class.Binary Haskoin.Transaction.Taproot.XOnlyPubKey
+ Haskoin.Transaction.Taproot: instance Data.Bytes.Serial.Serial Haskoin.Transaction.Taproot.XOnlyPubKey
+ Haskoin.Transaction.Taproot: instance Data.Serialize.Serialize Haskoin.Transaction.Taproot.XOnlyPubKey
+ Haskoin.Transaction.Taproot: instance GHC.Classes.Eq Haskoin.Transaction.Taproot.ScriptPathData
+ Haskoin.Transaction.Taproot: instance GHC.Classes.Eq Haskoin.Transaction.Taproot.TaprootWitness
+ Haskoin.Transaction.Taproot: instance GHC.Classes.Eq Haskoin.Transaction.Taproot.XOnlyPubKey
+ Haskoin.Transaction.Taproot: instance GHC.Show.Show Haskoin.Transaction.Taproot.MAST
+ Haskoin.Transaction.Taproot: instance GHC.Show.Show Haskoin.Transaction.Taproot.ScriptPathData
+ Haskoin.Transaction.Taproot: instance GHC.Show.Show Haskoin.Transaction.Taproot.TaprootOutput
+ Haskoin.Transaction.Taproot: instance GHC.Show.Show Haskoin.Transaction.Taproot.TaprootWitness
+ Haskoin.Transaction.Taproot: instance GHC.Show.Show Haskoin.Transaction.Taproot.XOnlyPubKey
+ Haskoin.Transaction.Taproot: mastCommitment :: MAST -> Digest SHA256
+ Haskoin.Transaction.Taproot: newtype XOnlyPubKey
+ Haskoin.Transaction.Taproot: taprootOutputKey :: TaprootOutput -> PubKey
+ Haskoin.Transaction.Taproot: taprootScriptOutput :: TaprootOutput -> ScriptOutput
+ Haskoin.Transaction.Taproot: type TapLeafVersion = Word8
+ Haskoin.Transaction.Taproot: verifyScriptPathData :: PubKey -> ScriptPathData -> Bool
+ Haskoin.Transaction.Taproot: viewTaprootWitness :: WitnessStack -> Maybe TaprootWitness
+ Haskoin.Util.Arbitrary.Keys: arbitraryFingerprint :: Gen Fingerprint
- Haskoin.Constants: Network :: !String -> !String -> !Word8 -> !Word8 -> !Word8 -> !Word32 -> !Word32 -> !Word32 -> !BlockHeader -> !Int -> !Word64 -> !ByteString -> !Int -> !Bool -> !Bool -> !Integer -> !(BlockHeight, BlockHash) -> !BlockHeight -> !BlockHeight -> !Word32 -> !Word32 -> ![(BlockHeight, BlockHash)] -> !Word32 -> ![String] -> !Maybe Word32 -> !Maybe Word32 -> !Maybe Word32 -> !Maybe Word32 -> !Integer -> !Bool -> !Maybe Text -> !Maybe Text -> !Bool -> !Word32 -> Network
+ Haskoin.Constants: Network :: !String -> !Word8 -> !Word8 -> !Word8 -> !Word32 -> !Word32 -> !Word32 -> !BlockHeader -> !Int -> !Word64 -> !ByteString -> !Int -> !Bool -> !Bool -> !Integer -> !(BlockHeight, BlockHash) -> !BlockHeight -> !BlockHeight -> !Word32 -> !Word32 -> ![(BlockHeight, BlockHash)] -> !Word32 -> ![String] -> !Maybe Word32 -> !Maybe Word32 -> !Maybe Word32 -> !Maybe Word32 -> !Integer -> !Bool -> !Maybe Text -> !Maybe Text -> !Bool -> !Word32 -> Network
Files
- CHANGELOG.md +18/−0
- README.md +4/−0
- data/bip341.json +452/−0
- data/complex_psbt.json +18/−0
- haskoin-core.cabal +8/−4
- src/Haskoin.hs +23/−21
- src/Haskoin/Address.hs +167/−157
- src/Haskoin/Address/Base58.hs +51/−43
- src/Haskoin/Address/Bech32.hs +90/−68
- src/Haskoin/Address/CashAddr.hs +76/−56
- src/Haskoin/Block.hs +9/−9
- src/Haskoin/Block/Common.hs +192/−156
- src/Haskoin/Block/Headers.hs +440/−344
- src/Haskoin/Block/Merkle.hs +181/−136
- src/Haskoin/Constants.hs +614/−574
- src/Haskoin/Crypto.hs +9/−9
- src/Haskoin/Crypto/Hash.hs +86/−59
- src/Haskoin/Crypto/Signature.hs +26/−25
- src/Haskoin/Data.hs +93/−0
- src/Haskoin/Keys.hs +9/−9
- src/Haskoin/Keys/Common.hs +89/−73
- src/Haskoin/Keys/Extended.hs +448/−362
- src/Haskoin/Keys/Extended/Internal.hs +83/−0
- src/Haskoin/Keys/Mnemonic.hs +2232/−518
- src/Haskoin/Network.hs +9/−9
- src/Haskoin/Network/Bloom.hs +150/−121
- src/Haskoin/Network/Common.hs +306/−287
- src/Haskoin/Network/Message.hs +134/−128
- src/Haskoin/Script.hs +9/−9
- src/Haskoin/Script/Common.hs +223/−245
- src/Haskoin/Script/SigHash.hs +142/−123
- src/Haskoin/Script/Standard.hs +211/−193
- src/Haskoin/Transaction.hs +15/−11
- src/Haskoin/Transaction/Builder.hs +354/−273
- src/Haskoin/Transaction/Builder/Sign.hs +193/−147
- src/Haskoin/Transaction/Common.hs +127/−111
- src/Haskoin/Transaction/Genesis.hs +20/−15
- src/Haskoin/Transaction/Partial.hs +584/−367
- src/Haskoin/Transaction/Segwit.hs +80/−71
- src/Haskoin/Transaction/Taproot.hs +310/−0
- src/Haskoin/Util.hs +165/−136
- src/Haskoin/Util/Arbitrary.hs +13/−13
- src/Haskoin/Util/Arbitrary/Address.hs +18/−15
- src/Haskoin/Util/Arbitrary/Block.hs +31/−34
- src/Haskoin/Util/Arbitrary/Crypto.hs +4/−4
- src/Haskoin/Util/Arbitrary/Keys.hs +34/−25
- src/Haskoin/Util/Arbitrary/Message.hs +11/−11
- src/Haskoin/Util/Arbitrary/Network.hs +40/−35
- src/Haskoin/Util/Arbitrary/Script.hs +103/−81
- src/Haskoin/Util/Arbitrary/Transaction.hs +66/−55
- src/Haskoin/Util/Arbitrary/Util.hs +85/−78
- test/Haskoin/Address/Bech32Spec.hs +137/−110
- test/Haskoin/Address/CashAddrSpec.hs +262/−194
- test/Haskoin/AddressSpec.hs +71/−57
- test/Haskoin/BlockSpec.hs +138/−122
- test/Haskoin/Crypto/HashSpec.hs +306/−211
- test/Haskoin/Crypto/SignatureSpec.hs +93/−75
- test/Haskoin/Keys/ExtendedSpec.hs +330/−289
- test/Haskoin/Keys/MnemonicSpec.hs +52/−44
- test/Haskoin/KeysSpec.hs +72/−67
- test/Haskoin/NetworkSpec.hs +71/−59
- test/Haskoin/ScriptSpec.hs +211/−194
- test/Haskoin/Transaction/PartialSpec.hs +318/−94
- test/Haskoin/Transaction/TaprootSpec.hs +189/−0
- test/Haskoin/TransactionSpec.hs +199/−161
- test/Haskoin/UtilSpec.hs +26/−26
CHANGELOG.md view
@@ -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.
README.md view
@@ -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.
+ data/bip341.json view
@@ -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"+ }+ }+ ]+}
+ data/complex_psbt.json view
@@ -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"+}
haskoin-core.cabal view
@@ -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 <https://github.com/haskoin/haskoin-core#readme> 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
src/Haskoin.hs view
@@ -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
src/Haskoin/Address.hs view
@@ -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
src/Haskoin/Address/Base58.hs view
@@ -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
src/Haskoin/Address/Bech32.hs view
@@ -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
src/Haskoin/Address/CashAddr.hs view
@@ -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)
src/Haskoin/Block.hs view
@@ -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
src/Haskoin/Block/Common.hs view
@@ -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
src/Haskoin/Block/Headers.hs view
@@ -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
src/Haskoin/Block/Merkle.hs view
@@ -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
src/Haskoin/Constants.hs view
@@ -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]
src/Haskoin/Crypto.hs view
@@ -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
src/Haskoin/Crypto/Hash.hs view
@@ -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
src/Haskoin/Crypto/Signature.hs view
@@ -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.
+ src/Haskoin/Data.hs view
@@ -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)
src/Haskoin/Keys.hs view
@@ -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
src/Haskoin/Keys/Common.hs view
@@ -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
src/Haskoin/Keys/Extended.hs view
@@ -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.
+ src/Haskoin/Keys/Extended/Internal.hs view
@@ -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
src/Haskoin/Keys/Mnemonic.hs view
@@ -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"+ ]
src/Haskoin/Network.hs view
@@ -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
src/Haskoin/Network/Bloom.hs view
@@ -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
src/Haskoin/Network/Common.hs view
@@ -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: <http://en.wikipedia.org/wiki/IPv6#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: <http://en.wikipedia.org/wiki/IPv6#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
src/Haskoin/Network/Message.hs view
@@ -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
src/Haskoin/Script.hs view
@@ -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
src/Haskoin/Script/Common.hs view
@@ -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
src/Haskoin/Script/SigHash.hs view
@@ -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
src/Haskoin/Script/Standard.hs view
@@ -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
src/Haskoin/Transaction.hs view
@@ -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
src/Haskoin/Transaction/Builder.hs view
@@ -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
src/Haskoin/Transaction/Builder/Sign.hs view
@@ -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
src/Haskoin/Transaction/Common.hs view
@@ -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+ }
src/Haskoin/Transaction/Genesis.hs view
@@ -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"
src/Haskoin/Transaction/Partial.hs view
@@ -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
src/Haskoin/Transaction/Segwit.hs view
@@ -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
+ src/Haskoin/Transaction/Taproot.hs view
@@ -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
src/Haskoin/Util.hs view
@@ -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)
src/Haskoin/Util/Arbitrary.hs view
@@ -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
src/Haskoin/Util/Arbitrary/Address.hs view
@@ -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
src/Haskoin/Util/Arbitrary/Block.hs view
@@ -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
src/Haskoin/Util/Arbitrary/Crypto.hs view
@@ -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
src/Haskoin/Util/Arbitrary/Keys.hs view
@@ -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
src/Haskoin/Util/Arbitrary/Message.hs view
@@ -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
src/Haskoin/Util/Arbitrary/Network.hs view
@@ -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'.
src/Haskoin/Util/Arbitrary/Script.hs view
@@ -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.
src/Haskoin/Util/Arbitrary/Transaction.hs view
@@ -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])
src/Haskoin/Util/Arbitrary/Util.hs view
@@ -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")-
test/Haskoin/Address/Bech32Spec.hs view
@@ -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]
test/Haskoin/Address/CashAddrSpec.hs view
@@ -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"+ ) ]
test/Haskoin/AddressSpec.hs view
@@ -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"+ ) ]
test/Haskoin/BlockSpec.hs view
@@ -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
test/Haskoin/Crypto/HashSpec.hs view
@@ -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"+ ) ]
test/Haskoin/Crypto/SignatureSpec.hs view
@@ -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
test/Haskoin/Keys/ExtendedSpec.hs view
@@ -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"+ ] ]
test/Haskoin/Keys/MnemonicSpec.hs view
@@ -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
test/Haskoin/KeysSpec.hs view
@@ -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-
test/Haskoin/NetworkSpec.hs view
@@ -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
test/Haskoin/ScriptSpec.hs view
@@ -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-
test/Haskoin/Transaction/PartialSpec.hs view
@@ -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
+ test/Haskoin/Transaction/TaprootSpec.hs view
@@ -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
test/Haskoin/TransactionSpec.hs view
@@ -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
test/Haskoin/UtilSpec.hs view
@@ -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