diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,10 @@ 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.6 +### Changed +- Expose the Arbitrary test instances under Haskoin.Util.Arbitrary + ## 0.13.5 ### Changed - Provide meaningful JSON instances for most types. 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: 9d9195e4ebe6a0ef3c20fc7252c63ad4bca7d0844dfaf15f479f7e08fc98b009 +-- hash: 14c9f49e8a8cbf3de72ab19366de7910b9e4f84ea0bf5191e211116e71102f98 name: haskoin-core -version: 0.13.5 +version: 0.13.6 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 @@ -46,6 +46,7 @@ Haskoin.Script Haskoin.Transaction Haskoin.Util + Haskoin.Util.Arbitrary other-modules: Haskoin.Address.Base58 Haskoin.Address.Bech32 @@ -69,11 +70,21 @@ Haskoin.Transaction.Common Haskoin.Transaction.Partial Haskoin.Transaction.Segwit + Haskoin.Util.Arbitrary.Address + Haskoin.Util.Arbitrary.Block + Haskoin.Util.Arbitrary.Crypto + Haskoin.Util.Arbitrary.Keys + Haskoin.Util.Arbitrary.Message + Haskoin.Util.Arbitrary.Network + Haskoin.Util.Arbitrary.Script + Haskoin.Util.Arbitrary.Transaction + Haskoin.Util.Arbitrary.Util Paths_haskoin_core hs-source-dirs: src build-depends: - aeson >=1.4.6.0 + QuickCheck >=2.13.2 + , aeson >=1.4.6.0 , array >=0.5.4.0 , base >=4.9 && <5 , base16-bytestring >=0.1.1.6 @@ -117,16 +128,6 @@ Haskoin.KeysSpec Haskoin.NetworkSpec Haskoin.ScriptSpec - Haskoin.Test - Haskoin.Test.Address - Haskoin.Test.Block - Haskoin.Test.Crypto - Haskoin.Test.Keys - Haskoin.Test.Message - Haskoin.Test.Network - Haskoin.Test.Script - Haskoin.Test.Transaction - Haskoin.Test.Util Haskoin.Transaction.PartialSpec Haskoin.TransactionSpec Haskoin.UtilSpec @@ -162,6 +163,16 @@ Haskoin.Transaction.Partial Haskoin.Transaction.Segwit Haskoin.Util + Haskoin.Util.Arbitrary + Haskoin.Util.Arbitrary.Address + Haskoin.Util.Arbitrary.Block + Haskoin.Util.Arbitrary.Crypto + Haskoin.Util.Arbitrary.Keys + Haskoin.Util.Arbitrary.Message + Haskoin.Util.Arbitrary.Network + Haskoin.Util.Arbitrary.Script + Haskoin.Util.Arbitrary.Transaction + Haskoin.Util.Arbitrary.Util Paths_haskoin_core hs-source-dirs: test diff --git a/src/Haskoin/Block/Common.hs b/src/Haskoin/Block/Common.hs --- a/src/Haskoin/Block/Common.hs +++ b/src/Haskoin/Block/Common.hs @@ -274,8 +274,9 @@ -- | The 'Headers' type is used to return a list of block headers in -- response to a 'GetHeaders' message. -newtype Headers = Headers -- | list of block headers with transaction count - { headersList :: [BlockHeaderCount] +newtype Headers = Headers + { -- | list of block headers with transaction count + headersList :: [BlockHeaderCount] } deriving (Eq, Show, Generic, NFData) instance Serialize Headers where diff --git a/src/Haskoin/Util/Arbitrary.hs b/src/Haskoin/Util/Arbitrary.hs new file mode 100644 --- /dev/null +++ b/src/Haskoin/Util/Arbitrary.hs @@ -0,0 +1,23 @@ +{-| +Module : Haskoin.Test +Copyright : No rights reserved +License : UNLICENSE +Maintainer : jprupp@protonmail.ch +Stability : experimental +Portability : POSIX + +Arbitrary instances for testing. +-} +module Haskoin.Util.Arbitrary + ( module X + ) where + +import Haskoin.Util.Arbitrary.Address as X +import Haskoin.Util.Arbitrary.Block as X +import Haskoin.Util.Arbitrary.Crypto as X +import Haskoin.Util.Arbitrary.Keys as X +import Haskoin.Util.Arbitrary.Message as X +import Haskoin.Util.Arbitrary.Network as X +import Haskoin.Util.Arbitrary.Script as X +import Haskoin.Util.Arbitrary.Transaction as X +import Haskoin.Util.Arbitrary.Util as X diff --git a/src/Haskoin/Util/Arbitrary/Address.hs b/src/Haskoin/Util/Arbitrary/Address.hs new file mode 100644 --- /dev/null +++ b/src/Haskoin/Util/Arbitrary/Address.hs @@ -0,0 +1,33 @@ +{-| +Module : Haskoin.Test.Address +Copyright : No rights reserved +License : UNLICENSE +Maintainer : jprupp@protonmail.ch +Stability : experimental +Portability : POSIX +-} +module Haskoin.Util.Arbitrary.Address where + +import Haskoin.Address +import Haskoin.Util.Arbitrary.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 = PubKeyAddress <$> arbitraryHash160 + +-- | Arbitrary pay-to-script-hash address. +arbitraryScriptAddress :: Gen Address +arbitraryScriptAddress = ScriptAddress <$> arbitraryHash160 + +-- | Arbitrary pay-to-witness public key hash +arbitraryWitnessPubKeyAddress :: Gen Address +arbitraryWitnessPubKeyAddress = WitnessPubKeyAddress <$> arbitraryHash160 + +-- | Arbitrary pay-to-witness script hash +arbitraryWitnessScriptAddress :: Gen Address +arbitraryWitnessScriptAddress = WitnessPubKeyAddress <$> arbitraryHash160 diff --git a/src/Haskoin/Util/Arbitrary/Block.hs b/src/Haskoin/Util/Arbitrary/Block.hs new file mode 100644 --- /dev/null +++ b/src/Haskoin/Util/Arbitrary/Block.hs @@ -0,0 +1,69 @@ +{-| +Module : Haskoin.Test.Block +Copyright : No rights reserved +License : UNLICENSE +Maintainer : jprupp@protonmail.ch +Stability : experimental +Portability : POSIX +-} +module Haskoin.Util.Arbitrary.Block where + +import Haskoin.Block.Common +import Haskoin.Block.Merkle +import Haskoin.Constants +import Haskoin.Util.Arbitrary.Crypto +import Haskoin.Util.Arbitrary.Network +import Haskoin.Util.Arbitrary.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/Haskoin/Util/Arbitrary/Crypto.hs b/src/Haskoin/Util/Arbitrary/Crypto.hs new file mode 100644 --- /dev/null +++ b/src/Haskoin/Util/Arbitrary/Crypto.hs @@ -0,0 +1,33 @@ +{-| +Module : Haskoin.Test.Crypto +Copyright : No rights reserved +License : UNLICENSE +Maintainer : jprupp@protonmail.ch +Stability : experimental +Portability : POSIX +-} +module Haskoin.Util.Arbitrary.Crypto where + +import Haskoin.Crypto.Hash +import Haskoin.Util.Arbitrary.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/Haskoin/Util/Arbitrary/Keys.hs b/src/Haskoin/Util/Arbitrary/Keys.hs new file mode 100644 --- /dev/null +++ b/src/Haskoin/Util/Arbitrary/Keys.hs @@ -0,0 +1,85 @@ +{-| +Module : Haskoin.Test.Keys +Copyright : No rights reserved +License : UNLICENSE +Maintainer : jprupp@protonmail.ch +Stability : experimental +Portability : POSIX +-} +module Haskoin.Util.Arbitrary.Keys where + +import Data.Bits (clearBit) +import Data.List (foldl') +import Data.Word (Word32) +import Haskoin.Crypto +import Haskoin.Keys.Common +import Haskoin.Keys.Extended +import Haskoin.Util.Arbitrary.Crypto +import Test.QuickCheck + +-- | 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/Haskoin/Util/Arbitrary/Message.hs b/src/Haskoin/Util/Arbitrary/Message.hs new file mode 100644 --- /dev/null +++ b/src/Haskoin/Util/Arbitrary/Message.hs @@ -0,0 +1,52 @@ +{-| +Module : Haskoin.Test.Message +Copyright : No rights reserved +License : UNLICENSE +Maintainer : jprupp@protonmail.ch +Stability : experimental +Portability : POSIX +-} +module Haskoin.Util.Arbitrary.Message where + +import Haskoin.Constants +import Haskoin.Network.Message +import Haskoin.Util.Arbitrary.Block +import Haskoin.Util.Arbitrary.Crypto +import Haskoin.Util.Arbitrary.Network +import Haskoin.Util.Arbitrary.Transaction +import Test.QuickCheck + +-- | 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/Haskoin/Util/Arbitrary/Network.hs b/src/Haskoin/Util/Arbitrary/Network.hs new file mode 100644 --- /dev/null +++ b/src/Haskoin/Util/Arbitrary/Network.hs @@ -0,0 +1,178 @@ +{-| +Module : Haskoin.Test.Network +Copyright : No rights reserved +License : UNLICENSE +Maintainer : jprupp@protonmail.ch +Stability : experimental +Portability : POSIX +-} +module Haskoin.Util.Arbitrary.Network where + +import qualified Data.ByteString as BS (empty, pack) +import qualified Data.ByteString.Char8 as C8 +import Data.Word (Word16, Word32) +import Haskoin.Network +import Haskoin.Util.Arbitrary.Crypto +import Haskoin.Util.Arbitrary.Util +import Network.Socket (SockAddr (..)) +import Test.QuickCheck + +-- | 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/Haskoin/Util/Arbitrary/Script.hs b/src/Haskoin/Util/Arbitrary/Script.hs new file mode 100644 --- /dev/null +++ b/src/Haskoin/Util/Arbitrary/Script.hs @@ -0,0 +1,379 @@ +{-# LANGUAGE LambdaCase #-} +{-| +Module : Haskoin.Test.Script +Copyright : No rights reserved +License : UNLICENSE +Maintainer : jprupp@protonmail.ch +Stability : experimental +Portability : POSIX +-} +module Haskoin.Util.Arbitrary.Script where + +import Crypto.Secp256k1 +import Data.Maybe +import Data.Word +import Haskoin.Address +import Haskoin.Constants +import Haskoin.Keys.Common +import Haskoin.Script +import Haskoin.Transaction.Common +import Haskoin.Util +import Haskoin.Util.Arbitrary.Address +import Haskoin.Util.Arbitrary.Crypto +import Haskoin.Util.Arbitrary.Keys +import Haskoin.Util.Arbitrary.Util +import Test.QuickCheck + +-- | 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 + -- Bitcoin Cash Nov 2018 hard fork + , return OP_CHECKDATASIG + , return OP_CHECKDATASIGVERIFY + -- Bitcoin Cash May 2020 hard fork + , return OP_REVERSEBYTES + -- Other + , return OP_PUBKEYHASH + , 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/Haskoin/Util/Arbitrary/Transaction.hs b/src/Haskoin/Util/Arbitrary/Transaction.hs new file mode 100644 --- /dev/null +++ b/src/Haskoin/Util/Arbitrary/Transaction.hs @@ -0,0 +1,278 @@ +{-| +Module : Haskoin.Test.Transaction +Copyright : No rights reserved +License : UNLICENSE +Maintainer : jprupp@protonmail.ch +Stability : experimental +Portability : POSIX +-} +module Haskoin.Util.Arbitrary.Transaction where + +import Control.Monad +import qualified Data.ByteString as BS +import Data.Either (fromRight) +import Data.List (nub, nubBy, permutations) +import Data.Word (Word64) +import Haskoin.Address +import Haskoin.Constants +import Haskoin.Keys.Common +import Haskoin.Script +import Haskoin.Util.Arbitrary.Crypto +import Haskoin.Util.Arbitrary.Keys +import Haskoin.Util.Arbitrary.Script +import Haskoin.Util.Arbitrary.Util +import Haskoin.Transaction +import Test.QuickCheck + +-- | 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/Haskoin/Util/Arbitrary/Util.hs b/src/Haskoin/Util/Arbitrary/Util.hs new file mode 100644 --- /dev/null +++ b/src/Haskoin/Util/Arbitrary/Util.hs @@ -0,0 +1,44 @@ +{-| +Module : Haskoin.Test.Util +Copyright : No rights reserved +License : UNLICENSE +Maintainer : jprupp@protonmail.ch +Stability : experimental +Portability : POSIX +-} +module Haskoin.Util.Arbitrary.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 +import Haskoin.Constants + +-- | 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) + ] + +arbitraryNetwork :: Gen Network +arbitraryNetwork = elements allNets + diff --git a/test/Haskoin/AddressSpec.hs b/test/Haskoin/AddressSpec.hs --- a/test/Haskoin/AddressSpec.hs +++ b/test/Haskoin/AddressSpec.hs @@ -8,7 +8,7 @@ import Haskoin.Address import Haskoin.Constants import Haskoin.Keys (derivePubKeyI) -import Haskoin.Test +import Haskoin.Util.Arbitrary import Haskoin.UtilSpec (testCustomEncoding, testCustomJSON) import Test.Hspec import Test.HUnit (Assertion, assertBool, assertEqual) diff --git a/test/Haskoin/BlockSpec.hs b/test/Haskoin/BlockSpec.hs --- a/test/Haskoin/BlockSpec.hs +++ b/test/Haskoin/BlockSpec.hs @@ -11,8 +11,8 @@ import Data.Text (Text) import Haskoin.Block import Haskoin.Constants -import Haskoin.Test import Haskoin.Transaction +import Haskoin.Util.Arbitrary import Haskoin.UtilSpec (cerealID, testJsonID) import Test.Hspec import Test.HUnit hiding (State) diff --git a/test/Haskoin/Crypto/HashSpec.hs b/test/Haskoin/Crypto/HashSpec.hs --- a/test/Haskoin/Crypto/HashSpec.hs +++ b/test/Haskoin/Crypto/HashSpec.hs @@ -9,8 +9,8 @@ import Data.String.Conversions import Haskoin.Block import Haskoin.Crypto -import Haskoin.Test import Haskoin.Util +import Haskoin.Util.Arbitrary import Test.Hspec import Test.HUnit (Assertion, assertBool) import Test.QuickCheck diff --git a/test/Haskoin/Crypto/SignatureSpec.hs b/test/Haskoin/Crypto/SignatureSpec.hs --- a/test/Haskoin/Crypto/SignatureSpec.hs +++ b/test/Haskoin/Crypto/SignatureSpec.hs @@ -1,21 +1,21 @@ {-# LANGUAGE OverloadedStrings #-} module Haskoin.Crypto.SignatureSpec (spec) where -import Data.Bits (testBit) -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS (index, length) -import Data.Serialize as S -import Data.Text (Text) -import Haskoin.Crypto (SecKey, Sig, decodeStrictSig, - derivePubKey, exportSig, - importCompactSig, isCanonicalHalfOrder, - sha256, signHash, verifyHashSig) -import Haskoin.Test (arbitrarySignature) -import Haskoin.Util (decodeHex, eitherToMaybe, lst3) -import Test.Hspec (Spec, describe, it) -import Test.Hspec.QuickCheck (prop) -import Test.HUnit (Assertion, assertBool) -import Test.QuickCheck (forAll) +import Data.Bits (testBit) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS (index, length) +import Data.Serialize as S +import Data.Text (Text) +import Haskoin.Crypto (SecKey, Sig, decodeStrictSig, + derivePubKey, exportSig, + importCompactSig, isCanonicalHalfOrder, + sha256, signHash, verifyHashSig) +import Haskoin.Util (decodeHex, eitherToMaybe, lst3) +import Haskoin.Util.Arbitrary (arbitrarySignature) +import Test.Hspec (Spec, describe, it) +import Test.Hspec.QuickCheck (prop) +import Test.HUnit (Assertion, assertBool) +import Test.QuickCheck (forAll) spec :: Spec spec = do diff --git a/test/Haskoin/Keys/ExtendedSpec.hs b/test/Haskoin/Keys/ExtendedSpec.hs --- a/test/Haskoin/Keys/ExtendedSpec.hs +++ b/test/Haskoin/Keys/ExtendedSpec.hs @@ -14,8 +14,8 @@ import Haskoin.Address import Haskoin.Constants import Haskoin.Keys -import Haskoin.Test import Haskoin.Util +import Haskoin.Util.Arbitrary import Haskoin.UtilSpec (cerealID, customCerealID, testCustomEncoding, testCustomJSON, testJsonID) diff --git a/test/Haskoin/Keys/MnemonicSpec.hs b/test/Haskoin/Keys/MnemonicSpec.hs --- a/test/Haskoin/Keys/MnemonicSpec.hs +++ b/test/Haskoin/Keys/MnemonicSpec.hs @@ -1,22 +1,22 @@ {-# LANGUAGE OverloadedStrings #-} module Haskoin.Keys.MnemonicSpec (spec) where -import Control.Monad (zipWithM_) -import Data.Bits (shiftR, (.&.)) -import qualified Data.ByteString as BS -import Data.Either (fromRight) -import Data.List (isPrefixOf) -import Data.Maybe (fromJust) -import Data.Serialize (Serialize, encode) -import Data.Text (Text) -import qualified Data.Text as T -import Data.Word (Word32, Word64) +import Control.Monad (zipWithM_) +import Data.Bits (shiftR, (.&.)) +import qualified Data.ByteString as BS +import Data.Either (fromRight) +import Data.List (isPrefixOf) +import Data.Maybe (fromJust) +import Data.Serialize (Serialize, encode) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Word (Word32, Word64) import Haskoin.Keys -import Haskoin.Test import Haskoin.Util +import Haskoin.Util.Arbitrary import Test.Hspec import Test.HUnit -import Test.QuickCheck hiding ((.&.)) +import Test.QuickCheck hiding ((.&.)) spec :: Spec spec = diff --git a/test/Haskoin/KeysSpec.hs b/test/Haskoin/KeysSpec.hs --- a/test/Haskoin/KeysSpec.hs +++ b/test/Haskoin/KeysSpec.hs @@ -10,7 +10,7 @@ import Haskoin.Constants import Haskoin.Crypto import Haskoin.Keys -import Haskoin.Test +import Haskoin.Util.Arbitrary import Haskoin.Util import Test.Hspec import Test.QuickCheck diff --git a/test/Haskoin/NetworkSpec.hs b/test/Haskoin/NetworkSpec.hs --- a/test/Haskoin/NetworkSpec.hs +++ b/test/Haskoin/NetworkSpec.hs @@ -1,20 +1,20 @@ {-# LANGUAGE OverloadedStrings #-} module Haskoin.NetworkSpec (spec) where -import Data.Maybe (fromJust) -import Data.Serialize as S -import Data.Text (Text) -import Data.Word (Word32) +import Data.Maybe (fromJust) +import Data.Serialize as S +import Data.Text (Text) +import Data.Word (Word32) import Haskoin.Address import Haskoin.Constants import Haskoin.Keys import Haskoin.Network -import Haskoin.Test import Haskoin.Transaction import Haskoin.Util -import Haskoin.UtilSpec (cerealID, customCerealID) +import Haskoin.Util.Arbitrary +import Haskoin.UtilSpec (cerealID, customCerealID) import Test.Hspec -import Test.HUnit (Assertion, assertBool, assertEqual) +import Test.HUnit (Assertion, assertBool, assertEqual) import Test.QuickCheck spec :: Spec diff --git a/test/Haskoin/ScriptSpec.hs b/test/Haskoin/ScriptSpec.hs --- a/test/Haskoin/ScriptSpec.hs +++ b/test/Haskoin/ScriptSpec.hs @@ -18,9 +18,9 @@ import Haskoin.Constants import Haskoin.Keys import Haskoin.Script -import Haskoin.Test import Haskoin.Transaction import Haskoin.Util +import Haskoin.Util.Arbitrary import Haskoin.UtilSpec (cerealID, testJsonID) import Test.Hspec import Test.HUnit as HUnit diff --git a/test/Haskoin/Test.hs b/test/Haskoin/Test.hs deleted file mode 100644 --- a/test/Haskoin/Test.hs +++ /dev/null @@ -1,23 +0,0 @@ -{-| -Module : Haskoin.Test -Copyright : No rights reserved -License : UNLICENSE -Maintainer : jprupp@protonmail.ch -Stability : experimental -Portability : POSIX - -Arbitrary instances for testing. --} -module Haskoin.Test - ( module X - ) where - -import Haskoin.Test.Address as X -import Haskoin.Test.Block as X -import Haskoin.Test.Crypto as X -import Haskoin.Test.Keys as X -import Haskoin.Test.Message as X -import Haskoin.Test.Network as X -import Haskoin.Test.Script as X -import Haskoin.Test.Transaction as X -import Haskoin.Test.Util as X diff --git a/test/Haskoin/Test/Address.hs b/test/Haskoin/Test/Address.hs deleted file mode 100644 --- a/test/Haskoin/Test/Address.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-| -Module : Haskoin.Test.Address -Copyright : No rights reserved -License : UNLICENSE -Maintainer : jprupp@protonmail.ch -Stability : experimental -Portability : POSIX --} -module Haskoin.Test.Address where - -import Haskoin.Address -import 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/Haskoin/Test/Block.hs b/test/Haskoin/Test/Block.hs deleted file mode 100644 --- a/test/Haskoin/Test/Block.hs +++ /dev/null @@ -1,69 +0,0 @@ -{-| -Module : Haskoin.Test.Block -Copyright : No rights reserved -License : UNLICENSE -Maintainer : jprupp@protonmail.ch -Stability : experimental -Portability : POSIX --} -module Haskoin.Test.Block where - -import Haskoin.Block.Common -import Haskoin.Block.Merkle -import Haskoin.Constants -import Haskoin.Test.Crypto -import Haskoin.Test.Network -import 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/Haskoin/Test/Crypto.hs b/test/Haskoin/Test/Crypto.hs deleted file mode 100644 --- a/test/Haskoin/Test/Crypto.hs +++ /dev/null @@ -1,33 +0,0 @@ -{-| -Module : Haskoin.Test.Crypto -Copyright : No rights reserved -License : UNLICENSE -Maintainer : jprupp@protonmail.ch -Stability : experimental -Portability : POSIX --} -module Haskoin.Test.Crypto where - -import Haskoin.Crypto.Hash -import 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/Haskoin/Test/Keys.hs b/test/Haskoin/Test/Keys.hs deleted file mode 100644 --- a/test/Haskoin/Test/Keys.hs +++ /dev/null @@ -1,85 +0,0 @@ -{-| -Module : Haskoin.Test.Keys -Copyright : No rights reserved -License : UNLICENSE -Maintainer : jprupp@protonmail.ch -Stability : experimental -Portability : POSIX --} -module Haskoin.Test.Keys where - -import Data.Bits (clearBit) -import Data.List (foldl') -import Data.Word (Word32) -import Haskoin.Crypto -import Haskoin.Keys.Common -import Haskoin.Keys.Extended -import Haskoin.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/Haskoin/Test/Message.hs b/test/Haskoin/Test/Message.hs deleted file mode 100644 --- a/test/Haskoin/Test/Message.hs +++ /dev/null @@ -1,52 +0,0 @@ -{-| -Module : Haskoin.Test.Message -Copyright : No rights reserved -License : UNLICENSE -Maintainer : jprupp@protonmail.ch -Stability : experimental -Portability : POSIX --} -module Haskoin.Test.Message where - -import Haskoin.Constants -import Haskoin.Network.Message -import Haskoin.Test.Block -import Haskoin.Test.Crypto -import Haskoin.Test.Network -import 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/Haskoin/Test/Network.hs b/test/Haskoin/Test/Network.hs deleted file mode 100644 --- a/test/Haskoin/Test/Network.hs +++ /dev/null @@ -1,178 +0,0 @@ -{-| -Module : Haskoin.Test.Network -Copyright : No rights reserved -License : UNLICENSE -Maintainer : jprupp@protonmail.ch -Stability : experimental -Portability : POSIX --} -module 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 Haskoin.Network -import Haskoin.Test.Crypto -import 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/Haskoin/Test/Script.hs b/test/Haskoin/Test/Script.hs deleted file mode 100644 --- a/test/Haskoin/Test/Script.hs +++ /dev/null @@ -1,379 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-| -Module : Haskoin.Test.Script -Copyright : No rights reserved -License : UNLICENSE -Maintainer : jprupp@protonmail.ch -Stability : experimental -Portability : POSIX --} -module Haskoin.Test.Script where - -import Crypto.Secp256k1 -import Data.Maybe -import Data.Word -import Haskoin.Address -import Haskoin.Constants -import Haskoin.Keys.Common -import Haskoin.Script -import Haskoin.Test.Address -import Haskoin.Test.Crypto -import Haskoin.Test.Keys -import Haskoin.Test.Util -import Haskoin.Transaction.Common -import 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 - -- Bitcoin Cash Nov 2018 hard fork - , return OP_CHECKDATASIG - , return OP_CHECKDATASIGVERIFY - -- Bitcoin Cash May 2020 hard fork - , return OP_REVERSEBYTES - -- Other - , return OP_PUBKEYHASH - , 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/Haskoin/Test/Transaction.hs b/test/Haskoin/Test/Transaction.hs deleted file mode 100644 --- a/test/Haskoin/Test/Transaction.hs +++ /dev/null @@ -1,278 +0,0 @@ -{-| -Module : Haskoin.Test.Transaction -Copyright : No rights reserved -License : UNLICENSE -Maintainer : jprupp@protonmail.ch -Stability : experimental -Portability : POSIX --} -module 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 Haskoin.Address -import Haskoin.Constants -import Haskoin.Keys.Common -import Haskoin.Script -import Haskoin.Test.Crypto -import Haskoin.Test.Keys -import Haskoin.Test.Script -import Haskoin.Test.Util -import 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/Haskoin/Test/Util.hs b/test/Haskoin/Test/Util.hs deleted file mode 100644 --- a/test/Haskoin/Test/Util.hs +++ /dev/null @@ -1,40 +0,0 @@ -{-| -Module : Haskoin.Test.Util -Copyright : No rights reserved -License : UNLICENSE -Maintainer : jprupp@protonmail.ch -Stability : experimental -Portability : POSIX --} -module 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/test/Haskoin/Transaction/PartialSpec.hs b/test/Haskoin/Transaction/PartialSpec.hs --- a/test/Haskoin/Transaction/PartialSpec.hs +++ b/test/Haskoin/Transaction/PartialSpec.hs @@ -19,10 +19,10 @@ import Haskoin.Crypto import Haskoin.Keys import Haskoin.Script -import Haskoin.Test import Haskoin.Transaction import Haskoin.Transaction.Partial import Haskoin.Util +import Haskoin.Util.Arbitrary spec :: Spec spec = describe "partially signed bitcoin transaction unit tests" $ do diff --git a/test/Haskoin/TransactionSpec.hs b/test/Haskoin/TransactionSpec.hs --- a/test/Haskoin/TransactionSpec.hs +++ b/test/Haskoin/TransactionSpec.hs @@ -14,10 +14,10 @@ import Haskoin.Constants import Haskoin.Keys import Haskoin.Script -import Haskoin.Test import Haskoin.Transaction import Haskoin.Transaction.Segwit (isSegwit) import Haskoin.Util +import Haskoin.Util.Arbitrary import Haskoin.UtilSpec (cerealID, testJsonID) import Safe (readMay) import Test.Hspec diff --git a/test/Haskoin/UtilSpec.hs b/test/Haskoin/UtilSpec.hs --- a/test/Haskoin/UtilSpec.hs +++ b/test/Haskoin/UtilSpec.hs @@ -7,20 +7,20 @@ , customCerealID ) where -import Data.Aeson (FromJSON, ToJSON) -import qualified Data.Aeson as A -import Data.Aeson.Encoding (encodingToLazyByteString) -import Data.Aeson.Types (Parser, parseMaybe) -import qualified Data.ByteString as BS -import Data.Either (fromLeft, fromRight, isLeft, isRight) -import Data.Foldable (toList) -import Data.List (permutations) -import Data.Map.Strict (singleton) +import Data.Aeson (FromJSON, ToJSON) +import qualified Data.Aeson as A +import Data.Aeson.Encoding (encodingToLazyByteString) +import Data.Aeson.Types (Parser, parseMaybe) +import qualified Data.ByteString as BS +import Data.Either (fromLeft, fromRight, isLeft, isRight) +import Data.Foldable (toList) +import Data.List (permutations) +import Data.Map.Strict (singleton) import Data.Maybe -import qualified Data.Sequence as Seq -import Data.Serialize as S -import Haskoin.Test +import qualified Data.Sequence as Seq +import Data.Serialize as S import Haskoin.Util +import Haskoin.Util.Arbitrary import Test.Hspec import Test.QuickCheck