haskoin-core 0.12.0 → 0.13.0
raw patch · 33 files changed
+1401/−1319 lines, 33 filesdep −haskoin-coredep ~HUnitdep ~QuickCheckdep ~aeson
Dependencies removed: haskoin-core
Dependency ranges changed: HUnit, QuickCheck, aeson, array, base16-bytestring, bytestring, cereal, conduit, containers, cryptonite, deepseq, entropy, hashable, hspec, memory, mtl, network, safe, scientific, split, string-conversions, text, time, transformers, unordered-containers, vector
Files
- CHANGELOG.md +12/−0
- haskoin-core.cabal +106/−64
- src/Network/Haskoin/Address.hs +15/−0
- src/Network/Haskoin/Block.hs +2/−24
- src/Network/Haskoin/Script/Common.hs +2/−4
- src/Network/Haskoin/Script/SigHash.hs +1/−1
- src/Network/Haskoin/Test.hs +0/−23
- src/Network/Haskoin/Test/Address.hs +0/−25
- src/Network/Haskoin/Test/Block.hs +0/−69
- src/Network/Haskoin/Test/Crypto.hs +0/−33
- src/Network/Haskoin/Test/Keys.hs +0/−85
- src/Network/Haskoin/Test/Message.hs +0/−52
- src/Network/Haskoin/Test/Network.hs +0/−178
- src/Network/Haskoin/Test/Script.hs +0/−374
- src/Network/Haskoin/Test/Transaction.hs +0/−275
- src/Network/Haskoin/Test/Util.hs +0/−40
- src/Network/Haskoin/Transaction.hs +7/−0
- src/Network/Haskoin/Transaction/Builder.hs +12/−14
- src/Network/Haskoin/Transaction/Builder/Sign.hs +20/−12
- src/Network/Haskoin/Transaction/Common.hs +10/−1
- src/Network/Haskoin/Transaction/Partial.hs +39/−30
- src/Network/Haskoin/Transaction/Segwit.hs +3/−3
- src/Network/Haskoin/Util.hs +18/−12
- test/Network/Haskoin/Test.hs +23/−0
- test/Network/Haskoin/Test/Address.hs +25/−0
- test/Network/Haskoin/Test/Block.hs +69/−0
- test/Network/Haskoin/Test/Crypto.hs +33/−0
- test/Network/Haskoin/Test/Keys.hs +85/−0
- test/Network/Haskoin/Test/Message.hs +52/−0
- test/Network/Haskoin/Test/Network.hs +178/−0
- test/Network/Haskoin/Test/Script.hs +374/−0
- test/Network/Haskoin/Test/Transaction.hs +275/−0
- test/Network/Haskoin/Test/Util.hs +40/−0
CHANGELOG.md view
@@ -4,6 +4,18 @@ 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.13.0+### Changed+- Consolidate all modules in Haskoin module.++### Removed+- Deprecate Network.Haskoin namespace.+- Hide QuickCheck generators in test suite.++## 0.12.0+### Added+- Support for signing segwit transactions.+ ## 0.11.0 ### Added - High-level representation of segwit v0 data and auxilliary functions.
haskoin-core.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 1ce94eac889a0e1f03131ba2275354d9e3fcffbb001fa4c0cd8e70cff3e8940a+-- hash: cb3995ebfc2aec471903f82fb6188dbb64f40fadf01471080ccf6a7948a3f7c4 name: haskoin-core-version: 0.12.0+version: 0.13.0 synopsis: Bitcoin & Bitcoin Cash library for Haskell description: Haskoin Core is a complete Bitcoin and Bitcoin Cash library of functions and data types for Haskell developers. category: Bitcoin, Finance, Network@@ -37,81 +37,68 @@ library exposed-modules: Haskoin+ other-modules: Network.Haskoin.Address Network.Haskoin.Address.Base58- Network.Haskoin.Address.CashAddr Network.Haskoin.Address.Bech32+ Network.Haskoin.Address.CashAddr Network.Haskoin.Block+ Network.Haskoin.Block.Common Network.Haskoin.Block.Headers Network.Haskoin.Block.Merkle Network.Haskoin.Constants Network.Haskoin.Crypto- Network.Haskoin.Keys- Network.Haskoin.Network- Network.Haskoin.Script- Network.Haskoin.Test- Network.Haskoin.Transaction- Network.Haskoin.Transaction.Partial- Network.Haskoin.Transaction.Segwit- Network.Haskoin.Util- other-modules:- Network.Haskoin.Block.Common Network.Haskoin.Crypto.Hash Network.Haskoin.Crypto.Signature+ Network.Haskoin.Keys Network.Haskoin.Keys.Common Network.Haskoin.Keys.Extended Network.Haskoin.Keys.Mnemonic+ Network.Haskoin.Network Network.Haskoin.Network.Bloom Network.Haskoin.Network.Common Network.Haskoin.Network.Message+ Network.Haskoin.Script Network.Haskoin.Script.Common Network.Haskoin.Script.SigHash Network.Haskoin.Script.Standard- Network.Haskoin.Test.Address- Network.Haskoin.Test.Block- Network.Haskoin.Test.Crypto- Network.Haskoin.Test.Keys- Network.Haskoin.Test.Message- Network.Haskoin.Test.Network- Network.Haskoin.Test.Script- Network.Haskoin.Test.Transaction- Network.Haskoin.Test.Util+ Network.Haskoin.Transaction Network.Haskoin.Transaction.Builder Network.Haskoin.Transaction.Builder.Sign Network.Haskoin.Transaction.Common+ Network.Haskoin.Transaction.Partial+ Network.Haskoin.Transaction.Segwit+ Network.Haskoin.Util Paths_haskoin_core hs-source-dirs: src build-depends:- HUnit- , QuickCheck- , aeson- , array+ aeson >=1.4.6.0+ , array >=0.5.4.0 , base >=4.9 && <5- , base16-bytestring- , bytestring- , cereal- , conduit- , containers- , cryptonite- , deepseq- , entropy- , hashable- , hspec- , memory- , mtl+ , base16-bytestring >=0.1.1.6+ , bytestring >=0.10.10.0+ , cereal >=0.5.8.1+ , conduit >=1.3.1.2+ , containers >=0.6.2.1+ , cryptonite >=0.26+ , deepseq >=1.4.4.0+ , entropy >=0.4.1.5+ , hashable >=1.3.0.0+ , memory >=0.15.0+ , mtl >=2.2.2 , murmur3 >=1.0.3- , network- , safe- , scientific+ , network >=3.1.1.1+ , safe >=0.3.18+ , scientific >=0.3.6.2 , secp256k1-haskell >=0.2.1- , split- , string-conversions- , text- , time- , transformers- , unordered-containers- , vector+ , split >=0.2.3.3+ , string-conversions >=0.4.0.1+ , text >=1.2.4.0+ , time >=1.9.3+ , transformers >=0.5.6.2+ , unordered-containers >=0.2.10.0+ , vector >=0.12.1.2 default-language: Haskell2010 test-suite spec@@ -130,29 +117,84 @@ Network.Haskoin.KeysSpec Network.Haskoin.NetworkSpec Network.Haskoin.ScriptSpec+ Network.Haskoin.Test+ Network.Haskoin.Test.Address+ Network.Haskoin.Test.Block+ Network.Haskoin.Test.Crypto+ Network.Haskoin.Test.Keys+ Network.Haskoin.Test.Message+ Network.Haskoin.Test.Network+ Network.Haskoin.Test.Script+ Network.Haskoin.Test.Transaction+ Network.Haskoin.Test.Util Network.Haskoin.Transaction.PartialSpec Network.Haskoin.TransactionSpec Network.Haskoin.UtilSpec+ Haskoin+ Network.Haskoin.Address+ Network.Haskoin.Address.Base58+ Network.Haskoin.Address.Bech32+ Network.Haskoin.Address.CashAddr+ Network.Haskoin.Block+ Network.Haskoin.Block.Common+ Network.Haskoin.Block.Headers+ Network.Haskoin.Block.Merkle+ Network.Haskoin.Constants+ Network.Haskoin.Crypto+ Network.Haskoin.Crypto.Hash+ Network.Haskoin.Crypto.Signature+ Network.Haskoin.Keys+ Network.Haskoin.Keys.Common+ Network.Haskoin.Keys.Extended+ Network.Haskoin.Keys.Mnemonic+ Network.Haskoin.Network+ Network.Haskoin.Network.Bloom+ Network.Haskoin.Network.Common+ Network.Haskoin.Network.Message+ Network.Haskoin.Script+ Network.Haskoin.Script.Common+ Network.Haskoin.Script.SigHash+ Network.Haskoin.Script.Standard+ Network.Haskoin.Transaction+ Network.Haskoin.Transaction.Builder+ Network.Haskoin.Transaction.Builder.Sign+ Network.Haskoin.Transaction.Common+ Network.Haskoin.Transaction.Partial+ Network.Haskoin.Transaction.Segwit+ Network.Haskoin.Util Paths_haskoin_core hs-source-dirs: test+ src build-depends:- HUnit- , QuickCheck- , aeson+ HUnit >=1.6.0.0+ , QuickCheck >=2.13.2+ , aeson >=1.4.6.0+ , array >=0.5.4.0 , base >=4.9 && <5- , bytestring- , cereal- , containers- , deepseq- , haskoin-core- , hspec- , mtl- , safe- , split- , string-conversions- , text- , unordered-containers- , vector+ , base16-bytestring >=0.1.1.6+ , bytestring >=0.10.10.0+ , cereal >=0.5.8.1+ , conduit >=1.3.1.2+ , containers >=0.6.2.1+ , cryptonite >=0.26+ , deepseq >=1.4.4.0+ , entropy >=0.4.1.5+ , hashable >=1.3.0.0+ , hspec >=2.7.1+ , memory >=0.15.0+ , mtl >=2.2.2+ , murmur3 >=1.0.3+ , network >=3.1.1.1+ , safe >=0.3.18+ , scientific >=0.3.6.2+ , secp256k1-haskell >=0.2.1+ , split >=0.2.3.3+ , string-conversions >=0.4.0.1+ , text >=1.2.4.0+ , time >=1.9.3+ , transformers >=0.5.6.2+ , unordered-containers >=0.2.10.0+ , vector >=0.12.1.2 default-language: Haskell2010 build-tool-depends: hspec-discover:hspec-discover
src/Network/Haskoin/Address.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-| Module : Network.Haskoin.Address@@ -21,6 +22,7 @@ , addrToString , stringToAddr , addrToJSON+ , addrToEncoding , addrFromJSON , pubKeyAddr , pubKeyWitnessAddr@@ -42,12 +44,19 @@ -- * Private Key Wallet Import Format (WIF) , fromWif , toWif+ -- * Base58+ , module Network.Haskoin.Address.Base58+ -- * Bech32+ , module Network.Haskoin.Address.Bech32+ -- * CashAddr+ , module Network.Haskoin.Address.CashAddr ) where import Control.Applicative import Control.DeepSeq import Control.Monad import Data.Aeson as A+import Data.Aeson.Encoding as A import Data.Aeson.Types import Data.ByteString (ByteString) import qualified Data.ByteString as B@@ -130,6 +139,12 @@ addrToJSON :: Network -> Address -> Value addrToJSON net a = toJSON (addrToString net a)++addrToEncoding :: Network -> Address -> Encoding+addrToEncoding net a =+ case addrToString net a of+ Nothing -> null_+ Just txt -> text txt -- | JSON parsing for Bitcoin addresses. Works with 'Base58', 'CashAddr' and -- 'Bech32'.
src/Network/Haskoin/Block.hs view
@@ -11,31 +11,9 @@ module Network.Haskoin.Block ( module Network.Haskoin.Block.Common -- * Block Header Chain- , BlockWork- , BlockHeaders(..)- , BlockNode(..)- , HeaderMemory(..)- , BlockMap- , getAncestor- , isGenesis- , initialChain- , genesisMap- , genesisNode- , genesisBlock- , connectBlocks- , connectBlock- , parentBlock- , splitPoint- , blockLocator+ , module Network.Haskoin.Block.Headers -- * Merkle Blocks- , MerkleBlock(..)- , MerkleRoot- , FlagBits- , PartialMerkleTree- , buildMerkleRoot- , buildPartialMerkle- , merkleBlockTxs- , testMerkleRoot+ , module Network.Haskoin.Block.Merkle ) where import Network.Haskoin.Block.Headers
src/Network/Haskoin/Script/Common.hs view
@@ -38,14 +38,11 @@ import Control.DeepSeq import Control.Monad import Data.Aeson as A+import Data.Aeson.Encoding (text) import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.Hashable import Data.Serialize as S-import Data.Serialize.Get (getByteString, getWord16le,- getWord32le, getWord8, isEmpty)-import Data.Serialize.Put (putByteString, putWord16le,- putWord32le, putWord8) import Data.Word (Word8) import GHC.Generics (Generic) import Network.Haskoin.Crypto.Hash@@ -618,6 +615,7 @@ instance ToJSON ScriptOutput where toJSON = String . encodeHex . encodeOutputBS+ toEncoding = text . encodeHex . encodeOutputBS -- | Is script a pay-to-public-key output? isPayPK :: ScriptOutput -> Bool
src/Network/Haskoin/Script/SigHash.hs view
@@ -46,7 +46,6 @@ import Data.Maybe import Data.Scientific import Data.Serialize-import Data.Serialize.Put (runPut) import Data.Word import GHC.Generics (Generic) import Network.Haskoin.Constants@@ -122,6 +121,7 @@ instance J.ToJSON SigHash where toJSON = J.Number . fromIntegral+ toEncoding (SigHash n) = J.toEncoding n -- | SIGHASH_NONE as a byte. sigHashNone :: SigHash
− src/Network/Haskoin/Test.hs
@@ -1,23 +0,0 @@-{-|-Module : Network.Haskoin.Test-Copyright : No rights reserved-License : UNLICENSE-Maintainer : jprupp@protonmail.ch-Stability : experimental-Portability : POSIX--Arbitrary instances for testing.--}-module Network.Haskoin.Test- ( module X- ) where--import Network.Haskoin.Test.Address as X-import Network.Haskoin.Test.Block as X-import Network.Haskoin.Test.Crypto as X-import Network.Haskoin.Test.Keys as X-import Network.Haskoin.Test.Message as X-import Network.Haskoin.Test.Network as X-import Network.Haskoin.Test.Script as X-import Network.Haskoin.Test.Transaction as X-import Network.Haskoin.Test.Util as X
− src/Network/Haskoin/Test/Address.hs
@@ -1,25 +0,0 @@-{-|-Module : Network.Haskoin.Test.Address-Copyright : No rights reserved-License : UNLICENSE-Maintainer : jprupp@protonmail.ch-Stability : experimental-Portability : POSIX--}-module Network.Haskoin.Test.Address where--import Network.Haskoin.Address-import Network.Haskoin.Test.Crypto-import Test.QuickCheck---- | Arbitrary pay-to-public-key-hash or pay-to-script-hash address.-arbitraryAddress :: Gen Address-arbitraryAddress = oneof [arbitraryPubKeyAddress, arbitraryScriptAddress]---- | Arbitrary pay-to-public-key-hash address.-arbitraryPubKeyAddress :: Gen Address-arbitraryPubKeyAddress = p2pkhAddr <$> arbitraryHash160---- | Arbitrary pay-to-script-hash address.-arbitraryScriptAddress :: Gen Address-arbitraryScriptAddress = p2shAddr <$> arbitraryHash160
− src/Network/Haskoin/Test/Block.hs
@@ -1,69 +0,0 @@-{-|-Module : Network.Haskoin.Test.Block-Copyright : No rights reserved-License : UNLICENSE-Maintainer : jprupp@protonmail.ch-Stability : experimental-Portability : POSIX--}-module Network.Haskoin.Test.Block where--import Network.Haskoin.Block.Merkle-import Network.Haskoin.Block.Common-import Network.Haskoin.Constants-import Network.Haskoin.Test.Crypto-import Network.Haskoin.Test.Network-import Network.Haskoin.Test.Transaction-import Test.QuickCheck---- | Block full or arbitrary transactions.-arbitraryBlock :: Network -> Gen Block-arbitraryBlock net = do- h <- arbitraryBlockHeader- c <- choose (0,10)- txs <- vectorOf c (arbitraryTx net)- return $ Block h txs---- | Block header with random hash.-arbitraryBlockHeader :: Gen BlockHeader-arbitraryBlockHeader =- BlockHeader <$> arbitrary- <*> arbitraryBlockHash- <*> arbitraryHash256- <*> arbitrary- <*> arbitrary- <*> arbitrary---- | Arbitrary block hash.-arbitraryBlockHash :: Gen BlockHash-arbitraryBlockHash = BlockHash <$> arbitraryHash256---- | Arbitrary 'GetBlocks' object with at least one block hash.-arbitraryGetBlocks :: Gen GetBlocks-arbitraryGetBlocks =- GetBlocks <$> arbitrary- <*> listOf1 arbitraryBlockHash- <*> arbitraryBlockHash---- | Arbitrary 'GetHeaders' object with at least one block header.-arbitraryGetHeaders :: Gen GetHeaders-arbitraryGetHeaders =- GetHeaders <$> arbitrary- <*> listOf1 arbitraryBlockHash- <*> arbitraryBlockHash---- | Arbitrary 'Headers' object with at least one block header.-arbitraryHeaders :: Gen Headers-arbitraryHeaders =- Headers <$> listOf1 ((,) <$> arbitraryBlockHeader <*> arbitraryVarInt)---- | Arbitrary 'MerkleBlock' with at least one hash.-arbitraryMerkleBlock :: Gen MerkleBlock-arbitraryMerkleBlock = do- bh <- arbitraryBlockHeader- ntx <- arbitrary- hashes <- listOf1 arbitraryHash256- c <- choose (1,10)- flags <- vectorOf (c*8) arbitrary- return $ MerkleBlock bh ntx hashes flags-
− src/Network/Haskoin/Test/Crypto.hs
@@ -1,33 +0,0 @@-{-|-Module : Network.Haskoin.Test.Crypto-Copyright : No rights reserved-License : UNLICENSE-Maintainer : jprupp@protonmail.ch-Stability : experimental-Portability : POSIX--}-module Network.Haskoin.Test.Crypto where--import Network.Haskoin.Crypto.Hash-import Network.Haskoin.Test.Util-import Test.QuickCheck---- | Arbitrary 160-bit hash.-arbitraryHash160 :: Gen Hash160-arbitraryHash160 =- ripemd160 <$> arbitraryBSn 20---- | Arbitrary 256-bit hash.-arbitraryHash256 :: Gen Hash256-arbitraryHash256 =- sha256 <$> arbitraryBSn 32---- | Arbitrary 512-bit hash.-arbitraryHash512 :: Gen Hash512-arbitraryHash512 =- sha512 <$> arbitraryBSn 64---- | Arbitrary 32-bit checksum.-arbitraryCheckSum32 :: Gen CheckSum32-arbitraryCheckSum32 =- checkSum32 <$> arbitraryBSn 4
− src/Network/Haskoin/Test/Keys.hs
@@ -1,85 +0,0 @@-{-|-Module : Network.Haskoin.Test.Keys-Copyright : No rights reserved-License : UNLICENSE-Maintainer : jprupp@protonmail.ch-Stability : experimental-Portability : POSIX--}-module Network.Haskoin.Test.Keys where--import Data.Bits (clearBit)-import Data.List (foldl')-import Data.Word (Word32)-import Network.Haskoin.Crypto-import Network.Haskoin.Keys.Common-import Network.Haskoin.Keys.Extended-import Network.Haskoin.Test.Crypto-import Test.QuickCheck---- | Arbitrary private key with arbitrary compressed flag.-arbitrarySecKeyI :: Gen SecKeyI-arbitrarySecKeyI = wrapSecKey <$> arbitrary <*> arbitrary---- | Arbitrary keypair, both either compressed or not.-arbitraryKeyPair :: Gen (SecKeyI, PubKeyI)-arbitraryKeyPair = do- k <- arbitrarySecKeyI- return (k, derivePubKeyI k)---- | Arbitrary extended private key.-arbitraryXPrvKey :: Gen XPrvKey-arbitraryXPrvKey =- XPrvKey <$> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitraryHash256- <*> arbitrary---- | Arbitrary extended public key with its corresponding private key.-arbitraryXPubKey :: Gen (XPrvKey, XPubKey)-arbitraryXPubKey = (\k -> (k, deriveXPubKey k)) <$> arbitraryXPrvKey--{- Custom derivations -}---- | Arbitrary derivation index with last bit unset.-genIndex :: Gen Word32-genIndex = (`clearBit` 31) <$> arbitrary---- | Arbitrary BIP-32 path index. Can be hardened or not.-arbitraryBip32PathIndex :: Gen Bip32PathIndex-arbitraryBip32PathIndex =- oneof [ Bip32SoftIndex <$> genIndex- , Bip32HardIndex <$> genIndex- ]---- | Arbitrary BIP-32 derivation path composed of only hardened derivations.-arbitraryHardPath :: Gen HardPath-arbitraryHardPath = foldl' (:|) Deriv <$> listOf genIndex---- | Arbitrary BIP-32 derivation path composed of only non-hardened derivations.-arbitrarySoftPath :: Gen SoftPath-arbitrarySoftPath = foldl' (:/) Deriv <$> listOf genIndex---- | Arbitrary derivation path composed of hardened and non-hardened derivations.-arbitraryDerivPath :: Gen DerivPath-arbitraryDerivPath = concatBip32Segments <$> listOf arbitraryBip32PathIndex---- | Arbitrary parsed derivation path. Can contain 'ParsedPrv', 'ParsedPub' or--- 'ParsedEmpty' elements.-arbitraryParsedPath :: Gen ParsedPath-arbitraryParsedPath =- 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.-arbitrarySignature :: Gen (Hash256, SecKey, Sig)-arbitrarySignature = do- m <- arbitraryHash256- key <- arbitrary- let sig = signHash key m- return (m, key, sig)
− src/Network/Haskoin/Test/Message.hs
@@ -1,52 +0,0 @@-{-|-Module : Network.Haskoin.Test.Message-Copyright : No rights reserved-License : UNLICENSE-Maintainer : jprupp@protonmail.ch-Stability : experimental-Portability : POSIX--}-module Network.Haskoin.Test.Message where--import Network.Haskoin.Constants-import Network.Haskoin.Network.Message-import Network.Haskoin.Test.Block-import Network.Haskoin.Test.Crypto-import Network.Haskoin.Test.Network-import Network.Haskoin.Test.Transaction-import Test.QuickCheck---- | Arbitrary 'MessageHeader'.-arbitraryMessageHeader :: Gen MessageHeader-arbitraryMessageHeader =- MessageHeader <$> arbitrary- <*> arbitraryMessageCommand- <*> arbitrary- <*> arbitraryCheckSum32---- | Arbitrary 'Message'.-arbitraryMessage :: Network -> Gen Message-arbitraryMessage net =- oneof- [ MVersion <$> arbitraryVersion- , return MVerAck- , MAddr <$> arbitraryAddr1- , MInv <$> arbitraryInv1- , MGetData <$> arbitraryGetData- , MNotFound <$> arbitraryNotFound- , MGetBlocks <$> arbitraryGetBlocks- , MGetHeaders <$> arbitraryGetHeaders- , MTx <$> arbitraryTx net- , MBlock <$> arbitraryBlock net- , MMerkleBlock <$> arbitraryMerkleBlock- , MHeaders <$> arbitraryHeaders- , return MGetAddr- , MFilterLoad <$> arbitraryFilterLoad- , MFilterAdd <$> arbitraryFilterAdd- , return MFilterClear- , MPing <$> arbitraryPing- , MPong <$> arbitraryPong- , MAlert <$> arbitraryAlert- , MReject <$> arbitraryReject- , return MSendHeaders- ]
− src/Network/Haskoin/Test/Network.hs
@@ -1,178 +0,0 @@-{-|-Module : Network.Haskoin.Test.Network-Copyright : No rights reserved-License : UNLICENSE-Maintainer : jprupp@protonmail.ch-Stability : experimental-Portability : POSIX--}-module Network.Haskoin.Test.Network where--import qualified Data.ByteString as BS (empty, pack)-import qualified Data.ByteString.Char8 as C8-import Data.Word (Word16, Word32)-import Network.Haskoin.Network-import Network.Haskoin.Test.Crypto-import Network.Haskoin.Test.Util-import Network.Socket (SockAddr (..))-import Test.QuickCheck---- | Arbitrary 'VarInt'.-arbitraryVarInt :: Gen VarInt-arbitraryVarInt = VarInt <$> arbitrary---- | Arbitrary 'VarString'.-arbitraryVarString :: Gen VarString-arbitraryVarString = VarString <$> arbitraryBS---- | Arbitrary 'NetworkAddress'.-arbitraryNetworkAddress :: Gen NetworkAddress-arbitraryNetworkAddress = do- 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- ]- let n = sockToHostAddress d- return $ NetworkAddress s n---- | Arbitrary 'NetworkAddressTime'.-arbitraryNetworkAddressTime :: Gen (Word32, NetworkAddress)-arbitraryNetworkAddressTime = (,) <$> arbitrary <*> arbitraryNetworkAddress---- | Arbitrary 'InvType'.-arbitraryInvType :: Gen InvType-arbitraryInvType = elements [InvError, InvTx, InvBlock, InvMerkleBlock]---- | Arbitrary 'InvVector'.-arbitraryInvVector :: Gen InvVector-arbitraryInvVector = InvVector <$> arbitraryInvType <*> arbitraryHash256---- | Arbitrary non-empty 'Inv'.-arbitraryInv1 :: Gen Inv-arbitraryInv1 = Inv <$> listOf1 arbitraryInvVector---- | Arbitrary 'Version'.-arbitraryVersion :: Gen Version-arbitraryVersion =- Version <$> 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.-arbitraryAlert :: Gen Alert-arbitraryAlert = Alert <$> arbitraryVarString <*> arbitraryVarString---- | Arbitrary 'Reject'.-arbitraryReject :: Gen Reject-arbitraryReject = do- m <- arbitraryMessageCommand- c <- arbitraryRejectCode- s <- arbitraryVarString- d <- oneof [ return BS.empty- , BS.pack <$> vectorOf 32 arbitrary- ]- return $ Reject m c s d---- | Arbitrary 'RejectCode'.-arbitraryRejectCode :: Gen RejectCode-arbitraryRejectCode =- elements- [ RejectMalformed- , RejectInvalid- , RejectInvalid- , RejectDuplicate- , RejectNonStandard- , RejectDust- , RejectInsufficientFee- , RejectCheckpoint- ]---- | Arbitrary non-empty 'GetData'.-arbitraryGetData :: Gen GetData-arbitraryGetData = GetData <$> listOf1 arbitraryInvVector---- | Arbitrary 'NotFound'.-arbitraryNotFound :: Gen NotFound-arbitraryNotFound = NotFound <$> listOf1 arbitraryInvVector---- | Arbitrary 'Ping'.-arbitraryPing :: Gen Ping-arbitraryPing = Ping <$> arbitrary---- | Arbitrary 'Pong'.-arbitraryPong :: Gen Pong-arbitraryPong = Pong <$> arbitrary---- | Arbitrary bloom filter flags.-arbitraryBloomFlags :: Gen BloomFlags-arbitraryBloomFlags =- elements- [ BloomUpdateNone- , BloomUpdateAll- , BloomUpdateP2PubKeyOnly- ]---- | 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)- tweak <- arbitrary- fl <- arbitraryBloomFlags- return (n, fp, bloomCreate n fp tweak fl)---- | Arbitrary 'FilterLoad'.-arbitraryFilterLoad :: Gen FilterLoad-arbitraryFilterLoad = do- (_, _, bf) <- arbitraryBloomFilter- return $ FilterLoad bf---- | Arbitrary 'FilterAdd'.-arbitraryFilterAdd :: Gen FilterAdd-arbitraryFilterAdd = FilterAdd <$> arbitraryBS---- | Arbitrary 'MessageCommand'.-arbitraryMessageCommand :: Gen MessageCommand-arbitraryMessageCommand = do- ASCIIString str <- arbitrary- elements- [ MCVersion- , MCVerAck- , MCAddr- , MCInv- , MCGetData- , MCNotFound- , MCGetBlocks- , MCGetHeaders- , MCTx- , MCBlock- , MCMerkleBlock- , MCHeaders- , MCGetAddr- , MCFilterLoad- , MCFilterAdd- , MCFilterClear- , MCPing- , MCPong- , MCAlert- , MCOther (C8.take 12 (C8.pack (filter (/= '\NUL') str)))- ]
− src/Network/Haskoin/Test/Script.hs
@@ -1,374 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-|-Module : Network.Haskoin.Test.Script-Copyright : No rights reserved-License : UNLICENSE-Maintainer : jprupp@protonmail.ch-Stability : experimental-Portability : POSIX--}-module Network.Haskoin.Test.Script where--import Crypto.Secp256k1-import Data.Maybe-import Data.Word-import Network.Haskoin.Address-import Network.Haskoin.Constants-import Network.Haskoin.Keys.Common-import Network.Haskoin.Script-import Network.Haskoin.Test.Address-import Network.Haskoin.Test.Crypto-import Network.Haskoin.Test.Keys-import Network.Haskoin.Test.Util-import Network.Haskoin.Transaction.Common-import Network.Haskoin.Util-import Test.QuickCheck---- | Arbitrary 'Script' with random script ops.-arbitraryScript :: Gen Script-arbitraryScript = Script <$> listOf arbitraryScriptOp---- | Arbitrary 'ScriptOp' (push operations have random data).-arbitraryScriptOp :: Gen ScriptOp-arbitraryScriptOp =- oneof- -- Pushing Data- [ opPushData <$> arbitraryBS1- , return OP_0- , return OP_1NEGATE- , return OP_RESERVED- , return OP_1- , return OP_2- , return OP_3- , return OP_4- , return OP_5- , return OP_6- , return OP_7- , return OP_8- , return OP_9- , return OP_10- , return OP_11- , return OP_12- , return OP_13- , return OP_14- , return OP_15- , return OP_16- -- Flow control- , return OP_NOP- , return OP_VER- , return OP_IF- , return OP_NOTIF- , return OP_VERIF- , return OP_VERNOTIF- , return OP_ELSE- , return OP_ENDIF- , return OP_VERIFY- , return OP_RETURN- -- Stack operations- , return OP_TOALTSTACK- , return OP_FROMALTSTACK- , return OP_IFDUP- , return OP_DEPTH- , return OP_DROP- , return OP_DUP- , return OP_NIP- , return OP_OVER- , return OP_PICK- , return OP_ROLL- , return OP_ROT- , return OP_SWAP- , return OP_TUCK- , return OP_2DROP- , return OP_2DUP- , return OP_3DUP- , return OP_2OVER- , return OP_2ROT- , return OP_2SWAP- -- Splice- , return OP_CAT- , return OP_SUBSTR- , return OP_LEFT- , return OP_RIGHT- , return OP_SIZE- -- Bitwise logic- , return OP_INVERT- , return OP_AND- , return OP_OR- , return OP_XOR- , return OP_EQUAL- , return OP_EQUALVERIFY- , return OP_RESERVED1- , return OP_RESERVED2- -- Arithmetic- , return OP_1ADD- , return OP_1SUB- , return OP_2MUL- , return OP_2DIV- , return OP_NEGATE- , return OP_ABS- , return OP_NOT- , return OP_0NOTEQUAL- , return OP_ADD- , return OP_SUB- , return OP_MUL- , return OP_DIV- , return OP_MOD- , return OP_LSHIFT- , return OP_RSHIFT- , return OP_BOOLAND- , return OP_BOOLOR- , return OP_NUMEQUAL- , return OP_NUMEQUALVERIFY- , return OP_NUMNOTEQUAL- , return OP_LESSTHAN- , return OP_GREATERTHAN- , return OP_LESSTHANOREQUAL- , return OP_GREATERTHANOREQUAL- , return OP_MIN- , return OP_MAX- , return OP_WITHIN- -- Crypto- , return OP_RIPEMD160- , return OP_SHA1- , return OP_SHA256- , return OP_HASH160- , return OP_HASH256- , return OP_CODESEPARATOR- , return OP_CHECKSIG- , return OP_CHECKSIGVERIFY- , return OP_CHECKMULTISIG- , return OP_CHECKMULTISIGVERIFY- -- Expansion- , return OP_NOP1- , return OP_NOP2- , return OP_NOP3- , return OP_NOP4- , return OP_NOP5- , return OP_NOP6- , return OP_NOP7- , return OP_NOP8- , return OP_NOP9- , return OP_NOP10- -- Other- , return OP_PUBKEYHASH- , return OP_PUBKEY- , return $ OP_INVALIDOPCODE 0xff- ]---- | Arbtirary 'ScriptOp' with a value in @[OP_1 .. OP_16]@.-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- ]---- | Arbitrary 'PushDataType'.-arbitraryPushDataType :: Gen PushDataType-arbitraryPushDataType = elements [OPCODE, OPDATA1, OPDATA2, OPDATA4]---- | Arbitrary 'SigHash' (including invalid/unknown sighash codes).-arbitrarySigHash :: Gen SigHash-arbitrarySigHash = fromIntegral <$> (arbitrary :: Gen Word32)---- | Arbitrary valid 'SigHash'.-arbitraryValidSigHash :: Network -> Gen SigHash-arbitraryValidSigHash net = do- sh <- elements [sigHashAll, sigHashNone, sigHashSingle]- f1 <-- elements $- if isJust (getSigHashForkId net)- then [id, setForkIdFlag]- else [id]- f2 <- elements [id, setAnyoneCanPayFlag]- return $ f1 $ f2 sh---- | 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- sh <- (fromIntegral <$> (arbitrary :: Gen Word8)) `suchThat` filterBad- let txsig = TxSignature sig sh- return (TxHash m, key, txsig)- where- 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)- ]---- | Arbitrary m of n parameters.-arbitraryMSParam :: Gen (Int, Int)-arbitraryMSParam = do- 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]- else []---- | Arbitrary 'ScriptOutput' of type 'PayPK', 'PayPKHash' or 'PayMS'--- (Not 'PayScriptHash', 'DataCarrier', or SegWit)-arbitrarySimpleOutput :: Gen ScriptOutput-arbitrarySimpleOutput =- oneof- [ arbitraryPKOutput- , arbitraryPKHashOutput- , arbitraryMSOutput- ]---- | Arbitrary 'ScriptOutput' of type 'PayPK'-arbitraryPKOutput :: Gen ScriptOutput-arbitraryPKOutput = PayPK . snd <$> arbitraryKeyPair---- | Arbitrary 'ScriptOutput' of type 'PayPKHash'-arbitraryPKHashOutput :: Gen ScriptOutput-arbitraryPKHashOutput = PayPKHash <$> arbitraryHash160---- | Arbitrary 'PayWitnessPKHash' output.-arbitraryWPKHashOutput :: Gen ScriptOutput-arbitraryWPKHashOutput = PayWitnessPKHash <$> arbitraryHash160---- | Arbitrary 'PayWitnessScriptHash' output.-arbitraryWSHOutput :: Gen ScriptOutput-arbitraryWSHOutput = PayWitnessScriptHash <$> arbitraryHash256---- | Arbitrary 'ScriptOutput' of type 'PayMS'.-arbitraryMSOutput :: Gen ScriptOutput-arbitraryMSOutput = do- (m, n) <- arbitraryMSParam- keys <- map snd <$> vectorOf n arbitraryKeyPair- return $ PayMulSig keys m---- | Arbitrary 'ScriptOutput' of type 'PayMS', only using compressed keys.-arbitraryMSOutputC :: Gen ScriptOutput-arbitraryMSOutputC = do- (m, n) <- arbitraryMSParam- keys <-- map snd <$>- vectorOf n (arbitraryKeyPair `suchThat` (pubKeyCompressed . snd))- return $ PayMulSig keys m---- | Arbitrary 'ScriptOutput' of type 'PayScriptHash'.-arbitrarySHOutput :: Gen ScriptOutput-arbitrarySHOutput = PayScriptHash . getAddrHash160 <$> arbitraryScriptAddress---- | Arbitrary 'ScriptOutput' of type 'DataCarrier'.-arbitraryDCOutput :: Gen ScriptOutput-arbitraryDCOutput = DataCarrier <$> arbitraryBS1---- | Arbitrary 'ScriptInput'.-arbitraryScriptInput :: Network -> Gen ScriptInput-arbitraryScriptInput net =- oneof- [ arbitraryPKInput net- , arbitraryPKHashInput net- , arbitraryMSInput net- , arbitrarySHInput net- ]---- | Arbitrary 'ScriptInput' of type 'SpendPK', 'SpendPKHash' or 'SpendMulSig'--- (not 'ScriptHashInput')-arbitrarySimpleInput :: Network -> Gen ScriptInput-arbitrarySimpleInput net =- oneof- [ arbitraryPKInput net- , arbitraryPKHashInput net- , arbitraryMSInput net- ]---- | Arbitrary 'ScriptInput' of type 'SpendPK'.-arbitraryPKInput :: Network -> Gen ScriptInput-arbitraryPKInput net = RegularInput . SpendPK <$> arbitraryTxSignatureEmpty net---- | Arbitrary 'ScriptInput' of type 'SpendPK'.-arbitraryPKHashInput :: Network -> Gen ScriptInput-arbitraryPKHashInput net = do- sig <- arbitraryTxSignatureEmpty net- key <- snd <$> arbitraryKeyPair- return $ RegularInput $ SpendPKHash sig key---- | Like 'arbitraryPKHashInput' without empty signatures.-arbitraryPKHashInputFull :: Network -> Gen ScriptInput-arbitraryPKHashInputFull net = do- sig <- lst3 <$> arbitraryTxSignature net- key <- snd <$> arbitraryKeyPair- return $ RegularInput $ SpendPKHash sig key---- | Like above but only compressed.-arbitraryPKHashInputFullC :: Network -> Gen ScriptInput-arbitraryPKHashInputFullC net = do- sig <- lst3 <$> arbitraryTxSignature net- key <- fmap snd $ arbitraryKeyPair `suchThat` (pubKeyCompressed . snd)- return $ RegularInput $ SpendPKHash sig key---- | Arbitrary 'ScriptInput' of type 'SpendMulSig'.-arbitraryMSInput :: Network -> Gen ScriptInput-arbitraryMSInput net = do- m <- fst <$> arbitraryMSParam- sigs <- vectorOf m (arbitraryTxSignatureEmpty net)- return $ RegularInput $ SpendMulSig sigs---- | Arbitrary 'ScriptInput' of type 'ScriptHashInput'.-arbitrarySHInput :: Network -> Gen ScriptInput-arbitrarySHInput net = do- i <- arbitrarySimpleInput net- ScriptHashInput (getRegularInput i) <$> arbitrarySimpleOutput---- | 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- rdm@(PayMulSig _ m) -> do- sigs <- vectorOf m (arbitraryTxSignatureEmpty net)- return $ ScriptHashInput (SpendMulSig sigs) rdm- _ -> undefined---- | 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- _ -> undefined---- | Like 'arbitraryMulSigSHCInput' with no empty signatures.-arbitraryMulSigSHInputFull :: Network -> Gen ScriptInput-arbitraryMulSigSHInputFull net =- arbitraryMSOutput >>= \case- rdm@(PayMulSig _ m) -> do- sigs <- map lst3 <$> vectorOf m (arbitraryTxSignature net)- return $ ScriptHashInput (SpendMulSig sigs) rdm- _ -> undefined---- | Like 'arbitraryMulSigSHCInput' with no empty signatures.-arbitraryMulSigSHInputFullC :: Network -> Gen ScriptInput-arbitraryMulSigSHInputFullC net =- arbitraryMSOutputC >>= \case- rdm@(PayMulSig _ m) -> do- sigs <- map lst3 <$> vectorOf m (arbitraryTxSignature net)- return $ ScriptHashInput (SpendMulSig sigs) rdm- _ -> undefined
− src/Network/Haskoin/Test/Transaction.hs
@@ -1,275 +0,0 @@-{-|-Module : Network.Haskoin.Test.Transaction-Copyright : No rights reserved-License : UNLICENSE-Maintainer : jprupp@protonmail.ch-Stability : experimental-Portability : POSIX--}-module Network.Haskoin.Test.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 Network.Haskoin.Address-import Network.Haskoin.Constants-import Network.Haskoin.Keys.Common-import Network.Haskoin.Script-import Network.Haskoin.Test.Crypto-import Network.Haskoin.Test.Keys-import Network.Haskoin.Test.Script-import Network.Haskoin.Test.Util-import Network.Haskoin.Transaction-import Test.QuickCheck---- | Wrapped coin value for testing.-newtype TestCoin = TestCoin { getTestCoin :: Word64 }- deriving (Eq, Show)--instance Coin TestCoin where- coinValue = getTestCoin---- | Arbitrary transaction hash (for non-existent transaction).-arbitraryTxHash :: Gen TxHash-arbitraryTxHash = TxHash <$> arbitraryHash256---- | Arbitrary amount of Satoshi as 'Word64' (Between 1 and 21e14)-arbitrarySatoshi :: Network -> Gen TestCoin-arbitrarySatoshi net = TestCoin <$> choose (1, getMaxSatoshi net)---- | Arbitrary 'OutPoint'.-arbitraryOutPoint :: Gen OutPoint-arbitraryOutPoint = OutPoint <$> arbitraryTxHash <*> arbitrary---- | Arbitrary 'TxOut'.-arbitraryTxOut :: Network -> Gen TxOut-arbitraryTxOut net =- TxOut <$> (getTestCoin <$> arbitrarySatoshi net)- <*> (encodeOutputBS <$> arbitraryScriptOutput net)---- | Arbitrary 'TxIn'.-arbitraryTxIn :: Network -> Gen TxIn-arbitraryTxIn net =- TxIn <$> arbitraryOutPoint- <*> (encodeInputBS <$> arbitraryScriptInput net)- <*> arbitrary---- | Arbitrary transaction. Can be regular or with witnesses.-arbitraryTx :: Network -> Gen Tx-arbitraryTx net = oneof [arbitraryLegacyTx net, arbitraryWitnessTx net]---- | Arbitrary regular transaction.-arbitraryLegacyTx :: Network -> Gen Tx-arbitraryLegacyTx net = arbitraryWLTx net False---- | Arbitrary witness transaction (witness data is fake).-arbitraryWitnessTx :: Network -> Gen Tx-arbitraryWitnessTx net = arbitraryWLTx net True---- | Arbitrary witness or legacy transaction.-arbitraryWLTx :: Network -> Bool -> Gen Tx-arbitraryWLTx net wit = do- ni <- choose (0, 5)- no <-- if wit- then choose (0, 5)- else choose- ( if ni == 0- then 2- else 0- , 5 -- avoid witness case- )- inps <- vectorOf ni (arbitraryTxIn net)- outs <- vectorOf no (arbitraryTxOut net)- let uniqueInps = nubBy (\a b -> prevOutput a == prevOutput b) inps- w <- if wit then vectorOf (length uniqueInps) (listOf arbitraryBS) 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.-arbitraryAddrOnlyTx :: Network -> Gen Tx-arbitraryAddrOnlyTx net = do- ni <- choose (0, 5)- no <- choose (0, 5)- inps <- vectorOf ni (arbitraryAddrOnlyTxIn net)- outs <- vectorOf no (arbitraryAddrOnlyTxOut net)- Tx <$> arbitrary <*> pure inps <*> pure outs <*> pure [] <*> arbitrary---- | Like 'arbitraryAddrOnlyTx' without empty signatures in the inputs.-arbitraryAddrOnlyTxFull :: Network -> Gen Tx-arbitraryAddrOnlyTxFull net = do- ni <- choose (0, 5)- no <- choose (0, 5)- inps <- vectorOf ni (arbitraryAddrOnlyTxInFull net)- 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.-arbitraryAddrOnlyTxIn :: Network -> Gen TxIn-arbitraryAddrOnlyTxIn net = do- inp <- oneof [arbitraryPKHashInput net, arbitraryMulSigSHInput net]- TxIn <$> arbitraryOutPoint <*> pure (encodeInputBS inp) <*> arbitrary---- | like 'arbitraryAddrOnlyTxIn' with no empty signatures.-arbitraryAddrOnlyTxInFull :: Network -> Gen TxIn-arbitraryAddrOnlyTxInFull net = do- inp <-- oneof [arbitraryPKHashInputFullC net, arbitraryMulSigSHInputFullC net]- TxIn <$> arbitraryOutPoint <*> pure (encodeInputBS inp) <*> arbitrary---- | Arbitrary 'TxOut' that can only be of type 'PayPKHash' or 'PaySH'.-arbitraryAddrOnlyTxOut :: Network -> Gen TxOut-arbitraryAddrOnlyTxOut net = do- v <- getTestCoin <$> arbitrarySatoshi net- out <- oneof [arbitraryPKHashOutput, arbitrarySHOutput]- return $ TxOut v $ encodeOutputBS out---- | Arbitrary 'SigInput' with the corresponding private keys used--- to generate the 'ScriptOutput' or 'RedeemScript'.-arbitrarySigInput :: Network -> Gen (SigInput, [SecKeyI])-arbitrarySigInput net =- oneof- [ wrapKey <$> arbitraryPKSigInput net- , wrapKey <$> arbitraryPKHashSigInput net- , arbitraryMSSigInput net- , arbitrarySHSigInput net- , wrapKey <$> arbitraryWPKHSigInput net- , arbitraryWSHSigInput net- ]---- | Arbitrary 'SigInput' with a 'ScriptOutput' of type 'PayPK'.-arbitraryPKSigInput :: Network -> Gen (SigInput, SecKeyI)-arbitraryPKSigInput net = arbitraryAnyInput net False---- | Arbitrary 'SigInput' with a 'ScriptOutput' of type 'PayPKHash'.-arbitraryPKHashSigInput :: Network -> Gen (SigInput, SecKeyI)-arbitraryPKHashSigInput net = arbitraryAnyInput net True---- | Arbitrary 'SigInput'.-arbitraryAnyInput :: Network -> Bool -> Gen (SigInput, SecKeyI)-arbitraryAnyInput net pkh = do- (k, p) <- arbitraryKeyPair- let out | pkh = PayPKHash $ getAddrHash160 $ pubKeyAddr p- | otherwise = PayPK p- (val, op, sh) <- arbitraryInputStuff net- return (SigInput out val op sh Nothing, k)---- | Arbitrary value, out point and sighash for an input.-arbitraryInputStuff :: Network -> Gen (Word64, OutPoint, SigHash)-arbitraryInputStuff net = do- val <- getTestCoin <$> arbitrarySatoshi net- op <- arbitraryOutPoint- sh <- arbitraryValidSigHash net- return (val, op, sh)---- | Arbitrary 'SigInput' with a 'ScriptOutput' of type 'PayMulSig'.-arbitraryMSSigInput :: Network -> Gen (SigInput, [SecKeyI])-arbitraryMSSigInput net = do- (m, n) <- arbitraryMSParam- ks <- vectorOf n arbitraryKeyPair- let out = PayMulSig (map snd ks) m- (val, op, sh) <- arbitraryInputStuff net- perm <- choose (0, n - 1)- 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'.-arbitrarySHSigInput :: Network -> Gen (SigInput, [SecKeyI])-arbitrarySHSigInput net = do- (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)--arbitraryWPKHSigInput :: Network -> Gen (SigInput, SecKeyI)-arbitraryWPKHSigInput net = do- (k, p) <- arbitraryKeyPair- (val, op, sh) <- arbitraryInputStuff net- let out = PayWitnessPKHash . getAddrHash160 $ pubKeyAddr p- return (SigInput out val op sh Nothing, k)--arbitraryWSHSigInput :: Network -> Gen (SigInput, [SecKeyI])-arbitraryWSHSigInput net = do- (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'.-arbitrarySigningData :: Network -> Gen (Tx, [SigInput], [SecKeyI])-arbitrarySigningData net = do- v <- arbitrary- ni <- choose (1, 5)- no <- choose (1, 5)- sigis <- vectorOf ni (arbitrarySigInput net)- let uSigis = nubBy (\(a, _) (b, _) -> sigInputOP a == sigInputOP b) sigis- inps <- forM uSigis $ \(s, _) -> TxIn (sigInputOP s) BS.empty <$> arbitrary- outs <- vectorOf no (arbitraryTxOut net)- l <- arbitrary- perm <- choose (0, length inps - 1)- let tx = Tx v (permutations inps !! perm) outs [] l- keys = concatMap snd uSigis- return (tx, map fst uSigis, keys)---- | Arbitrary transaction with empty inputs.-arbitraryEmptyTx :: Network -> Gen Tx-arbitraryEmptyTx net = do- v <- arbitrary- no <- choose (1,5)- ni <- choose (1,5)- outs <- vectorOf no (arbitraryTxOut net)- 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)])-arbitraryPartialTxs net = do- tx <- arbitraryEmptyTx net- res <-- forM (map prevOutput $ txIn tx) $ \op -> do- (so, val, rdmM, prvs, m, n) <- arbitraryData- txs <- mapM (singleSig so val rdmM tx op . secKeyData) prvs- return (txs, (so, val, op, m, n))- return (concatMap fst res, map snd res)- where- singleSig so val rdmM tx op prv = do- sh <- arbitraryValidSigHash net- let sigi = SigInput so val op sh rdmM- return . fromRight (error "Could not decode transaction") $- signTx net tx [sigi] [prv]- arbitraryData = do- (m, n) <- arbitraryMSParam- val <- getTestCoin <$> arbitrarySatoshi net- nPrv <- choose (m, n)- keys <- vectorOf n arbitraryKeyPair- perm <- choose (0, length keys - 1)- let pubKeys = map snd keys- prvKeys = take nPrv $ permutations (map fst keys) !! perm- let so = PayMulSig pubKeys m- elements- [ (so, val, Nothing, prvKeys, m, n)- , ( PayScriptHash $ getAddrHash160 $ payToScriptAddress so- , val- , Just so- , prvKeys- , m- , n)- ]--wrapKey :: (SigInput, SecKeyI) -> (SigInput, [SecKeyI])-wrapKey (s, k) = (s, [k])
− src/Network/Haskoin/Test/Util.hs
@@ -1,40 +0,0 @@-{-|-Module : Network.Haskoin.Test.Util-Copyright : No rights reserved-License : UNLICENSE-Maintainer : jprupp@protonmail.ch-Stability : experimental-Portability : POSIX--}-module Network.Haskoin.Test.Util where--import Data.ByteString (ByteString, pack)-import Data.Time.Clock (UTCTime (..))-import Data.Time.Clock.POSIX (posixSecondsToUTCTime)-import Data.Word (Word32)-import Test.QuickCheck---- | Arbitrary strict 'ByteString'.-arbitraryBS :: Gen ByteString-arbitraryBS = pack <$> arbitrary---- | Arbitrary non-empty strict ByteString-arbitraryBS1 :: Gen ByteString-arbitraryBS1 = pack <$> listOf1 arbitrary---- | Arbitrary strict ByteString of a given length-arbitraryBSn :: Int -> Gen ByteString-arbitraryBSn n = pack <$> vectorOf n arbitrary---- | Arbitrary UTCTime that generates dates after 01 Jan 1970 01:00:00 CET-arbitraryUTCTime :: Gen UTCTime-arbitraryUTCTime = do- w <- arbitrary :: Gen Word32- return $ posixSecondsToUTCTime $ realToFrac w---- | Generate a Maybe from a Gen a-arbitraryMaybe :: Gen a -> Gen (Maybe a)-arbitraryMaybe g = frequency [ (1, return Nothing)- , (5, Just <$> g)- ]-
src/Network/Haskoin/Transaction.hs view
@@ -10,8 +10,15 @@ -} module Network.Haskoin.Transaction ( module Common+ -- * Builder , module Builder+ -- * Segwit+ , module Segwit+ -- * Partial+ , module Partial ) where import Network.Haskoin.Transaction.Builder as Builder import Network.Haskoin.Transaction.Common as Common+import Network.Haskoin.Transaction.Partial as Partial+import Network.Haskoin.Transaction.Segwit as Segwit
src/Network/Haskoin/Transaction/Builder.hs view
@@ -69,7 +69,6 @@ import Network.Haskoin.Script import Network.Haskoin.Transaction.Builder.Sign (SigInput (..), buildInput,- makeSigHash, makeSignature, sigKeys) import qualified Network.Haskoin.Transaction.Builder.Sign as S@@ -423,25 +422,24 @@ (PayWitnessPKHash h, Nothing, SpendPKHash (TxSignature sig sh) 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)- (PayWitnessScriptHash h, Just rdm@(PayPKHash kh), SpendPKHash (TxSignature sig sh) pub) ->- payToWitnessScriptAddress rdm == p2wshAddr h &&+ (PayWitnessScriptHash h, Just rdm'@(PayPK pub), SpendPK (TxSignature sig sh)) ->+ 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 (encode 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+ 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 _ -> False- where out = encodeOutput so verifyNestedInput so so' x = case so of PayScriptHash h -> payToScriptAddress so' == p2shAddr h && verifySegwitInput so' x _ -> False inp = scriptInput $ txIn tx !! i- theTxSigHash so = makeSigHash net tx i so val+ theTxSigHash so = S.makeSigHash net tx i so val ws | length (txWitness tx) > i = txWitness tx !! i | otherwise = []@@ -466,8 +464,8 @@ h = txSigHash net tx out val i countMulSig' :: (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int-countMulSig' h [] _ = 0-countMulSig' h _ [] = 0+countMulSig' _ [] _ = 0+countMulSig' _ _ [] = 0 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'
src/Network/Haskoin/Transaction/Builder/Sign.hs view
@@ -25,10 +25,10 @@ import Control.DeepSeq (NFData) import Control.Monad (foldM, mzero, when)-import Data.Aeson (FromJSON, ToJSON,+import Data.Aeson (FromJSON, ToJSON (..), Value (Object), object,- parseJSON, toJSON, (.:),- (.:?), (.=))+ parseJSON, (.:), (.:?),+ (.=), pairs) import Data.Either (rights) import Data.Hashable (Hashable) import Data.List (find, nub)@@ -81,6 +81,13 @@ , "outpoint" .= op , "sighash" .= sh ] ++ [ "redeem" .= r | r <- maybeToList rdm ]+ toEncoding (SigInput so val op sh rdm) = pairs $+ "pkscript" .= so+ <> "value" .= val+ <> "outpoint" .= op+ <> "sighash" .= sh+ <> (case rdm of Nothing -> mempty+ Just r -> "redeem" .= r) instance FromJSON SigInput where parseJSON (Object o) = do@@ -118,7 +125,7 @@ -> (SigInput, Bool) -- ^ boolean flag: nest input -> SecKeyI -> Either String Tx-signInput net tx i (sigIn@(SigInput so val _ sh rdmM), nest) key = do+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@@ -127,12 +134,12 @@ } where f si x = x {scriptInput = encodeInputBS si}- g so x = x {scriptInput = S.encode . opPushData $ encodeOutputBS so}+ g so' x = x {scriptInput = S.encode . 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)+ nextTxIn so' si+ | isSegwit so' && nest = updateIndex i txis (g so')+ | isSegwit so' = txIn tx+ | otherwise = updateIndex i txis (f si) -- | Add the witness data of the transaction given segwit parameters for an input. --@@ -246,7 +253,8 @@ -- | Produce a structured representation of a deterministic (RFC-6979) signature over an input. makeSignature :: Network -> Tx -> Int -> SigInput -> SecKeyI -> TxSignature-makeSignature net tx i (SigInput so val _ sh rdmM) key = TxSignature (signHash (secKeyData key) m) sh+makeSignature net tx i (SigInput so val _ sh rdmM) key =+ TxSignature (signHash (secKeyData key) m) sh where m = makeSigHash net tx i so val sh rdmM @@ -265,7 +273,7 @@ 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+ PayWitnessPKHash h' -> PayPKHash h'+ _ -> fromMaybe so rdmM h | isSegwit so = txSigHashForkId | otherwise = txSigHash
src/Network/Haskoin/Transaction/Common.hs view
@@ -33,10 +33,12 @@ import Control.Monad (forM_, guard, liftM2, mzero, replicateM, (<=<)) import Data.Aeson as A+import Data.Aeson.Encoding (unsafeToEncoding) import Data.ByteString (ByteString) import qualified Data.ByteString as B+import Data.ByteString.Builder (char7) import Data.Hashable (Hashable)-import Data.Maybe (fromMaybe, maybe)+import Data.Maybe (fromMaybe) import Data.Serialize as S import Data.String (IsString, fromString) import Data.String.Conversions (cs)@@ -72,6 +74,9 @@ instance ToJSON TxHash where toJSON = A.String . txHashToHex+ toEncoding (TxHash h) =+ unsafeToEncoding $+ char7 '"' <> hexBuilder (B.reverse (S.encode h)) <> char7 '"' -- | Transaction hash excluding signatures. nosigTxHash :: Tx -> TxHash@@ -210,6 +215,8 @@ instance ToJSON Tx where toJSON = A.String . encodeHex . S.encode+ toEncoding tx =+ unsafeToEncoding $ char7 '"' <> hexBuilder (S.encode tx) <> char7 '"' -- | Data type representing a transaction input. data TxIn =@@ -268,6 +275,8 @@ instance ToJSON OutPoint where toJSON = A.String . encodeHex . S.encode+ toEncoding op =+ unsafeToEncoding $ char7 '"' <> hexBuilder (S.encode op) <> char7 '"' instance Serialize OutPoint where get = do
src/Network/Haskoin/Transaction/Partial.hs view
@@ -29,37 +29,45 @@ , emptyOutput ) where -import Control.Applicative ((<|>))+import Control.Applicative ((<|>)) import Control.DeepSeq-import Control.Monad (guard, replicateM, void)-import Data.ByteString (ByteString)-import qualified Data.ByteString as B-import Data.Hashable (Hashable)-import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as HashMap-import Data.List (foldl')-import Data.Maybe (fromMaybe, isJust)-import Data.Serialize as S-import GHC.Generics (Generic)-import GHC.Word (Word32, Word8)-import Network.Haskoin.Address (Address (..), pubKeyAddr)-import Network.Haskoin.Keys (Fingerprint, KeyIndex, PubKeyI)-import Network.Haskoin.Network (VarInt (..), VarString (..),- putVarInt)-import Network.Haskoin.Script (Script (..), ScriptOp (..),- ScriptOutput (..), SigHash,- decodeOutput, decodeOutputBS,- encodeOutputBS, isPayScriptHash,- opPushData, toP2SH, toP2WSH)-import Network.Haskoin.Transaction (Tx (..), TxOut, WitnessStack,- outPointIndex, prevOutput,- scriptInput, scriptOutput)-import Network.Haskoin.Util (eitherToMaybe)+import Control.Monad (guard, replicateM, void)+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Data.Hashable (Hashable)+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HashMap+import Data.List (foldl')+import Data.Maybe (fromMaybe, isJust)+import Data.Serialize as S+import GHC.Generics (Generic)+import GHC.Word (Word32, Word8)+import Network.Haskoin.Address (Address (..), pubKeyAddr)+import Network.Haskoin.Keys (Fingerprint, KeyIndex,+ PubKeyI)+import Network.Haskoin.Network (VarInt (..),+ VarString (..), putVarInt)+import Network.Haskoin.Script (Script (..), ScriptOp (..),+ ScriptOutput (..), SigHash,+ decodeOutput,+ decodeOutputBS,+ encodeOutputBS,+ isPayScriptHash,+ opPushData, toP2SH,+ toP2WSH)+import Network.Haskoin.Transaction.Common (Tx (..), TxOut,+ WitnessStack,+ outPointIndex, prevOutput,+ scriptInput, scriptOutput)+import Network.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.+-- | 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@@ -69,7 +77,8 @@ 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
src/Network/Haskoin/Transaction/Segwit.hs view
@@ -105,11 +105,11 @@ P2WSH (WitnessProgramSH st scr) -> do so <- decodeOutput scr fmap (Just so, ) $ case (so, st) of- (PayPK k, [sigBS]) ->+ (PayPK _, [sigBS]) -> SpendPK <$> decodeTxSig net sigBS- (PayPKHash h, [sigBS, keyBS]) ->+ (PayPKHash _, [sigBS, keyBS]) -> SpendPKHash <$> decodeTxSig net sigBS <*> S.decode keyBS- (PayMulSig ps r, "" : sigsBS) ->+ (PayMulSig _ _, "" : sigsBS) -> SpendMulSig <$> traverse (decodeTxSig net) sigsBS _ -> Left "decodeWitnessInput: Non-standard script output" EmptyWitnessProgram -> Left "decodeWitnessInput: Empty witness program"
src/Network/Haskoin/Util.hs view
@@ -14,6 +14,7 @@ -- * ByteString Helpers bsToInteger , integerToBS+ , hexBuilder , encodeHex , decodeHex , getBits@@ -40,19 +41,21 @@ ) where -import Control.Monad (guard)-import Control.Monad.Except (ExceptT (..), liftEither)-import Data.Aeson.Types (Options (..), SumEncoding (..),- defaultOptions, defaultTaggedObject)+import Control.Monad (guard)+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.Char (toLower)+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 Data.Char (toLower) import Data.List-import Data.Text (Text)-import qualified Data.Text.Encoding as E-import Data.Word (Word8)+import Data.Text (Text)+import qualified Data.Text.Encoding as E+import Data.Word (Word8) -- ByteString helpers @@ -72,9 +75,12 @@ f 0 = Nothing f x = Just (fromInteger x :: Word8, x `shiftR` 8) +hexBuilder :: ByteString -> Builder+hexBuilder = byteStringHex+ -- | Encode as string of human-readable hex characters. encodeHex :: ByteString -> Text-encodeHex = E.decodeUtf8 . B16.encode+encodeHex = E.decodeUtf8 . BL.toStrict . toLazyByteString . byteStringHex -- | Decode string of human-readable hex characters. decodeHex :: Text -> Maybe ByteString
+ test/Network/Haskoin/Test.hs view
@@ -0,0 +1,23 @@+{-|+Module : Network.Haskoin.Test+Copyright : No rights reserved+License : UNLICENSE+Maintainer : jprupp@protonmail.ch+Stability : experimental+Portability : POSIX++Arbitrary instances for testing.+-}+module Network.Haskoin.Test+ ( module X+ ) where++import Network.Haskoin.Test.Address as X+import Network.Haskoin.Test.Block as X+import Network.Haskoin.Test.Crypto as X+import Network.Haskoin.Test.Keys as X+import Network.Haskoin.Test.Message as X+import Network.Haskoin.Test.Network as X+import Network.Haskoin.Test.Script as X+import Network.Haskoin.Test.Transaction as X+import Network.Haskoin.Test.Util as X
+ test/Network/Haskoin/Test/Address.hs view
@@ -0,0 +1,25 @@+{-|+Module : Network.Haskoin.Test.Address+Copyright : No rights reserved+License : UNLICENSE+Maintainer : jprupp@protonmail.ch+Stability : experimental+Portability : POSIX+-}+module Network.Haskoin.Test.Address where++import Network.Haskoin.Address+import Network.Haskoin.Test.Crypto+import Test.QuickCheck++-- | Arbitrary pay-to-public-key-hash or pay-to-script-hash address.+arbitraryAddress :: Gen Address+arbitraryAddress = oneof [arbitraryPubKeyAddress, arbitraryScriptAddress]++-- | Arbitrary pay-to-public-key-hash address.+arbitraryPubKeyAddress :: Gen Address+arbitraryPubKeyAddress = p2pkhAddr <$> arbitraryHash160++-- | Arbitrary pay-to-script-hash address.+arbitraryScriptAddress :: Gen Address+arbitraryScriptAddress = p2shAddr <$> arbitraryHash160
+ test/Network/Haskoin/Test/Block.hs view
@@ -0,0 +1,69 @@+{-|+Module : Network.Haskoin.Test.Block+Copyright : No rights reserved+License : UNLICENSE+Maintainer : jprupp@protonmail.ch+Stability : experimental+Portability : POSIX+-}+module Network.Haskoin.Test.Block where++import Network.Haskoin.Block.Merkle+import Network.Haskoin.Block.Common+import Network.Haskoin.Constants+import Network.Haskoin.Test.Crypto+import Network.Haskoin.Test.Network+import Network.Haskoin.Test.Transaction+import Test.QuickCheck++-- | Block full or arbitrary transactions.+arbitraryBlock :: Network -> Gen Block+arbitraryBlock net = do+ h <- arbitraryBlockHeader+ c <- choose (0,10)+ txs <- vectorOf c (arbitraryTx net)+ return $ Block h txs++-- | Block header with random hash.+arbitraryBlockHeader :: Gen BlockHeader+arbitraryBlockHeader =+ BlockHeader <$> arbitrary+ <*> arbitraryBlockHash+ <*> arbitraryHash256+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++-- | Arbitrary block hash.+arbitraryBlockHash :: Gen BlockHash+arbitraryBlockHash = BlockHash <$> arbitraryHash256++-- | Arbitrary 'GetBlocks' object with at least one block hash.+arbitraryGetBlocks :: Gen GetBlocks+arbitraryGetBlocks =+ GetBlocks <$> arbitrary+ <*> listOf1 arbitraryBlockHash+ <*> arbitraryBlockHash++-- | Arbitrary 'GetHeaders' object with at least one block header.+arbitraryGetHeaders :: Gen GetHeaders+arbitraryGetHeaders =+ GetHeaders <$> arbitrary+ <*> listOf1 arbitraryBlockHash+ <*> arbitraryBlockHash++-- | Arbitrary 'Headers' object with at least one block header.+arbitraryHeaders :: Gen Headers+arbitraryHeaders =+ Headers <$> listOf1 ((,) <$> arbitraryBlockHeader <*> arbitraryVarInt)++-- | Arbitrary 'MerkleBlock' with at least one hash.+arbitraryMerkleBlock :: Gen MerkleBlock+arbitraryMerkleBlock = do+ bh <- arbitraryBlockHeader+ ntx <- arbitrary+ hashes <- listOf1 arbitraryHash256+ c <- choose (1,10)+ flags <- vectorOf (c*8) arbitrary+ return $ MerkleBlock bh ntx hashes flags+
+ test/Network/Haskoin/Test/Crypto.hs view
@@ -0,0 +1,33 @@+{-|+Module : Network.Haskoin.Test.Crypto+Copyright : No rights reserved+License : UNLICENSE+Maintainer : jprupp@protonmail.ch+Stability : experimental+Portability : POSIX+-}+module Network.Haskoin.Test.Crypto where++import Network.Haskoin.Crypto.Hash+import Network.Haskoin.Test.Util+import Test.QuickCheck++-- | Arbitrary 160-bit hash.+arbitraryHash160 :: Gen Hash160+arbitraryHash160 =+ ripemd160 <$> arbitraryBSn 20++-- | Arbitrary 256-bit hash.+arbitraryHash256 :: Gen Hash256+arbitraryHash256 =+ sha256 <$> arbitraryBSn 32++-- | Arbitrary 512-bit hash.+arbitraryHash512 :: Gen Hash512+arbitraryHash512 =+ sha512 <$> arbitraryBSn 64++-- | Arbitrary 32-bit checksum.+arbitraryCheckSum32 :: Gen CheckSum32+arbitraryCheckSum32 =+ checkSum32 <$> arbitraryBSn 4
+ test/Network/Haskoin/Test/Keys.hs view
@@ -0,0 +1,85 @@+{-|+Module : Network.Haskoin.Test.Keys+Copyright : No rights reserved+License : UNLICENSE+Maintainer : jprupp@protonmail.ch+Stability : experimental+Portability : POSIX+-}+module Network.Haskoin.Test.Keys where++import Data.Bits (clearBit)+import Data.List (foldl')+import Data.Word (Word32)+import Network.Haskoin.Crypto+import Network.Haskoin.Keys.Common+import Network.Haskoin.Keys.Extended+import Network.Haskoin.Test.Crypto+import Test.QuickCheck++-- | Arbitrary private key with arbitrary compressed flag.+arbitrarySecKeyI :: Gen SecKeyI+arbitrarySecKeyI = wrapSecKey <$> arbitrary <*> arbitrary++-- | Arbitrary keypair, both either compressed or not.+arbitraryKeyPair :: Gen (SecKeyI, PubKeyI)+arbitraryKeyPair = do+ k <- arbitrarySecKeyI+ return (k, derivePubKeyI k)++-- | Arbitrary extended private key.+arbitraryXPrvKey :: Gen XPrvKey+arbitraryXPrvKey =+ XPrvKey <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitraryHash256+ <*> arbitrary++-- | Arbitrary extended public key with its corresponding private key.+arbitraryXPubKey :: Gen (XPrvKey, XPubKey)+arbitraryXPubKey = (\k -> (k, deriveXPubKey k)) <$> arbitraryXPrvKey++{- Custom derivations -}++-- | Arbitrary derivation index with last bit unset.+genIndex :: Gen Word32+genIndex = (`clearBit` 31) <$> arbitrary++-- | Arbitrary BIP-32 path index. Can be hardened or not.+arbitraryBip32PathIndex :: Gen Bip32PathIndex+arbitraryBip32PathIndex =+ oneof [ Bip32SoftIndex <$> genIndex+ , Bip32HardIndex <$> genIndex+ ]++-- | Arbitrary BIP-32 derivation path composed of only hardened derivations.+arbitraryHardPath :: Gen HardPath+arbitraryHardPath = foldl' (:|) Deriv <$> listOf genIndex++-- | Arbitrary BIP-32 derivation path composed of only non-hardened derivations.+arbitrarySoftPath :: Gen SoftPath+arbitrarySoftPath = foldl' (:/) Deriv <$> listOf genIndex++-- | Arbitrary derivation path composed of hardened and non-hardened derivations.+arbitraryDerivPath :: Gen DerivPath+arbitraryDerivPath = concatBip32Segments <$> listOf arbitraryBip32PathIndex++-- | Arbitrary parsed derivation path. Can contain 'ParsedPrv', 'ParsedPub' or+-- 'ParsedEmpty' elements.+arbitraryParsedPath :: Gen ParsedPath+arbitraryParsedPath =+ 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.+arbitrarySignature :: Gen (Hash256, SecKey, Sig)+arbitrarySignature = do+ m <- arbitraryHash256+ key <- arbitrary+ let sig = signHash key m+ return (m, key, sig)
+ test/Network/Haskoin/Test/Message.hs view
@@ -0,0 +1,52 @@+{-|+Module : Network.Haskoin.Test.Message+Copyright : No rights reserved+License : UNLICENSE+Maintainer : jprupp@protonmail.ch+Stability : experimental+Portability : POSIX+-}+module Network.Haskoin.Test.Message where++import Network.Haskoin.Constants+import Network.Haskoin.Network.Message+import Network.Haskoin.Test.Block+import Network.Haskoin.Test.Crypto+import Network.Haskoin.Test.Network+import Network.Haskoin.Test.Transaction+import Test.QuickCheck++-- | Arbitrary 'MessageHeader'.+arbitraryMessageHeader :: Gen MessageHeader+arbitraryMessageHeader =+ MessageHeader <$> arbitrary+ <*> arbitraryMessageCommand+ <*> arbitrary+ <*> arbitraryCheckSum32++-- | Arbitrary 'Message'.+arbitraryMessage :: Network -> Gen Message+arbitraryMessage net =+ oneof+ [ MVersion <$> arbitraryVersion+ , return MVerAck+ , MAddr <$> arbitraryAddr1+ , MInv <$> arbitraryInv1+ , MGetData <$> arbitraryGetData+ , MNotFound <$> arbitraryNotFound+ , MGetBlocks <$> arbitraryGetBlocks+ , MGetHeaders <$> arbitraryGetHeaders+ , MTx <$> arbitraryTx net+ , MBlock <$> arbitraryBlock net+ , MMerkleBlock <$> arbitraryMerkleBlock+ , MHeaders <$> arbitraryHeaders+ , return MGetAddr+ , MFilterLoad <$> arbitraryFilterLoad+ , MFilterAdd <$> arbitraryFilterAdd+ , return MFilterClear+ , MPing <$> arbitraryPing+ , MPong <$> arbitraryPong+ , MAlert <$> arbitraryAlert+ , MReject <$> arbitraryReject+ , return MSendHeaders+ ]
+ test/Network/Haskoin/Test/Network.hs view
@@ -0,0 +1,178 @@+{-|+Module : Network.Haskoin.Test.Network+Copyright : No rights reserved+License : UNLICENSE+Maintainer : jprupp@protonmail.ch+Stability : experimental+Portability : POSIX+-}+module Network.Haskoin.Test.Network where++import qualified Data.ByteString as BS (empty, pack)+import qualified Data.ByteString.Char8 as C8+import Data.Word (Word16, Word32)+import Network.Haskoin.Network+import Network.Haskoin.Test.Crypto+import Network.Haskoin.Test.Util+import Network.Socket (SockAddr (..))+import Test.QuickCheck++-- | Arbitrary 'VarInt'.+arbitraryVarInt :: Gen VarInt+arbitraryVarInt = VarInt <$> arbitrary++-- | Arbitrary 'VarString'.+arbitraryVarString :: Gen VarString+arbitraryVarString = VarString <$> arbitraryBS++-- | Arbitrary 'NetworkAddress'.+arbitraryNetworkAddress :: Gen NetworkAddress+arbitraryNetworkAddress = do+ 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+ ]+ let n = sockToHostAddress d+ return $ NetworkAddress s n++-- | Arbitrary 'NetworkAddressTime'.+arbitraryNetworkAddressTime :: Gen (Word32, NetworkAddress)+arbitraryNetworkAddressTime = (,) <$> arbitrary <*> arbitraryNetworkAddress++-- | Arbitrary 'InvType'.+arbitraryInvType :: Gen InvType+arbitraryInvType = elements [InvError, InvTx, InvBlock, InvMerkleBlock]++-- | Arbitrary 'InvVector'.+arbitraryInvVector :: Gen InvVector+arbitraryInvVector = InvVector <$> arbitraryInvType <*> arbitraryHash256++-- | Arbitrary non-empty 'Inv'.+arbitraryInv1 :: Gen Inv+arbitraryInv1 = Inv <$> listOf1 arbitraryInvVector++-- | Arbitrary 'Version'.+arbitraryVersion :: Gen Version+arbitraryVersion =+ Version <$> 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.+arbitraryAlert :: Gen Alert+arbitraryAlert = Alert <$> arbitraryVarString <*> arbitraryVarString++-- | Arbitrary 'Reject'.+arbitraryReject :: Gen Reject+arbitraryReject = do+ m <- arbitraryMessageCommand+ c <- arbitraryRejectCode+ s <- arbitraryVarString+ d <- oneof [ return BS.empty+ , BS.pack <$> vectorOf 32 arbitrary+ ]+ return $ Reject m c s d++-- | Arbitrary 'RejectCode'.+arbitraryRejectCode :: Gen RejectCode+arbitraryRejectCode =+ elements+ [ RejectMalformed+ , RejectInvalid+ , RejectInvalid+ , RejectDuplicate+ , RejectNonStandard+ , RejectDust+ , RejectInsufficientFee+ , RejectCheckpoint+ ]++-- | Arbitrary non-empty 'GetData'.+arbitraryGetData :: Gen GetData+arbitraryGetData = GetData <$> listOf1 arbitraryInvVector++-- | Arbitrary 'NotFound'.+arbitraryNotFound :: Gen NotFound+arbitraryNotFound = NotFound <$> listOf1 arbitraryInvVector++-- | Arbitrary 'Ping'.+arbitraryPing :: Gen Ping+arbitraryPing = Ping <$> arbitrary++-- | Arbitrary 'Pong'.+arbitraryPong :: Gen Pong+arbitraryPong = Pong <$> arbitrary++-- | Arbitrary bloom filter flags.+arbitraryBloomFlags :: Gen BloomFlags+arbitraryBloomFlags =+ elements+ [ BloomUpdateNone+ , BloomUpdateAll+ , BloomUpdateP2PubKeyOnly+ ]++-- | 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)+ tweak <- arbitrary+ fl <- arbitraryBloomFlags+ return (n, fp, bloomCreate n fp tweak fl)++-- | Arbitrary 'FilterLoad'.+arbitraryFilterLoad :: Gen FilterLoad+arbitraryFilterLoad = do+ (_, _, bf) <- arbitraryBloomFilter+ return $ FilterLoad bf++-- | Arbitrary 'FilterAdd'.+arbitraryFilterAdd :: Gen FilterAdd+arbitraryFilterAdd = FilterAdd <$> arbitraryBS++-- | Arbitrary 'MessageCommand'.+arbitraryMessageCommand :: Gen MessageCommand+arbitraryMessageCommand = do+ ASCIIString str <- arbitrary+ elements+ [ MCVersion+ , MCVerAck+ , MCAddr+ , MCInv+ , MCGetData+ , MCNotFound+ , MCGetBlocks+ , MCGetHeaders+ , MCTx+ , MCBlock+ , MCMerkleBlock+ , MCHeaders+ , MCGetAddr+ , MCFilterLoad+ , MCFilterAdd+ , MCFilterClear+ , MCPing+ , MCPong+ , MCAlert+ , MCOther (C8.take 12 (C8.pack (filter (/= '\NUL') str)))+ ]
+ test/Network/Haskoin/Test/Script.hs view
@@ -0,0 +1,374 @@+{-# LANGUAGE LambdaCase #-}+{-|+Module : Network.Haskoin.Test.Script+Copyright : No rights reserved+License : UNLICENSE+Maintainer : jprupp@protonmail.ch+Stability : experimental+Portability : POSIX+-}+module Network.Haskoin.Test.Script where++import Crypto.Secp256k1+import Data.Maybe+import Data.Word+import Network.Haskoin.Address+import Network.Haskoin.Constants+import Network.Haskoin.Keys.Common+import Network.Haskoin.Script+import Network.Haskoin.Test.Address+import Network.Haskoin.Test.Crypto+import Network.Haskoin.Test.Keys+import Network.Haskoin.Test.Util+import Network.Haskoin.Transaction.Common+import Network.Haskoin.Util+import Test.QuickCheck++-- | Arbitrary 'Script' with random script ops.+arbitraryScript :: Gen Script+arbitraryScript = Script <$> listOf arbitraryScriptOp++-- | Arbitrary 'ScriptOp' (push operations have random data).+arbitraryScriptOp :: Gen ScriptOp+arbitraryScriptOp =+ oneof+ -- Pushing Data+ [ opPushData <$> arbitraryBS1+ , return OP_0+ , return OP_1NEGATE+ , return OP_RESERVED+ , return OP_1+ , return OP_2+ , return OP_3+ , return OP_4+ , return OP_5+ , return OP_6+ , return OP_7+ , return OP_8+ , return OP_9+ , return OP_10+ , return OP_11+ , return OP_12+ , return OP_13+ , return OP_14+ , return OP_15+ , return OP_16+ -- Flow control+ , return OP_NOP+ , return OP_VER+ , return OP_IF+ , return OP_NOTIF+ , return OP_VERIF+ , return OP_VERNOTIF+ , return OP_ELSE+ , return OP_ENDIF+ , return OP_VERIFY+ , return OP_RETURN+ -- Stack operations+ , return OP_TOALTSTACK+ , return OP_FROMALTSTACK+ , return OP_IFDUP+ , return OP_DEPTH+ , return OP_DROP+ , return OP_DUP+ , return OP_NIP+ , return OP_OVER+ , return OP_PICK+ , return OP_ROLL+ , return OP_ROT+ , return OP_SWAP+ , return OP_TUCK+ , return OP_2DROP+ , return OP_2DUP+ , return OP_3DUP+ , return OP_2OVER+ , return OP_2ROT+ , return OP_2SWAP+ -- Splice+ , return OP_CAT+ , return OP_SUBSTR+ , return OP_LEFT+ , return OP_RIGHT+ , return OP_SIZE+ -- Bitwise logic+ , return OP_INVERT+ , return OP_AND+ , return OP_OR+ , return OP_XOR+ , return OP_EQUAL+ , return OP_EQUALVERIFY+ , return OP_RESERVED1+ , return OP_RESERVED2+ -- Arithmetic+ , return OP_1ADD+ , return OP_1SUB+ , return OP_2MUL+ , return OP_2DIV+ , return OP_NEGATE+ , return OP_ABS+ , return OP_NOT+ , return OP_0NOTEQUAL+ , return OP_ADD+ , return OP_SUB+ , return OP_MUL+ , return OP_DIV+ , return OP_MOD+ , return OP_LSHIFT+ , return OP_RSHIFT+ , return OP_BOOLAND+ , return OP_BOOLOR+ , return OP_NUMEQUAL+ , return OP_NUMEQUALVERIFY+ , return OP_NUMNOTEQUAL+ , return OP_LESSTHAN+ , return OP_GREATERTHAN+ , return OP_LESSTHANOREQUAL+ , return OP_GREATERTHANOREQUAL+ , return OP_MIN+ , return OP_MAX+ , return OP_WITHIN+ -- Crypto+ , return OP_RIPEMD160+ , return OP_SHA1+ , return OP_SHA256+ , return OP_HASH160+ , return OP_HASH256+ , return OP_CODESEPARATOR+ , return OP_CHECKSIG+ , return OP_CHECKSIGVERIFY+ , return OP_CHECKMULTISIG+ , return OP_CHECKMULTISIGVERIFY+ -- Expansion+ , return OP_NOP1+ , return OP_NOP2+ , return OP_NOP3+ , return OP_NOP4+ , return OP_NOP5+ , return OP_NOP6+ , return OP_NOP7+ , return OP_NOP8+ , return OP_NOP9+ , return OP_NOP10+ -- Other+ , return OP_PUBKEYHASH+ , return OP_PUBKEY+ , return $ OP_INVALIDOPCODE 0xff+ ]++-- | Arbtirary 'ScriptOp' with a value in @[OP_1 .. OP_16]@.+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+ ]++-- | Arbitrary 'PushDataType'.+arbitraryPushDataType :: Gen PushDataType+arbitraryPushDataType = elements [OPCODE, OPDATA1, OPDATA2, OPDATA4]++-- | Arbitrary 'SigHash' (including invalid/unknown sighash codes).+arbitrarySigHash :: Gen SigHash+arbitrarySigHash = fromIntegral <$> (arbitrary :: Gen Word32)++-- | Arbitrary valid 'SigHash'.+arbitraryValidSigHash :: Network -> Gen SigHash+arbitraryValidSigHash net = do+ sh <- elements [sigHashAll, sigHashNone, sigHashSingle]+ f1 <-+ elements $+ if isJust (getSigHashForkId net)+ then [id, setForkIdFlag]+ else [id]+ f2 <- elements [id, setAnyoneCanPayFlag]+ return $ f1 $ f2 sh++-- | 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+ sh <- (fromIntegral <$> (arbitrary :: Gen Word8)) `suchThat` filterBad+ let txsig = TxSignature sig sh+ return (TxHash m, key, txsig)+ where+ 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)+ ]++-- | Arbitrary m of n parameters.+arbitraryMSParam :: Gen (Int, Int)+arbitraryMSParam = do+ 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]+ else []++-- | Arbitrary 'ScriptOutput' of type 'PayPK', 'PayPKHash' or 'PayMS'+-- (Not 'PayScriptHash', 'DataCarrier', or SegWit)+arbitrarySimpleOutput :: Gen ScriptOutput+arbitrarySimpleOutput =+ oneof+ [ arbitraryPKOutput+ , arbitraryPKHashOutput+ , arbitraryMSOutput+ ]++-- | Arbitrary 'ScriptOutput' of type 'PayPK'+arbitraryPKOutput :: Gen ScriptOutput+arbitraryPKOutput = PayPK . snd <$> arbitraryKeyPair++-- | Arbitrary 'ScriptOutput' of type 'PayPKHash'+arbitraryPKHashOutput :: Gen ScriptOutput+arbitraryPKHashOutput = PayPKHash <$> arbitraryHash160++-- | Arbitrary 'PayWitnessPKHash' output.+arbitraryWPKHashOutput :: Gen ScriptOutput+arbitraryWPKHashOutput = PayWitnessPKHash <$> arbitraryHash160++-- | Arbitrary 'PayWitnessScriptHash' output.+arbitraryWSHOutput :: Gen ScriptOutput+arbitraryWSHOutput = PayWitnessScriptHash <$> arbitraryHash256++-- | Arbitrary 'ScriptOutput' of type 'PayMS'.+arbitraryMSOutput :: Gen ScriptOutput+arbitraryMSOutput = do+ (m, n) <- arbitraryMSParam+ keys <- map snd <$> vectorOf n arbitraryKeyPair+ return $ PayMulSig keys m++-- | Arbitrary 'ScriptOutput' of type 'PayMS', only using compressed keys.+arbitraryMSOutputC :: Gen ScriptOutput+arbitraryMSOutputC = do+ (m, n) <- arbitraryMSParam+ keys <-+ map snd <$>+ vectorOf n (arbitraryKeyPair `suchThat` (pubKeyCompressed . snd))+ return $ PayMulSig keys m++-- | Arbitrary 'ScriptOutput' of type 'PayScriptHash'.+arbitrarySHOutput :: Gen ScriptOutput+arbitrarySHOutput = PayScriptHash . getAddrHash160 <$> arbitraryScriptAddress++-- | Arbitrary 'ScriptOutput' of type 'DataCarrier'.+arbitraryDCOutput :: Gen ScriptOutput+arbitraryDCOutput = DataCarrier <$> arbitraryBS1++-- | Arbitrary 'ScriptInput'.+arbitraryScriptInput :: Network -> Gen ScriptInput+arbitraryScriptInput net =+ oneof+ [ arbitraryPKInput net+ , arbitraryPKHashInput net+ , arbitraryMSInput net+ , arbitrarySHInput net+ ]++-- | Arbitrary 'ScriptInput' of type 'SpendPK', 'SpendPKHash' or 'SpendMulSig'+-- (not 'ScriptHashInput')+arbitrarySimpleInput :: Network -> Gen ScriptInput+arbitrarySimpleInput net =+ oneof+ [ arbitraryPKInput net+ , arbitraryPKHashInput net+ , arbitraryMSInput net+ ]++-- | Arbitrary 'ScriptInput' of type 'SpendPK'.+arbitraryPKInput :: Network -> Gen ScriptInput+arbitraryPKInput net = RegularInput . SpendPK <$> arbitraryTxSignatureEmpty net++-- | Arbitrary 'ScriptInput' of type 'SpendPK'.+arbitraryPKHashInput :: Network -> Gen ScriptInput+arbitraryPKHashInput net = do+ sig <- arbitraryTxSignatureEmpty net+ key <- snd <$> arbitraryKeyPair+ return $ RegularInput $ SpendPKHash sig key++-- | Like 'arbitraryPKHashInput' without empty signatures.+arbitraryPKHashInputFull :: Network -> Gen ScriptInput+arbitraryPKHashInputFull net = do+ sig <- lst3 <$> arbitraryTxSignature net+ key <- snd <$> arbitraryKeyPair+ return $ RegularInput $ SpendPKHash sig key++-- | Like above but only compressed.+arbitraryPKHashInputFullC :: Network -> Gen ScriptInput+arbitraryPKHashInputFullC net = do+ sig <- lst3 <$> arbitraryTxSignature net+ key <- fmap snd $ arbitraryKeyPair `suchThat` (pubKeyCompressed . snd)+ return $ RegularInput $ SpendPKHash sig key++-- | Arbitrary 'ScriptInput' of type 'SpendMulSig'.+arbitraryMSInput :: Network -> Gen ScriptInput+arbitraryMSInput net = do+ m <- fst <$> arbitraryMSParam+ sigs <- vectorOf m (arbitraryTxSignatureEmpty net)+ return $ RegularInput $ SpendMulSig sigs++-- | Arbitrary 'ScriptInput' of type 'ScriptHashInput'.+arbitrarySHInput :: Network -> Gen ScriptInput+arbitrarySHInput net = do+ i <- arbitrarySimpleInput net+ ScriptHashInput (getRegularInput i) <$> arbitrarySimpleOutput++-- | 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+ rdm@(PayMulSig _ m) -> do+ sigs <- vectorOf m (arbitraryTxSignatureEmpty net)+ return $ ScriptHashInput (SpendMulSig sigs) rdm+ _ -> undefined++-- | 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+ _ -> undefined++-- | Like 'arbitraryMulSigSHCInput' with no empty signatures.+arbitraryMulSigSHInputFull :: Network -> Gen ScriptInput+arbitraryMulSigSHInputFull net =+ arbitraryMSOutput >>= \case+ rdm@(PayMulSig _ m) -> do+ sigs <- map lst3 <$> vectorOf m (arbitraryTxSignature net)+ return $ ScriptHashInput (SpendMulSig sigs) rdm+ _ -> undefined++-- | Like 'arbitraryMulSigSHCInput' with no empty signatures.+arbitraryMulSigSHInputFullC :: Network -> Gen ScriptInput+arbitraryMulSigSHInputFullC net =+ arbitraryMSOutputC >>= \case+ rdm@(PayMulSig _ m) -> do+ sigs <- map lst3 <$> vectorOf m (arbitraryTxSignature net)+ return $ ScriptHashInput (SpendMulSig sigs) rdm+ _ -> undefined
+ test/Network/Haskoin/Test/Transaction.hs view
@@ -0,0 +1,275 @@+{-|+Module : Network.Haskoin.Test.Transaction+Copyright : No rights reserved+License : UNLICENSE+Maintainer : jprupp@protonmail.ch+Stability : experimental+Portability : POSIX+-}+module Network.Haskoin.Test.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 Network.Haskoin.Address+import Network.Haskoin.Constants+import Network.Haskoin.Keys.Common+import Network.Haskoin.Script+import Network.Haskoin.Test.Crypto+import Network.Haskoin.Test.Keys+import Network.Haskoin.Test.Script+import Network.Haskoin.Test.Util+import Network.Haskoin.Transaction+import Test.QuickCheck++-- | Wrapped coin value for testing.+newtype TestCoin = TestCoin { getTestCoin :: Word64 }+ deriving (Eq, Show)++instance Coin TestCoin where+ coinValue = getTestCoin++-- | Arbitrary transaction hash (for non-existent transaction).+arbitraryTxHash :: Gen TxHash+arbitraryTxHash = TxHash <$> arbitraryHash256++-- | Arbitrary amount of Satoshi as 'Word64' (Between 1 and 21e14)+arbitrarySatoshi :: Network -> Gen TestCoin+arbitrarySatoshi net = TestCoin <$> choose (1, getMaxSatoshi net)++-- | Arbitrary 'OutPoint'.+arbitraryOutPoint :: Gen OutPoint+arbitraryOutPoint = OutPoint <$> arbitraryTxHash <*> arbitrary++-- | Arbitrary 'TxOut'.+arbitraryTxOut :: Network -> Gen TxOut+arbitraryTxOut net =+ TxOut <$> (getTestCoin <$> arbitrarySatoshi net)+ <*> (encodeOutputBS <$> arbitraryScriptOutput net)++-- | Arbitrary 'TxIn'.+arbitraryTxIn :: Network -> Gen TxIn+arbitraryTxIn net =+ TxIn <$> arbitraryOutPoint+ <*> (encodeInputBS <$> arbitraryScriptInput net)+ <*> arbitrary++-- | Arbitrary transaction. Can be regular or with witnesses.+arbitraryTx :: Network -> Gen Tx+arbitraryTx net = oneof [arbitraryLegacyTx net, arbitraryWitnessTx net]++-- | Arbitrary regular transaction.+arbitraryLegacyTx :: Network -> Gen Tx+arbitraryLegacyTx net = arbitraryWLTx net False++-- | Arbitrary witness transaction (witness data is fake).+arbitraryWitnessTx :: Network -> Gen Tx+arbitraryWitnessTx net = arbitraryWLTx net True++-- | Arbitrary witness or legacy transaction.+arbitraryWLTx :: Network -> Bool -> Gen Tx+arbitraryWLTx net wit = do+ ni <- choose (0, 5)+ no <-+ if wit+ then choose (0, 5)+ else choose+ ( if ni == 0+ then 2+ else 0+ , 5 -- avoid witness case+ )+ inps <- vectorOf ni (arbitraryTxIn net)+ outs <- vectorOf no (arbitraryTxOut net)+ let uniqueInps = nubBy (\a b -> prevOutput a == prevOutput b) inps+ w <- if wit then vectorOf (length uniqueInps) (listOf arbitraryBS) 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.+arbitraryAddrOnlyTx :: Network -> Gen Tx+arbitraryAddrOnlyTx net = do+ ni <- choose (0, 5)+ no <- choose (0, 5)+ inps <- vectorOf ni (arbitraryAddrOnlyTxIn net)+ outs <- vectorOf no (arbitraryAddrOnlyTxOut net)+ Tx <$> arbitrary <*> pure inps <*> pure outs <*> pure [] <*> arbitrary++-- | Like 'arbitraryAddrOnlyTx' without empty signatures in the inputs.+arbitraryAddrOnlyTxFull :: Network -> Gen Tx+arbitraryAddrOnlyTxFull net = do+ ni <- choose (0, 5)+ no <- choose (0, 5)+ inps <- vectorOf ni (arbitraryAddrOnlyTxInFull net)+ 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.+arbitraryAddrOnlyTxIn :: Network -> Gen TxIn+arbitraryAddrOnlyTxIn net = do+ inp <- oneof [arbitraryPKHashInput net, arbitraryMulSigSHInput net]+ TxIn <$> arbitraryOutPoint <*> pure (encodeInputBS inp) <*> arbitrary++-- | like 'arbitraryAddrOnlyTxIn' with no empty signatures.+arbitraryAddrOnlyTxInFull :: Network -> Gen TxIn+arbitraryAddrOnlyTxInFull net = do+ inp <-+ oneof [arbitraryPKHashInputFullC net, arbitraryMulSigSHInputFullC net]+ TxIn <$> arbitraryOutPoint <*> pure (encodeInputBS inp) <*> arbitrary++-- | Arbitrary 'TxOut' that can only be of type 'PayPKHash' or 'PaySH'.+arbitraryAddrOnlyTxOut :: Network -> Gen TxOut+arbitraryAddrOnlyTxOut net = do+ v <- getTestCoin <$> arbitrarySatoshi net+ out <- oneof [arbitraryPKHashOutput, arbitrarySHOutput]+ return $ TxOut v $ encodeOutputBS out++-- | Arbitrary 'SigInput' with the corresponding private keys used+-- to generate the 'ScriptOutput' or 'RedeemScript'.+arbitrarySigInput :: Network -> Gen (SigInput, [SecKeyI])+arbitrarySigInput net =+ oneof+ [ wrapKey <$> arbitraryPKSigInput net+ , wrapKey <$> arbitraryPKHashSigInput net+ , arbitraryMSSigInput net+ , arbitrarySHSigInput net+ , wrapKey <$> arbitraryWPKHSigInput net+ , arbitraryWSHSigInput net+ ]++-- | Arbitrary 'SigInput' with a 'ScriptOutput' of type 'PayPK'.+arbitraryPKSigInput :: Network -> Gen (SigInput, SecKeyI)+arbitraryPKSigInput net = arbitraryAnyInput net False++-- | Arbitrary 'SigInput' with a 'ScriptOutput' of type 'PayPKHash'.+arbitraryPKHashSigInput :: Network -> Gen (SigInput, SecKeyI)+arbitraryPKHashSigInput net = arbitraryAnyInput net True++-- | Arbitrary 'SigInput'.+arbitraryAnyInput :: Network -> Bool -> Gen (SigInput, SecKeyI)+arbitraryAnyInput net pkh = do+ (k, p) <- arbitraryKeyPair+ let out | pkh = PayPKHash $ getAddrHash160 $ pubKeyAddr p+ | otherwise = PayPK p+ (val, op, sh) <- arbitraryInputStuff net+ return (SigInput out val op sh Nothing, k)++-- | Arbitrary value, out point and sighash for an input.+arbitraryInputStuff :: Network -> Gen (Word64, OutPoint, SigHash)+arbitraryInputStuff net = do+ val <- getTestCoin <$> arbitrarySatoshi net+ op <- arbitraryOutPoint+ sh <- arbitraryValidSigHash net+ return (val, op, sh)++-- | Arbitrary 'SigInput' with a 'ScriptOutput' of type 'PayMulSig'.+arbitraryMSSigInput :: Network -> Gen (SigInput, [SecKeyI])+arbitraryMSSigInput net = do+ (m, n) <- arbitraryMSParam+ ks <- vectorOf n arbitraryKeyPair+ let out = PayMulSig (map snd ks) m+ (val, op, sh) <- arbitraryInputStuff net+ perm <- choose (0, n - 1)+ 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'.+arbitrarySHSigInput :: Network -> Gen (SigInput, [SecKeyI])+arbitrarySHSigInput net = do+ (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)++arbitraryWPKHSigInput :: Network -> Gen (SigInput, SecKeyI)+arbitraryWPKHSigInput net = do+ (k, p) <- arbitraryKeyPair+ (val, op, sh) <- arbitraryInputStuff net+ let out = PayWitnessPKHash . getAddrHash160 $ pubKeyAddr p+ return (SigInput out val op sh Nothing, k)++arbitraryWSHSigInput :: Network -> Gen (SigInput, [SecKeyI])+arbitraryWSHSigInput net = do+ (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'.+arbitrarySigningData :: Network -> Gen (Tx, [SigInput], [SecKeyI])+arbitrarySigningData net = do+ v <- arbitrary+ ni <- choose (1, 5)+ no <- choose (1, 5)+ sigis <- vectorOf ni (arbitrarySigInput net)+ let uSigis = nubBy (\(a, _) (b, _) -> sigInputOP a == sigInputOP b) sigis+ inps <- forM uSigis $ \(s, _) -> TxIn (sigInputOP s) BS.empty <$> arbitrary+ outs <- vectorOf no (arbitraryTxOut net)+ l <- arbitrary+ perm <- choose (0, length inps - 1)+ let tx = Tx v (permutations inps !! perm) outs [] l+ keys = concatMap snd uSigis+ return (tx, map fst uSigis, keys)++-- | Arbitrary transaction with empty inputs.+arbitraryEmptyTx :: Network -> Gen Tx+arbitraryEmptyTx net = do+ v <- arbitrary+ no <- choose (1,5)+ ni <- choose (1,5)+ outs <- vectorOf no (arbitraryTxOut net)+ 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)])+arbitraryPartialTxs net = do+ tx <- arbitraryEmptyTx net+ res <-+ forM (map prevOutput $ txIn tx) $ \op -> do+ (so, val, rdmM, prvs, m, n) <- arbitraryData+ txs <- mapM (singleSig so val rdmM tx op . secKeyData) prvs+ return (txs, (so, val, op, m, n))+ return (concatMap fst res, map snd res)+ where+ singleSig so val rdmM tx op prv = do+ sh <- arbitraryValidSigHash net+ let sigi = SigInput so val op sh rdmM+ return . fromRight (error "Could not decode transaction") $+ signTx net tx [sigi] [prv]+ arbitraryData = do+ (m, n) <- arbitraryMSParam+ val <- getTestCoin <$> arbitrarySatoshi net+ nPrv <- choose (m, n)+ keys <- vectorOf n arbitraryKeyPair+ perm <- choose (0, length keys - 1)+ let pubKeys = map snd keys+ prvKeys = take nPrv $ permutations (map fst keys) !! perm+ let so = PayMulSig pubKeys m+ elements+ [ (so, val, Nothing, prvKeys, m, n)+ , ( PayScriptHash $ getAddrHash160 $ payToScriptAddress so+ , val+ , Just so+ , prvKeys+ , m+ , n)+ ]++wrapKey :: (SigInput, SecKeyI) -> (SigInput, [SecKeyI])+wrapKey (s, k) = (s, [k])
+ test/Network/Haskoin/Test/Util.hs view
@@ -0,0 +1,40 @@+{-|+Module : Network.Haskoin.Test.Util+Copyright : No rights reserved+License : UNLICENSE+Maintainer : jprupp@protonmail.ch+Stability : experimental+Portability : POSIX+-}+module Network.Haskoin.Test.Util where++import Data.ByteString (ByteString, pack)+import Data.Time.Clock (UTCTime (..))+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import Data.Word (Word32)+import Test.QuickCheck++-- | Arbitrary strict 'ByteString'.+arbitraryBS :: Gen ByteString+arbitraryBS = pack <$> arbitrary++-- | Arbitrary non-empty strict ByteString+arbitraryBS1 :: Gen ByteString+arbitraryBS1 = pack <$> listOf1 arbitrary++-- | Arbitrary strict ByteString of a given length+arbitraryBSn :: Int -> Gen ByteString+arbitraryBSn n = pack <$> vectorOf n arbitrary++-- | Arbitrary UTCTime that generates dates after 01 Jan 1970 01:00:00 CET+arbitraryUTCTime :: Gen UTCTime+arbitraryUTCTime = do+ w <- arbitrary :: Gen Word32+ return $ posixSecondsToUTCTime $ realToFrac w++-- | Generate a Maybe from a Gen a+arbitraryMaybe :: Gen a -> Gen (Maybe a)+arbitraryMaybe g = frequency [ (1, return Nothing)+ , (5, Just <$> g)+ ]+