packages feed

haskoin-core 0.12.0 → 0.13.0

raw patch · 33 files changed

+1401/−1319 lines, 33 filesdep −haskoin-coredep ~HUnitdep ~QuickCheckdep ~aeson

Dependencies removed: haskoin-core

Dependency ranges changed: HUnit, QuickCheck, aeson, array, base16-bytestring, bytestring, cereal, conduit, containers, cryptonite, deepseq, entropy, hashable, hspec, memory, mtl, network, safe, scientific, split, string-conversions, text, time, transformers, unordered-containers, vector

Files

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