diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/haskoin-core.cabal b/haskoin-core.cabal --- a/haskoin-core.cabal +++ b/haskoin-core.cabal @@ -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 diff --git a/src/Network/Haskoin/Address.hs b/src/Network/Haskoin/Address.hs --- a/src/Network/Haskoin/Address.hs +++ b/src/Network/Haskoin/Address.hs @@ -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'. diff --git a/src/Network/Haskoin/Block.hs b/src/Network/Haskoin/Block.hs --- a/src/Network/Haskoin/Block.hs +++ b/src/Network/Haskoin/Block.hs @@ -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 diff --git a/src/Network/Haskoin/Script/Common.hs b/src/Network/Haskoin/Script/Common.hs --- a/src/Network/Haskoin/Script/Common.hs +++ b/src/Network/Haskoin/Script/Common.hs @@ -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 diff --git a/src/Network/Haskoin/Script/SigHash.hs b/src/Network/Haskoin/Script/SigHash.hs --- a/src/Network/Haskoin/Script/SigHash.hs +++ b/src/Network/Haskoin/Script/SigHash.hs @@ -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 diff --git a/src/Network/Haskoin/Test.hs b/src/Network/Haskoin/Test.hs deleted file mode 100644 --- a/src/Network/Haskoin/Test.hs +++ /dev/null @@ -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 diff --git a/src/Network/Haskoin/Test/Address.hs b/src/Network/Haskoin/Test/Address.hs deleted file mode 100644 --- a/src/Network/Haskoin/Test/Address.hs +++ /dev/null @@ -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 diff --git a/src/Network/Haskoin/Test/Block.hs b/src/Network/Haskoin/Test/Block.hs deleted file mode 100644 --- a/src/Network/Haskoin/Test/Block.hs +++ /dev/null @@ -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 - diff --git a/src/Network/Haskoin/Test/Crypto.hs b/src/Network/Haskoin/Test/Crypto.hs deleted file mode 100644 --- a/src/Network/Haskoin/Test/Crypto.hs +++ /dev/null @@ -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 diff --git a/src/Network/Haskoin/Test/Keys.hs b/src/Network/Haskoin/Test/Keys.hs deleted file mode 100644 --- a/src/Network/Haskoin/Test/Keys.hs +++ /dev/null @@ -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) diff --git a/src/Network/Haskoin/Test/Message.hs b/src/Network/Haskoin/Test/Message.hs deleted file mode 100644 --- a/src/Network/Haskoin/Test/Message.hs +++ /dev/null @@ -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 - ] diff --git a/src/Network/Haskoin/Test/Network.hs b/src/Network/Haskoin/Test/Network.hs deleted file mode 100644 --- a/src/Network/Haskoin/Test/Network.hs +++ /dev/null @@ -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))) - ] diff --git a/src/Network/Haskoin/Test/Script.hs b/src/Network/Haskoin/Test/Script.hs deleted file mode 100644 --- a/src/Network/Haskoin/Test/Script.hs +++ /dev/null @@ -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 diff --git a/src/Network/Haskoin/Test/Transaction.hs b/src/Network/Haskoin/Test/Transaction.hs deleted file mode 100644 --- a/src/Network/Haskoin/Test/Transaction.hs +++ /dev/null @@ -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]) diff --git a/src/Network/Haskoin/Test/Util.hs b/src/Network/Haskoin/Test/Util.hs deleted file mode 100644 --- a/src/Network/Haskoin/Test/Util.hs +++ /dev/null @@ -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) - ] - diff --git a/src/Network/Haskoin/Transaction.hs b/src/Network/Haskoin/Transaction.hs --- a/src/Network/Haskoin/Transaction.hs +++ b/src/Network/Haskoin/Transaction.hs @@ -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 diff --git a/src/Network/Haskoin/Transaction/Builder.hs b/src/Network/Haskoin/Transaction/Builder.hs --- a/src/Network/Haskoin/Transaction/Builder.hs +++ b/src/Network/Haskoin/Transaction/Builder.hs @@ -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' diff --git a/src/Network/Haskoin/Transaction/Builder/Sign.hs b/src/Network/Haskoin/Transaction/Builder/Sign.hs --- a/src/Network/Haskoin/Transaction/Builder/Sign.hs +++ b/src/Network/Haskoin/Transaction/Builder/Sign.hs @@ -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 diff --git a/src/Network/Haskoin/Transaction/Common.hs b/src/Network/Haskoin/Transaction/Common.hs --- a/src/Network/Haskoin/Transaction/Common.hs +++ b/src/Network/Haskoin/Transaction/Common.hs @@ -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 diff --git a/src/Network/Haskoin/Transaction/Partial.hs b/src/Network/Haskoin/Transaction/Partial.hs --- a/src/Network/Haskoin/Transaction/Partial.hs +++ b/src/Network/Haskoin/Transaction/Partial.hs @@ -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 diff --git a/src/Network/Haskoin/Transaction/Segwit.hs b/src/Network/Haskoin/Transaction/Segwit.hs --- a/src/Network/Haskoin/Transaction/Segwit.hs +++ b/src/Network/Haskoin/Transaction/Segwit.hs @@ -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" diff --git a/src/Network/Haskoin/Util.hs b/src/Network/Haskoin/Util.hs --- a/src/Network/Haskoin/Util.hs +++ b/src/Network/Haskoin/Util.hs @@ -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 diff --git a/test/Network/Haskoin/Test.hs b/test/Network/Haskoin/Test.hs new file mode 100644 --- /dev/null +++ b/test/Network/Haskoin/Test.hs @@ -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 diff --git a/test/Network/Haskoin/Test/Address.hs b/test/Network/Haskoin/Test/Address.hs new file mode 100644 --- /dev/null +++ b/test/Network/Haskoin/Test/Address.hs @@ -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 diff --git a/test/Network/Haskoin/Test/Block.hs b/test/Network/Haskoin/Test/Block.hs new file mode 100644 --- /dev/null +++ b/test/Network/Haskoin/Test/Block.hs @@ -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 + diff --git a/test/Network/Haskoin/Test/Crypto.hs b/test/Network/Haskoin/Test/Crypto.hs new file mode 100644 --- /dev/null +++ b/test/Network/Haskoin/Test/Crypto.hs @@ -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 diff --git a/test/Network/Haskoin/Test/Keys.hs b/test/Network/Haskoin/Test/Keys.hs new file mode 100644 --- /dev/null +++ b/test/Network/Haskoin/Test/Keys.hs @@ -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) diff --git a/test/Network/Haskoin/Test/Message.hs b/test/Network/Haskoin/Test/Message.hs new file mode 100644 --- /dev/null +++ b/test/Network/Haskoin/Test/Message.hs @@ -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 + ] diff --git a/test/Network/Haskoin/Test/Network.hs b/test/Network/Haskoin/Test/Network.hs new file mode 100644 --- /dev/null +++ b/test/Network/Haskoin/Test/Network.hs @@ -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))) + ] diff --git a/test/Network/Haskoin/Test/Script.hs b/test/Network/Haskoin/Test/Script.hs new file mode 100644 --- /dev/null +++ b/test/Network/Haskoin/Test/Script.hs @@ -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 diff --git a/test/Network/Haskoin/Test/Transaction.hs b/test/Network/Haskoin/Test/Transaction.hs new file mode 100644 --- /dev/null +++ b/test/Network/Haskoin/Test/Transaction.hs @@ -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]) diff --git a/test/Network/Haskoin/Test/Util.hs b/test/Network/Haskoin/Test/Util.hs new file mode 100644 --- /dev/null +++ b/test/Network/Haskoin/Test/Util.hs @@ -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) + ] +