packages feed

haskoin-core 0.13.5 → 0.13.6

raw patch · 35 files changed

+1259/−1231 lines, 35 files

Files

CHANGELOG.md view
@@ -4,6 +4,10 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html). +## 0.13.6+### Changed+- Expose the Arbitrary test instances under Haskoin.Util.Arbitrary+ ## 0.13.5 ### Changed - Provide meaningful JSON instances for most types.
haskoin-core.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 9d9195e4ebe6a0ef3c20fc7252c63ad4bca7d0844dfaf15f479f7e08fc98b009+-- hash: 14c9f49e8a8cbf3de72ab19366de7910b9e4f84ea0bf5191e211116e71102f98  name:           haskoin-core-version:        0.13.5+version:        0.13.6 synopsis:       Bitcoin & Bitcoin Cash library for Haskell description:    Haskoin Core is a complete Bitcoin and Bitcoin Cash library of functions and data types for Haskell developers. category:       Bitcoin, Finance, Network@@ -46,6 +46,7 @@       Haskoin.Script       Haskoin.Transaction       Haskoin.Util+      Haskoin.Util.Arbitrary   other-modules:       Haskoin.Address.Base58       Haskoin.Address.Bech32@@ -69,11 +70,21 @@       Haskoin.Transaction.Common       Haskoin.Transaction.Partial       Haskoin.Transaction.Segwit+      Haskoin.Util.Arbitrary.Address+      Haskoin.Util.Arbitrary.Block+      Haskoin.Util.Arbitrary.Crypto+      Haskoin.Util.Arbitrary.Keys+      Haskoin.Util.Arbitrary.Message+      Haskoin.Util.Arbitrary.Network+      Haskoin.Util.Arbitrary.Script+      Haskoin.Util.Arbitrary.Transaction+      Haskoin.Util.Arbitrary.Util       Paths_haskoin_core   hs-source-dirs:       src   build-depends:-      aeson >=1.4.6.0+      QuickCheck >=2.13.2+    , aeson >=1.4.6.0     , array >=0.5.4.0     , base >=4.9 && <5     , base16-bytestring >=0.1.1.6@@ -117,16 +128,6 @@       Haskoin.KeysSpec       Haskoin.NetworkSpec       Haskoin.ScriptSpec-      Haskoin.Test-      Haskoin.Test.Address-      Haskoin.Test.Block-      Haskoin.Test.Crypto-      Haskoin.Test.Keys-      Haskoin.Test.Message-      Haskoin.Test.Network-      Haskoin.Test.Script-      Haskoin.Test.Transaction-      Haskoin.Test.Util       Haskoin.Transaction.PartialSpec       Haskoin.TransactionSpec       Haskoin.UtilSpec@@ -162,6 +163,16 @@       Haskoin.Transaction.Partial       Haskoin.Transaction.Segwit       Haskoin.Util+      Haskoin.Util.Arbitrary+      Haskoin.Util.Arbitrary.Address+      Haskoin.Util.Arbitrary.Block+      Haskoin.Util.Arbitrary.Crypto+      Haskoin.Util.Arbitrary.Keys+      Haskoin.Util.Arbitrary.Message+      Haskoin.Util.Arbitrary.Network+      Haskoin.Util.Arbitrary.Script+      Haskoin.Util.Arbitrary.Transaction+      Haskoin.Util.Arbitrary.Util       Paths_haskoin_core   hs-source-dirs:       test
src/Haskoin/Block/Common.hs view
@@ -274,8 +274,9 @@  -- | The 'Headers' type is used to return a list of block headers in -- response to a 'GetHeaders' message.-newtype Headers = Headers -- | list of block headers with transaction count-    { headersList :: [BlockHeaderCount]+newtype Headers = Headers+    { -- | list of block headers with transaction count+      headersList :: [BlockHeaderCount]     } deriving (Eq, Show, Generic, NFData)  instance Serialize Headers where
+ src/Haskoin/Util/Arbitrary.hs view
@@ -0,0 +1,23 @@+{-|+Module      : Haskoin.Test+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX++Arbitrary instances for testing.+-}+module Haskoin.Util.Arbitrary+    ( module X+    ) where++import           Haskoin.Util.Arbitrary.Address     as X+import           Haskoin.Util.Arbitrary.Block       as X+import           Haskoin.Util.Arbitrary.Crypto      as X+import           Haskoin.Util.Arbitrary.Keys        as X+import           Haskoin.Util.Arbitrary.Message     as X+import           Haskoin.Util.Arbitrary.Network     as X+import           Haskoin.Util.Arbitrary.Script      as X+import           Haskoin.Util.Arbitrary.Transaction as X+import           Haskoin.Util.Arbitrary.Util        as X
+ src/Haskoin/Util/Arbitrary/Address.hs view
@@ -0,0 +1,33 @@+{-|+Module      : Haskoin.Test.Address+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX+-}+module Haskoin.Util.Arbitrary.Address where++import           Haskoin.Address+import           Haskoin.Util.Arbitrary.Crypto+import           Test.QuickCheck++-- | Arbitrary pay-to-public-key-hash or pay-to-script-hash address.+arbitraryAddress :: Gen Address+arbitraryAddress = oneof [arbitraryPubKeyAddress, arbitraryScriptAddress]++-- | Arbitrary pay-to-public-key-hash address.+arbitraryPubKeyAddress :: Gen Address+arbitraryPubKeyAddress = PubKeyAddress <$> arbitraryHash160++-- | Arbitrary pay-to-script-hash address.+arbitraryScriptAddress :: Gen Address+arbitraryScriptAddress = ScriptAddress <$> arbitraryHash160++-- | Arbitrary pay-to-witness public key hash+arbitraryWitnessPubKeyAddress :: Gen Address+arbitraryWitnessPubKeyAddress = WitnessPubKeyAddress <$> arbitraryHash160 ++-- | Arbitrary pay-to-witness script hash+arbitraryWitnessScriptAddress :: Gen Address+arbitraryWitnessScriptAddress = WitnessPubKeyAddress <$> arbitraryHash160
+ src/Haskoin/Util/Arbitrary/Block.hs view
@@ -0,0 +1,69 @@+{-|+Module      : Haskoin.Test.Block+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX+-}+module Haskoin.Util.Arbitrary.Block where++import           Haskoin.Block.Common+import           Haskoin.Block.Merkle+import           Haskoin.Constants+import           Haskoin.Util.Arbitrary.Crypto+import           Haskoin.Util.Arbitrary.Network+import           Haskoin.Util.Arbitrary.Transaction+import           Test.QuickCheck++-- | Block full or arbitrary transactions.+arbitraryBlock :: Network -> Gen Block+arbitraryBlock net = do+    h   <- arbitraryBlockHeader+    c   <- choose (0,10)+    txs <- vectorOf c (arbitraryTx net)+    return $ Block h txs++-- | Block header with random hash.+arbitraryBlockHeader :: Gen BlockHeader+arbitraryBlockHeader =+    BlockHeader <$> arbitrary+                      <*> arbitraryBlockHash+                      <*> arbitraryHash256+                      <*> arbitrary+                      <*> arbitrary+                      <*> arbitrary++-- | Arbitrary block hash.+arbitraryBlockHash :: Gen BlockHash+arbitraryBlockHash = BlockHash <$> arbitraryHash256++-- | Arbitrary 'GetBlocks' object with at least one block hash.+arbitraryGetBlocks :: Gen GetBlocks+arbitraryGetBlocks =+    GetBlocks <$> arbitrary+              <*> listOf1 arbitraryBlockHash+              <*> arbitraryBlockHash++-- | Arbitrary 'GetHeaders' object with at least one block header.+arbitraryGetHeaders :: Gen GetHeaders+arbitraryGetHeaders =+    GetHeaders <$> arbitrary+               <*> listOf1 arbitraryBlockHash+               <*> arbitraryBlockHash++-- | Arbitrary 'Headers' object with at least one block header.+arbitraryHeaders :: Gen Headers+arbitraryHeaders =+    Headers <$> listOf1 ((,) <$> arbitraryBlockHeader <*> arbitraryVarInt)++-- | Arbitrary 'MerkleBlock' with at least one hash.+arbitraryMerkleBlock :: Gen MerkleBlock+arbitraryMerkleBlock = do+    bh     <- arbitraryBlockHeader+    ntx    <- arbitrary+    hashes <- listOf1 arbitraryHash256+    c      <- choose (1,10)+    flags  <- vectorOf (c*8) arbitrary+    return $ MerkleBlock bh ntx hashes flags+
+ src/Haskoin/Util/Arbitrary/Crypto.hs view
@@ -0,0 +1,33 @@+{-|+Module      : Haskoin.Test.Crypto+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX+-}+module Haskoin.Util.Arbitrary.Crypto where++import           Haskoin.Crypto.Hash+import           Haskoin.Util.Arbitrary.Util+import           Test.QuickCheck++-- | Arbitrary 160-bit hash.+arbitraryHash160 :: Gen Hash160+arbitraryHash160 =+    ripemd160 <$> arbitraryBSn 20++-- | Arbitrary 256-bit hash.+arbitraryHash256 :: Gen Hash256+arbitraryHash256 =+    sha256 <$> arbitraryBSn 32++-- | Arbitrary 512-bit hash.+arbitraryHash512 :: Gen Hash512+arbitraryHash512 =+    sha512 <$> arbitraryBSn 64++-- | Arbitrary 32-bit checksum.+arbitraryCheckSum32 :: Gen CheckSum32+arbitraryCheckSum32 =+    checkSum32 <$> arbitraryBSn 4
+ src/Haskoin/Util/Arbitrary/Keys.hs view
@@ -0,0 +1,85 @@+{-|+Module      : Haskoin.Test.Keys+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX+-}+module Haskoin.Util.Arbitrary.Keys where++import           Data.Bits             (clearBit)+import           Data.List             (foldl')+import           Data.Word             (Word32)+import           Haskoin.Crypto+import           Haskoin.Keys.Common+import           Haskoin.Keys.Extended+import           Haskoin.Util.Arbitrary.Crypto+import           Test.QuickCheck++-- | Arbitrary private key with arbitrary compressed flag.+arbitrarySecKeyI :: Gen SecKeyI+arbitrarySecKeyI = wrapSecKey <$> arbitrary <*> arbitrary++-- | Arbitrary keypair, both either compressed or not.+arbitraryKeyPair :: Gen (SecKeyI, PubKeyI)+arbitraryKeyPair = do+    k <- arbitrarySecKeyI+    return (k, derivePubKeyI k)++-- | Arbitrary extended private key.+arbitraryXPrvKey :: Gen XPrvKey+arbitraryXPrvKey =+    XPrvKey <$> arbitrary+            <*> arbitrary+            <*> arbitrary+            <*> arbitraryHash256+            <*> arbitrary++-- | Arbitrary extended public key with its corresponding private key.+arbitraryXPubKey :: Gen (XPrvKey, XPubKey)+arbitraryXPubKey = (\k -> (k, deriveXPubKey k)) <$> arbitraryXPrvKey++{- Custom derivations -}++-- | Arbitrary derivation index with last bit unset.+genIndex :: Gen Word32+genIndex = (`clearBit` 31) <$> arbitrary++-- | Arbitrary BIP-32 path index. Can be hardened or not.+arbitraryBip32PathIndex :: Gen Bip32PathIndex+arbitraryBip32PathIndex =+    oneof [ Bip32SoftIndex <$> genIndex+          , Bip32HardIndex <$> genIndex+          ]++-- | Arbitrary BIP-32 derivation path composed of only hardened derivations.+arbitraryHardPath :: Gen HardPath+arbitraryHardPath = foldl' (:|) Deriv <$> listOf genIndex++-- | Arbitrary BIP-32 derivation path composed of only non-hardened derivations.+arbitrarySoftPath :: Gen SoftPath+arbitrarySoftPath = foldl' (:/) Deriv <$> listOf genIndex++-- | Arbitrary derivation path composed of hardened and non-hardened derivations.+arbitraryDerivPath :: Gen DerivPath+arbitraryDerivPath = concatBip32Segments <$> listOf arbitraryBip32PathIndex++-- | Arbitrary parsed derivation path. Can contain 'ParsedPrv', 'ParsedPub' or+-- 'ParsedEmpty' elements.+arbitraryParsedPath :: Gen ParsedPath+arbitraryParsedPath =+    oneof [ ParsedPrv <$> arbitraryDerivPath+          , ParsedPub <$> arbitraryDerivPath+          , ParsedEmpty <$> arbitraryDerivPath+          ]++-- | Arbitrary message hash, private key, nonce and corresponding signature. The+-- signature is generated with a random message, random private key and a random+-- nonce.+arbitrarySignature :: Gen (Hash256, SecKey, Sig)+arbitrarySignature = do+    m <- arbitraryHash256+    key <- arbitrary+    let sig = signHash key m+    return (m, key, sig)
+ src/Haskoin/Util/Arbitrary/Message.hs view
@@ -0,0 +1,52 @@+{-|+Module      : Haskoin.Test.Message+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX+-}+module Haskoin.Util.Arbitrary.Message where++import           Haskoin.Constants+import           Haskoin.Network.Message+import           Haskoin.Util.Arbitrary.Block+import           Haskoin.Util.Arbitrary.Crypto+import           Haskoin.Util.Arbitrary.Network+import           Haskoin.Util.Arbitrary.Transaction+import           Test.QuickCheck++-- | Arbitrary 'MessageHeader'.+arbitraryMessageHeader :: Gen MessageHeader+arbitraryMessageHeader =+    MessageHeader <$> arbitrary+                  <*> arbitraryMessageCommand+                  <*> arbitrary+                  <*> arbitraryCheckSum32++-- | Arbitrary 'Message'.+arbitraryMessage :: Network -> Gen Message+arbitraryMessage net =+    oneof+        [ MVersion <$> arbitraryVersion+        , return MVerAck+        , MAddr <$> arbitraryAddr1+        , MInv <$> arbitraryInv1+        , MGetData <$> arbitraryGetData+        , MNotFound <$> arbitraryNotFound+        , MGetBlocks <$> arbitraryGetBlocks+        , MGetHeaders <$> arbitraryGetHeaders+        , MTx <$> arbitraryTx net+        , MBlock <$> arbitraryBlock net+        , MMerkleBlock <$> arbitraryMerkleBlock+        , MHeaders <$> arbitraryHeaders+        , return MGetAddr+        , MFilterLoad <$> arbitraryFilterLoad+        , MFilterAdd <$> arbitraryFilterAdd+        , return MFilterClear+        , MPing <$> arbitraryPing+        , MPong <$> arbitraryPong+        , MAlert <$> arbitraryAlert+        , MReject <$> arbitraryReject+        , return MSendHeaders+        ]
+ src/Haskoin/Util/Arbitrary/Network.hs view
@@ -0,0 +1,178 @@+{-|+Module      : Haskoin.Test.Network+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX+-}+module Haskoin.Util.Arbitrary.Network where++import qualified Data.ByteString               as BS (empty, pack)+import qualified Data.ByteString.Char8         as C8+import           Data.Word                     (Word16, Word32)+import           Haskoin.Network+import           Haskoin.Util.Arbitrary.Crypto+import           Haskoin.Util.Arbitrary.Util+import           Network.Socket                (SockAddr (..))+import           Test.QuickCheck++-- | Arbitrary 'VarInt'.+arbitraryVarInt :: Gen VarInt+arbitraryVarInt = VarInt <$> arbitrary++-- | Arbitrary 'VarString'.+arbitraryVarString :: Gen VarString+arbitraryVarString = VarString <$> arbitraryBS++-- | Arbitrary 'NetworkAddress'.+arbitraryNetworkAddress :: Gen NetworkAddress+arbitraryNetworkAddress = do+    s <- arbitrary+    a <- arbitrary+    p <- arbitrary+    d <- oneof+        [ do+            b <- arbitrary+            c <- arbitrary+            d <- arbitrary+            return $ SockAddrInet6 (fromIntegral p) 0 (a,b,c,d) 0+        , return $ SockAddrInet (fromIntegral (p :: Word16)) a+        ]+    let n = sockToHostAddress d+    return $ NetworkAddress s n++-- | Arbitrary 'NetworkAddressTime'.+arbitraryNetworkAddressTime :: Gen (Word32, NetworkAddress)+arbitraryNetworkAddressTime = (,) <$> arbitrary <*> arbitraryNetworkAddress++-- | Arbitrary 'InvType'.+arbitraryInvType :: Gen InvType+arbitraryInvType = elements [InvError, InvTx, InvBlock, InvMerkleBlock]++-- | Arbitrary 'InvVector'.+arbitraryInvVector :: Gen InvVector+arbitraryInvVector = InvVector <$> arbitraryInvType <*> arbitraryHash256++-- | Arbitrary non-empty 'Inv'.+arbitraryInv1 :: Gen Inv+arbitraryInv1 = Inv <$> listOf1 arbitraryInvVector++-- | Arbitrary 'Version'.+arbitraryVersion :: Gen Version+arbitraryVersion =+    Version <$> arbitrary+            <*> arbitrary+            <*> arbitrary+            <*> arbitraryNetworkAddress+            <*> arbitraryNetworkAddress+            <*> arbitrary+            <*> arbitraryVarString+            <*> arbitrary+            <*> arbitrary++-- | Arbitrary non-empty 'Addr'.+arbitraryAddr1 :: Gen Addr+arbitraryAddr1 = Addr <$> listOf1 arbitraryNetworkAddressTime++-- | Arbitrary 'Alert' with random payload and signature. Signature is not+-- valid.+arbitraryAlert :: Gen Alert+arbitraryAlert = Alert <$> arbitraryVarString <*> arbitraryVarString++-- | Arbitrary 'Reject'.+arbitraryReject :: Gen Reject+arbitraryReject = do+    m <- arbitraryMessageCommand+    c <- arbitraryRejectCode+    s <- arbitraryVarString+    d <- oneof [ return BS.empty+               , BS.pack <$> vectorOf 32 arbitrary+               ]+    return $ Reject m c s d++-- | Arbitrary 'RejectCode'.+arbitraryRejectCode :: Gen RejectCode+arbitraryRejectCode =+    elements+        [ RejectMalformed+        , RejectInvalid+        , RejectInvalid+        , RejectDuplicate+        , RejectNonStandard+        , RejectDust+        , RejectInsufficientFee+        , RejectCheckpoint+        ]++-- | Arbitrary non-empty 'GetData'.+arbitraryGetData :: Gen GetData+arbitraryGetData = GetData <$> listOf1 arbitraryInvVector++-- | Arbitrary 'NotFound'.+arbitraryNotFound :: Gen NotFound+arbitraryNotFound = NotFound <$> listOf1 arbitraryInvVector++-- | Arbitrary 'Ping'.+arbitraryPing :: Gen Ping+arbitraryPing = Ping <$> arbitrary++-- | Arbitrary 'Pong'.+arbitraryPong :: Gen Pong+arbitraryPong = Pong <$> arbitrary++-- | Arbitrary bloom filter flags.+arbitraryBloomFlags :: Gen BloomFlags+arbitraryBloomFlags =+    elements+        [ BloomUpdateNone+        , BloomUpdateAll+        , BloomUpdateP2PubKeyOnly+        ]++-- | Arbitrary bloom filter with its corresponding number of elements+-- and false positive rate.+arbitraryBloomFilter :: Gen (Int, Double, BloomFilter)+arbitraryBloomFilter = do+    n     <- choose (0,100000)+    fp    <- choose (1e-8,1)+    tweak <- arbitrary+    fl    <- arbitraryBloomFlags+    return (n, fp, bloomCreate n fp tweak fl)++-- | Arbitrary 'FilterLoad'.+arbitraryFilterLoad :: Gen FilterLoad+arbitraryFilterLoad = do+    (_, _, bf) <- arbitraryBloomFilter+    return $ FilterLoad bf++-- | Arbitrary 'FilterAdd'.+arbitraryFilterAdd :: Gen FilterAdd+arbitraryFilterAdd = FilterAdd <$> arbitraryBS++-- | Arbitrary 'MessageCommand'.+arbitraryMessageCommand :: Gen MessageCommand+arbitraryMessageCommand = do+    ASCIIString str <- arbitrary+    elements+        [ MCVersion+        , MCVerAck+        , MCAddr+        , MCInv+        , MCGetData+        , MCNotFound+        , MCGetBlocks+        , MCGetHeaders+        , MCTx+        , MCBlock+        , MCMerkleBlock+        , MCHeaders+        , MCGetAddr+        , MCFilterLoad+        , MCFilterAdd+        , MCFilterClear+        , MCPing+        , MCPong+        , MCAlert+        , MCOther (C8.take 12 (C8.pack (filter (/= '\NUL') str)))+        ]
+ src/Haskoin/Util/Arbitrary/Script.hs view
@@ -0,0 +1,379 @@+{-# LANGUAGE LambdaCase #-}+{-|+Module      : Haskoin.Test.Script+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX+-}+module Haskoin.Util.Arbitrary.Script where++import           Crypto.Secp256k1+import           Data.Maybe+import           Data.Word+import           Haskoin.Address+import           Haskoin.Constants+import           Haskoin.Keys.Common+import           Haskoin.Script+import           Haskoin.Transaction.Common+import           Haskoin.Util+import           Haskoin.Util.Arbitrary.Address+import           Haskoin.Util.Arbitrary.Crypto+import           Haskoin.Util.Arbitrary.Keys+import           Haskoin.Util.Arbitrary.Util+import           Test.QuickCheck++-- | Arbitrary 'Script' with random script ops.+arbitraryScript :: Gen Script+arbitraryScript = Script <$> listOf arbitraryScriptOp++-- | Arbitrary 'ScriptOp' (push operations have random data).+arbitraryScriptOp :: Gen ScriptOp+arbitraryScriptOp =+    oneof+          -- Pushing Data+        [ opPushData <$> arbitraryBS1+        , return OP_0+        , return OP_1NEGATE+        , return OP_RESERVED+        , return OP_1+        , return OP_2+        , return OP_3+        , return OP_4+        , return OP_5+        , return OP_6+        , return OP_7+        , return OP_8+        , return OP_9+        , return OP_10+        , return OP_11+        , return OP_12+        , return OP_13+        , return OP_14+        , return OP_15+        , return OP_16+        -- Flow control+        , return OP_NOP+        , return OP_VER+        , return OP_IF+        , return OP_NOTIF+        , return OP_VERIF+        , return OP_VERNOTIF+        , return OP_ELSE+        , return OP_ENDIF+        , return OP_VERIFY+        , return OP_RETURN+        -- Stack operations+        , return OP_TOALTSTACK+        , return OP_FROMALTSTACK+        , return OP_IFDUP+        , return OP_DEPTH+        , return OP_DROP+        , return OP_DUP+        , return OP_NIP+        , return OP_OVER+        , return OP_PICK+        , return OP_ROLL+        , return OP_ROT+        , return OP_SWAP+        , return OP_TUCK+        , return OP_2DROP+        , return OP_2DUP+        , return OP_3DUP+        , return OP_2OVER+        , return OP_2ROT+        , return OP_2SWAP+        -- Splice+        , return OP_CAT+        , return OP_SUBSTR+        , return OP_LEFT+        , return OP_RIGHT+        , return OP_SIZE+        -- Bitwise logic+        , return OP_INVERT+        , return OP_AND+        , return OP_OR+        , return OP_XOR+        , return OP_EQUAL+        , return OP_EQUALVERIFY+        , return OP_RESERVED1+        , return OP_RESERVED2+        -- Arithmetic+        , return OP_1ADD+        , return OP_1SUB+        , return OP_2MUL+        , return OP_2DIV+        , return OP_NEGATE+        , return OP_ABS+        , return OP_NOT+        , return OP_0NOTEQUAL+        , return OP_ADD+        , return OP_SUB+        , return OP_MUL+        , return OP_DIV+        , return OP_MOD+        , return OP_LSHIFT+        , return OP_RSHIFT+        , return OP_BOOLAND+        , return OP_BOOLOR+        , return OP_NUMEQUAL+        , return OP_NUMEQUALVERIFY+        , return OP_NUMNOTEQUAL+        , return OP_LESSTHAN+        , return OP_GREATERTHAN+        , return OP_LESSTHANOREQUAL+        , return OP_GREATERTHANOREQUAL+        , return OP_MIN+        , return OP_MAX+        , return OP_WITHIN+        -- Crypto+        , return OP_RIPEMD160+        , return OP_SHA1+        , return OP_SHA256+        , return OP_HASH160+        , return OP_HASH256+        , return OP_CODESEPARATOR+        , return OP_CHECKSIG+        , return OP_CHECKSIGVERIFY+        , return OP_CHECKMULTISIG+        , return OP_CHECKMULTISIGVERIFY+        -- Expansion+        , return OP_NOP1+        , return OP_NOP2+        , return OP_NOP3+        , return OP_NOP4+        , return OP_NOP5+        , return OP_NOP6+        , return OP_NOP7+        , return OP_NOP8+        , return OP_NOP9+        , return OP_NOP10+        -- Bitcoin Cash Nov 2018 hard fork+        , return OP_CHECKDATASIG+        , return OP_CHECKDATASIGVERIFY+        -- Bitcoin Cash May 2020 hard fork+        , return OP_REVERSEBYTES+        -- Other+        , return OP_PUBKEYHASH+        , return OP_PUBKEY+        , return $ OP_INVALIDOPCODE 0xff+        ]++-- | Arbtirary 'ScriptOp' with a value in @[OP_1 .. OP_16]@.+arbitraryIntScriptOp :: Gen ScriptOp+arbitraryIntScriptOp =+    elements+        [ OP_1,  OP_2,  OP_3,  OP_4+        , OP_5,  OP_6,  OP_7,  OP_8+        , OP_9,  OP_10, OP_11, OP_12+        , OP_13, OP_14, OP_15, OP_16+        ]++-- | Arbitrary 'PushDataType'.+arbitraryPushDataType :: Gen PushDataType+arbitraryPushDataType = elements [OPCODE, OPDATA1, OPDATA2, OPDATA4]++-- | Arbitrary 'SigHash' (including invalid/unknown sighash codes).+arbitrarySigHash :: Gen SigHash+arbitrarySigHash = fromIntegral <$> (arbitrary :: Gen Word32)++-- | Arbitrary valid 'SigHash'.+arbitraryValidSigHash :: Network -> Gen SigHash+arbitraryValidSigHash net = do+    sh <- elements [sigHashAll, sigHashNone, sigHashSingle]+    f1 <-+        elements $+        if isJust (getSigHashForkId net)+            then [id, setForkIdFlag]+            else [id]+    f2 <- elements [id, setAnyoneCanPayFlag]+    return $ f1 $ f2 sh++-- | Arbitrary message hash, private key and corresponding 'TxSignature'. The+-- signature is generated deterministically using a random message and a random+-- private key.+arbitraryTxSignature :: Network -> Gen (TxHash, SecKey, TxSignature)+arbitraryTxSignature net = do+    (m, key, sig) <- arbitrarySignature+    sh <- (fromIntegral <$> (arbitrary :: Gen Word8)) `suchThat` filterBad+    let txsig = TxSignature sig sh+    return (TxHash m, key, txsig)+  where+    filterBad sh = not $+        isSigHashUnknown sh ||+        isNothing (getSigHashForkId net) && hasForkIdFlag sh++-- | Arbitrary transaction signature that could also be empty.+arbitraryTxSignatureEmpty :: Network -> Gen TxSignature+arbitraryTxSignatureEmpty net =+    frequency [ (1, return TxSignatureEmpty)+              , (10, lst3 <$> arbitraryTxSignature net)+              ]++-- | Arbitrary m of n parameters.+arbitraryMSParam :: Gen (Int, Int)+arbitraryMSParam = do+    m <- choose (1,16)+    n <- choose (m,16)+    return (m, n)++-- | Arbitrary 'ScriptOutput' (Can by any valid type).+arbitraryScriptOutput :: Network -> Gen ScriptOutput+arbitraryScriptOutput net =+    oneof $+    [ arbitraryPKOutput+    , arbitraryPKHashOutput+    , arbitraryMSOutput+    , arbitrarySHOutput+    , arbitraryDCOutput+    ] +++    if getSegWit net+        then [arbitraryWPKHashOutput, arbitraryWSHOutput]+        else []++-- | Arbitrary 'ScriptOutput' of type 'PayPK', 'PayPKHash' or 'PayMS'+-- (Not 'PayScriptHash', 'DataCarrier', or SegWit)+arbitrarySimpleOutput :: Gen ScriptOutput+arbitrarySimpleOutput =+    oneof+        [ arbitraryPKOutput+        , arbitraryPKHashOutput+        , arbitraryMSOutput+        ]++-- | Arbitrary 'ScriptOutput' of type 'PayPK'+arbitraryPKOutput :: Gen ScriptOutput+arbitraryPKOutput =  PayPK . snd <$> arbitraryKeyPair++-- | Arbitrary 'ScriptOutput' of type 'PayPKHash'+arbitraryPKHashOutput :: Gen ScriptOutput+arbitraryPKHashOutput = PayPKHash <$> arbitraryHash160++-- | Arbitrary 'PayWitnessPKHash' output.+arbitraryWPKHashOutput :: Gen ScriptOutput+arbitraryWPKHashOutput = PayWitnessPKHash <$> arbitraryHash160++-- | Arbitrary 'PayWitnessScriptHash' output.+arbitraryWSHOutput :: Gen ScriptOutput+arbitraryWSHOutput = PayWitnessScriptHash <$> arbitraryHash256++-- | Arbitrary 'ScriptOutput' of type 'PayMS'.+arbitraryMSOutput :: Gen ScriptOutput+arbitraryMSOutput = do+    (m, n) <- arbitraryMSParam+    keys <- map snd <$> vectorOf n arbitraryKeyPair+    return $ PayMulSig keys m++-- | Arbitrary 'ScriptOutput' of type 'PayMS', only using compressed keys.+arbitraryMSOutputC :: Gen ScriptOutput+arbitraryMSOutputC = do+    (m, n) <- arbitraryMSParam+    keys <-+        map snd <$>+        vectorOf n (arbitraryKeyPair `suchThat` (pubKeyCompressed . snd))+    return $ PayMulSig keys m++-- | Arbitrary 'ScriptOutput' of type 'PayScriptHash'.+arbitrarySHOutput :: Gen ScriptOutput+arbitrarySHOutput = PayScriptHash . getAddrHash160 <$> arbitraryScriptAddress++-- | Arbitrary 'ScriptOutput' of type 'DataCarrier'.+arbitraryDCOutput :: Gen ScriptOutput+arbitraryDCOutput = DataCarrier <$> arbitraryBS1++-- | Arbitrary 'ScriptInput'.+arbitraryScriptInput :: Network -> Gen ScriptInput+arbitraryScriptInput net =+    oneof+        [ arbitraryPKInput net+        , arbitraryPKHashInput net+        , arbitraryMSInput net+        , arbitrarySHInput net+        ]++-- | Arbitrary 'ScriptInput' of type 'SpendPK', 'SpendPKHash' or 'SpendMulSig'+-- (not 'ScriptHashInput')+arbitrarySimpleInput :: Network -> Gen ScriptInput+arbitrarySimpleInput net =+    oneof+        [ arbitraryPKInput net+        , arbitraryPKHashInput net+        , arbitraryMSInput net+        ]++-- | Arbitrary 'ScriptInput' of type 'SpendPK'.+arbitraryPKInput :: Network -> Gen ScriptInput+arbitraryPKInput net = RegularInput . SpendPK <$> arbitraryTxSignatureEmpty net++-- | Arbitrary 'ScriptInput' of type 'SpendPK'.+arbitraryPKHashInput :: Network -> Gen ScriptInput+arbitraryPKHashInput net = do+    sig <- arbitraryTxSignatureEmpty net+    key <- snd <$> arbitraryKeyPair+    return $ RegularInput $ SpendPKHash sig key++-- | Like 'arbitraryPKHashInput' without empty signatures.+arbitraryPKHashInputFull :: Network -> Gen ScriptInput+arbitraryPKHashInputFull net = do+    sig <- lst3 <$> arbitraryTxSignature net+    key <- snd <$> arbitraryKeyPair+    return $ RegularInput $ SpendPKHash sig key++-- | Like above but only compressed.+arbitraryPKHashInputFullC :: Network -> Gen ScriptInput+arbitraryPKHashInputFullC net = do+    sig <- lst3 <$> arbitraryTxSignature net+    key <- fmap snd $ arbitraryKeyPair `suchThat` (pubKeyCompressed . snd)+    return $ RegularInput $ SpendPKHash sig key++-- | Arbitrary 'ScriptInput' of type 'SpendMulSig'.+arbitraryMSInput :: Network -> Gen ScriptInput+arbitraryMSInput net = do+    m    <- fst <$> arbitraryMSParam+    sigs <- vectorOf m (arbitraryTxSignatureEmpty net)+    return $ RegularInput $ SpendMulSig sigs++-- | Arbitrary 'ScriptInput' of type 'ScriptHashInput'.+arbitrarySHInput :: Network -> Gen ScriptInput+arbitrarySHInput net = do+    i <- arbitrarySimpleInput net+    ScriptHashInput (getRegularInput i) <$> arbitrarySimpleOutput++-- | Arbitrary 'ScriptInput' of type 'ScriptHashInput' containing a+-- 'RedeemScript' of type 'PayMulSig' and an input of type 'SpendMulSig'.+arbitraryMulSigSHInput :: Network -> Gen ScriptInput+arbitraryMulSigSHInput net =+    arbitraryMSOutput >>= \case+        rdm@(PayMulSig _ m) -> do+            sigs <- vectorOf m (arbitraryTxSignatureEmpty net)+            return $ ScriptHashInput (SpendMulSig sigs) rdm+        _ -> undefined++-- | Arbitrary 'ScriptInput' of type 'ScriptHashInput' containing a+-- 'RedeemScript' of type 'PayMulSig' and an input of type 'SpendMulSig'.+arbitraryMulSigSHInputC :: Network -> Gen ScriptInput+arbitraryMulSigSHInputC net =+    arbitraryMSOutputC >>= \case+        rdm@(PayMulSig _ m) -> do+          sigs <- vectorOf m (arbitraryTxSignatureEmpty net)+          return $ ScriptHashInput (SpendMulSig sigs) rdm+        _ -> undefined++-- | Like 'arbitraryMulSigSHCInput' with no empty signatures.+arbitraryMulSigSHInputFull :: Network -> Gen ScriptInput+arbitraryMulSigSHInputFull net =+    arbitraryMSOutput >>= \case+        rdm@(PayMulSig _ m) -> do+            sigs <- map lst3 <$> vectorOf m (arbitraryTxSignature net)+            return $ ScriptHashInput (SpendMulSig sigs) rdm+        _ -> undefined++-- | Like 'arbitraryMulSigSHCInput' with no empty signatures.+arbitraryMulSigSHInputFullC :: Network -> Gen ScriptInput+arbitraryMulSigSHInputFullC net =+    arbitraryMSOutputC >>= \case+        rdm@(PayMulSig _ m) -> do+            sigs <- map lst3 <$> vectorOf m (arbitraryTxSignature net)+            return $ ScriptHashInput (SpendMulSig sigs) rdm+        _ -> undefined
+ src/Haskoin/Util/Arbitrary/Transaction.hs view
@@ -0,0 +1,278 @@+{-|+Module      : Haskoin.Test.Transaction+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX+-}+module Haskoin.Util.Arbitrary.Transaction where++import           Control.Monad+import qualified Data.ByteString     as BS+import           Data.Either         (fromRight)+import           Data.List           (nub, nubBy, permutations)+import           Data.Word           (Word64)+import           Haskoin.Address+import           Haskoin.Constants+import           Haskoin.Keys.Common+import           Haskoin.Script+import           Haskoin.Util.Arbitrary.Crypto+import           Haskoin.Util.Arbitrary.Keys+import           Haskoin.Util.Arbitrary.Script+import           Haskoin.Util.Arbitrary.Util+import           Haskoin.Transaction+import           Test.QuickCheck++-- | Wrapped coin value for testing.+newtype TestCoin = TestCoin { getTestCoin :: Word64 }+    deriving (Eq, Show)++instance Coin TestCoin where+    coinValue = getTestCoin++-- | Arbitrary transaction hash (for non-existent transaction).+arbitraryTxHash :: Gen TxHash+arbitraryTxHash = TxHash <$> arbitraryHash256++-- | Arbitrary amount of Satoshi as 'Word64' (Between 1 and 21e14)+arbitrarySatoshi :: Network -> Gen TestCoin+arbitrarySatoshi net = TestCoin <$> choose (1, getMaxSatoshi net)++-- | Arbitrary 'OutPoint'.+arbitraryOutPoint :: Gen OutPoint+arbitraryOutPoint = OutPoint <$> arbitraryTxHash <*> arbitrary++-- | Arbitrary 'TxOut'.+arbitraryTxOut :: Network -> Gen TxOut+arbitraryTxOut net =+    TxOut <$> (getTestCoin <$> arbitrarySatoshi net)+          <*> (encodeOutputBS <$> arbitraryScriptOutput net)++-- | Arbitrary 'TxIn'.+arbitraryTxIn :: Network -> Gen TxIn+arbitraryTxIn net =+    TxIn <$> arbitraryOutPoint+         <*> (encodeInputBS <$> arbitraryScriptInput net)+         <*> arbitrary++-- | Arbitrary transaction. Can be regular or with witnesses.+arbitraryTx :: Network -> Gen Tx+arbitraryTx net = oneof [arbitraryLegacyTx net, arbitraryWitnessTx net]++-- | Arbitrary regular transaction.+arbitraryLegacyTx :: Network -> Gen Tx+arbitraryLegacyTx net = arbitraryWLTx net False++-- | Arbitrary witness transaction (witness data is fake).+arbitraryWitnessTx :: Network -> Gen Tx+arbitraryWitnessTx net = arbitraryWLTx net True++-- | Arbitrary witness or legacy transaction.+arbitraryWLTx :: Network -> Bool -> Gen Tx+arbitraryWLTx net wit = do+    ni <- choose (0, 5)+    no <-+        if wit+            then choose (0, 5)+            else choose+                     ( if ni == 0+                           then 2+                           else 0+                     , 5 -- avoid witness case+                      )+    inps <- vectorOf ni (arbitraryTxIn net)+    outs <- vectorOf no (arbitraryTxOut net)+    let uniqueInps = nubBy (\a b -> prevOutput a == prevOutput b) inps+    w <-+        if wit+            then vectorOf (length uniqueInps) (listOf arbitraryBS)+            else return []+    Tx <$> arbitrary <*> pure uniqueInps <*> pure outs <*> pure w <*> arbitrary++-- | Arbitrary transaction containing only inputs of type 'SpendPKHash',+-- 'SpendScriptHash' (multisig) and outputs of type 'PayPKHash' and 'PaySH'.+-- Only compressed public keys are used.+arbitraryAddrOnlyTx :: Network -> Gen Tx+arbitraryAddrOnlyTx net = do+    ni <- choose (0, 5)+    no <- choose (0, 5)+    inps <- vectorOf ni (arbitraryAddrOnlyTxIn net)+    outs <- vectorOf no (arbitraryAddrOnlyTxOut net)+    Tx <$> arbitrary <*> pure inps <*> pure outs <*> pure [] <*> arbitrary++-- | Like 'arbitraryAddrOnlyTx' without empty signatures in the inputs.+arbitraryAddrOnlyTxFull :: Network -> Gen Tx+arbitraryAddrOnlyTxFull net = do+    ni <- choose (0, 5)+    no <- choose (0, 5)+    inps <- vectorOf ni (arbitraryAddrOnlyTxInFull net)+    outs <- vectorOf no (arbitraryAddrOnlyTxOut net)+    Tx <$> arbitrary <*> pure inps <*> pure outs <*> pure [] <*> arbitrary++-- | Arbitrary TxIn that can only be of type 'SpendPKHash' or 'SpendScriptHash'+-- (multisig). Only compressed public keys are used.+arbitraryAddrOnlyTxIn :: Network -> Gen TxIn+arbitraryAddrOnlyTxIn net = do+    inp <- oneof [arbitraryPKHashInput net, arbitraryMulSigSHInput net]+    TxIn <$> arbitraryOutPoint <*> pure (encodeInputBS inp) <*> arbitrary++-- | like 'arbitraryAddrOnlyTxIn' with no empty signatures.+arbitraryAddrOnlyTxInFull :: Network -> Gen TxIn+arbitraryAddrOnlyTxInFull net = do+    inp <-+        oneof [arbitraryPKHashInputFullC net, arbitraryMulSigSHInputFullC net]+    TxIn <$> arbitraryOutPoint <*> pure (encodeInputBS inp) <*> arbitrary++-- | Arbitrary 'TxOut' that can only be of type 'PayPKHash' or 'PaySH'.+arbitraryAddrOnlyTxOut :: Network -> Gen TxOut+arbitraryAddrOnlyTxOut net = do+    v <- getTestCoin <$> arbitrarySatoshi net+    out <- oneof [arbitraryPKHashOutput, arbitrarySHOutput]+    return $ TxOut v $ encodeOutputBS out++-- | Arbitrary 'SigInput' with the corresponding private keys used+-- to generate the 'ScriptOutput' or 'RedeemScript'.+arbitrarySigInput :: Network -> Gen (SigInput, [SecKeyI])+arbitrarySigInput net =+    oneof+        [ wrapKey <$> arbitraryPKSigInput net+        , wrapKey <$> arbitraryPKHashSigInput net+        , arbitraryMSSigInput net+        , arbitrarySHSigInput net+        , wrapKey <$> arbitraryWPKHSigInput net+        , arbitraryWSHSigInput net+        ]++-- | Arbitrary 'SigInput' with a 'ScriptOutput' of type 'PayPK'.+arbitraryPKSigInput :: Network -> Gen (SigInput, SecKeyI)+arbitraryPKSigInput net = arbitraryAnyInput net False++-- | Arbitrary 'SigInput' with a 'ScriptOutput' of type 'PayPKHash'.+arbitraryPKHashSigInput :: Network -> Gen (SigInput, SecKeyI)+arbitraryPKHashSigInput net = arbitraryAnyInput net True++-- | Arbitrary 'SigInput'.+arbitraryAnyInput :: Network -> Bool -> Gen (SigInput, SecKeyI)+arbitraryAnyInput net pkh = do+    (k, p) <- arbitraryKeyPair+    let out | pkh = PayPKHash $ getAddrHash160 $ pubKeyAddr p+            | otherwise = PayPK p+    (val, op, sh) <- arbitraryInputStuff net+    return (SigInput out val op sh Nothing, k)++-- | Arbitrary value, out point and sighash for an input.+arbitraryInputStuff :: Network -> Gen (Word64, OutPoint, SigHash)+arbitraryInputStuff net = do+    val <- getTestCoin <$> arbitrarySatoshi net+    op <- arbitraryOutPoint+    sh <- arbitraryValidSigHash net+    return (val, op, sh)++-- | Arbitrary 'SigInput' with a 'ScriptOutput' of type 'PayMulSig'.+arbitraryMSSigInput :: Network -> Gen (SigInput, [SecKeyI])+arbitraryMSSigInput net = do+    (m, n) <- arbitraryMSParam+    ks <- vectorOf n arbitraryKeyPair+    let out = PayMulSig (map snd ks) m+    (val, op, sh) <- arbitraryInputStuff net+    perm <- choose (0, n - 1)+    let ksPerm = map fst $ take m $ permutations ks !! perm+    return (SigInput out val op sh Nothing, ksPerm)++-- | Arbitrary 'SigInput' with 'ScriptOutput' of type 'PaySH' and a+-- 'RedeemScript'.+arbitrarySHSigInput :: Network -> Gen (SigInput, [SecKeyI])+arbitrarySHSigInput net = do+    (SigInput rdm val op sh _, ks) <- oneof+        [ wrapKey <$> arbitraryPKSigInput net+        , wrapKey <$> arbitraryPKHashSigInput net+        , arbitraryMSSigInput net+        ]+    let out = PayScriptHash $ getAddrHash160 $ payToScriptAddress rdm+    return (SigInput out val op sh $ Just rdm, ks)++arbitraryWPKHSigInput :: Network -> Gen (SigInput, SecKeyI)+arbitraryWPKHSigInput net = do+    (k, p) <- arbitraryKeyPair+    (val, op, sh) <- arbitraryInputStuff net+    let out = PayWitnessPKHash . getAddrHash160 $ pubKeyAddr p+    return (SigInput out val op sh Nothing, k)++arbitraryWSHSigInput :: Network -> Gen (SigInput, [SecKeyI])+arbitraryWSHSigInput net = do+    (SigInput rdm val op sh _, ks) <- oneof+        [ wrapKey <$> arbitraryPKSigInput net+        , wrapKey <$> arbitraryPKHashSigInput net+        , arbitraryMSSigInput net+        ]+    let out = PayWitnessScriptHash . getAddrHash256 $ payToWitnessScriptAddress rdm+    return (SigInput out val op sh $ Just rdm, ks)++-- | Arbitrary 'Tx' (empty 'TxIn'), 'SigInputs' and private keys that can be+-- passed to 'signTx' or 'detSignTx' to fully sign the 'Tx'.+arbitrarySigningData :: Network -> Gen (Tx, [SigInput], [SecKeyI])+arbitrarySigningData net = do+    v <- arbitrary+    ni <- choose (1, 5)+    no <- choose (1, 5)+    sigis <- vectorOf ni (arbitrarySigInput net)+    let uSigis = nubBy (\(a, _) (b, _) -> sigInputOP a == sigInputOP b) sigis+    inps <- forM uSigis $ \(s, _) -> TxIn (sigInputOP s) BS.empty <$> arbitrary+    outs <- vectorOf no (arbitraryTxOut net)+    l <- arbitrary+    perm <- choose (0, length inps - 1)+    let tx = Tx v (permutations inps !! perm) outs [] l+        keys = concatMap snd uSigis+    return (tx, map fst uSigis, keys)++-- | Arbitrary transaction with empty inputs.+arbitraryEmptyTx :: Network -> Gen Tx+arbitraryEmptyTx net = do+    v    <- arbitrary+    no   <- choose (1,5)+    ni   <- choose (1,5)+    outs <- vectorOf no (arbitraryTxOut net)+    ops  <- vectorOf ni arbitraryOutPoint+    t    <- arbitrary+    s    <- arbitrary+    return $ Tx v (map (\op -> TxIn op BS.empty s) (nub ops)) outs [] t++-- | Arbitrary partially-signed transactions.+arbitraryPartialTxs ::+       Network -> Gen ([Tx], [(ScriptOutput, Word64, OutPoint, Int, Int)])+arbitraryPartialTxs net = do+    tx <- arbitraryEmptyTx net+    res <-+        forM (map prevOutput $ txIn tx) $ \op -> do+            (so, val, rdmM, prvs, m, n) <- arbitraryData+            txs <- mapM (singleSig so val rdmM tx op . secKeyData) prvs+            return (txs, (so, val, op, m, n))+    return (concatMap fst res, map snd res)+  where+    singleSig so val rdmM tx op prv = do+        sh <- arbitraryValidSigHash net+        let sigi = SigInput so val op sh rdmM+        return . fromRight (error "Could not decode transaction") $+            signTx net tx [sigi] [prv]+    arbitraryData = do+        (m, n) <- arbitraryMSParam+        val <- getTestCoin <$> arbitrarySatoshi net+        nPrv <- choose (m, n)+        keys <- vectorOf n arbitraryKeyPair+        perm <- choose (0, length keys - 1)+        let pubKeys = map snd keys+            prvKeys = take nPrv $ permutations (map fst keys) !! perm+        let so = PayMulSig pubKeys m+        elements+            [ (so, val, Nothing, prvKeys, m, n)+            , ( PayScriptHash $ getAddrHash160 $ payToScriptAddress so+              , val+              , Just so+              , prvKeys+              , m+              , n)+            ]++wrapKey :: (SigInput, SecKeyI) -> (SigInput, [SecKeyI])+wrapKey (s, k) = (s, [k])
+ src/Haskoin/Util/Arbitrary/Util.hs view
@@ -0,0 +1,44 @@+{-|+Module      : Haskoin.Test.Util+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX+-}+module Haskoin.Util.Arbitrary.Util where++import           Data.ByteString       (ByteString, pack)+import           Data.Time.Clock       (UTCTime (..))+import           Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import           Data.Word             (Word32)+import           Test.QuickCheck+import           Haskoin.Constants++-- | Arbitrary strict 'ByteString'.+arbitraryBS :: Gen ByteString+arbitraryBS = pack <$> arbitrary++-- | Arbitrary non-empty strict ByteString+arbitraryBS1 :: Gen ByteString+arbitraryBS1 = pack <$> listOf1 arbitrary++-- | Arbitrary strict ByteString of a given length+arbitraryBSn :: Int -> Gen ByteString+arbitraryBSn n = pack <$> vectorOf n arbitrary++-- | Arbitrary UTCTime that generates dates after 01 Jan 1970 01:00:00 CET+arbitraryUTCTime :: Gen UTCTime+arbitraryUTCTime = do+    w <- arbitrary :: Gen Word32+    return $ posixSecondsToUTCTime $ realToFrac w++-- | Generate a Maybe from a Gen a+arbitraryMaybe :: Gen a -> Gen (Maybe a)+arbitraryMaybe g = frequency [ (1, return Nothing)+                             , (5, Just <$> g)+                             ]++arbitraryNetwork :: Gen Network+arbitraryNetwork = elements allNets+
test/Haskoin/AddressSpec.hs view
@@ -8,7 +8,7 @@ import           Haskoin.Address import           Haskoin.Constants import           Haskoin.Keys           (derivePubKeyI)-import           Haskoin.Test+import           Haskoin.Util.Arbitrary import           Haskoin.UtilSpec       (testCustomEncoding, testCustomJSON) import           Test.Hspec import           Test.HUnit             (Assertion, assertBool, assertEqual)
test/Haskoin/BlockSpec.hs view
@@ -11,8 +11,8 @@ import           Data.Text                  (Text) import           Haskoin.Block import           Haskoin.Constants-import           Haskoin.Test import           Haskoin.Transaction+import           Haskoin.Util.Arbitrary import           Haskoin.UtilSpec           (cerealID, testJsonID) import           Test.Hspec import           Test.HUnit                 hiding (State)
test/Haskoin/Crypto/HashSpec.hs view
@@ -9,8 +9,8 @@ import           Data.String.Conversions import           Haskoin.Block import           Haskoin.Crypto-import           Haskoin.Test import           Haskoin.Util+import           Haskoin.Util.Arbitrary import           Test.Hspec import           Test.HUnit              (Assertion, assertBool) import           Test.QuickCheck
test/Haskoin/Crypto/SignatureSpec.hs view
@@ -1,21 +1,21 @@ {-# LANGUAGE OverloadedStrings #-} module Haskoin.Crypto.SignatureSpec (spec) where -import           Data.Bits             (testBit)-import           Data.ByteString       (ByteString)-import qualified Data.ByteString       as BS (index, length)-import           Data.Serialize        as S-import           Data.Text             (Text)-import           Haskoin.Crypto        (SecKey, Sig, decodeStrictSig,-                                        derivePubKey, exportSig,-                                        importCompactSig, isCanonicalHalfOrder,-                                        sha256, signHash, verifyHashSig)-import           Haskoin.Test          (arbitrarySignature)-import           Haskoin.Util          (decodeHex, eitherToMaybe, lst3)-import           Test.Hspec            (Spec, describe, it)-import           Test.Hspec.QuickCheck (prop)-import           Test.HUnit            (Assertion, assertBool)-import           Test.QuickCheck       (forAll)+import           Data.Bits              (testBit)+import           Data.ByteString        (ByteString)+import qualified Data.ByteString        as BS (index, length)+import           Data.Serialize         as S+import           Data.Text              (Text)+import           Haskoin.Crypto         (SecKey, Sig, decodeStrictSig,+                                         derivePubKey, exportSig,+                                         importCompactSig, isCanonicalHalfOrder,+                                         sha256, signHash, verifyHashSig)+import           Haskoin.Util           (decodeHex, eitherToMaybe, lst3)+import           Haskoin.Util.Arbitrary (arbitrarySignature)+import           Test.Hspec             (Spec, describe, it)+import           Test.Hspec.QuickCheck  (prop)+import           Test.HUnit             (Assertion, assertBool)+import           Test.QuickCheck        (forAll)  spec :: Spec spec = do
test/Haskoin/Keys/ExtendedSpec.hs view
@@ -14,8 +14,8 @@ import           Haskoin.Address import           Haskoin.Constants import           Haskoin.Keys-import           Haskoin.Test import           Haskoin.Util+import           Haskoin.Util.Arbitrary import           Haskoin.UtilSpec           (cerealID, customCerealID,                                              testCustomEncoding, testCustomJSON,                                              testJsonID)
test/Haskoin/Keys/MnemonicSpec.hs view
@@ -1,22 +1,22 @@ {-# LANGUAGE OverloadedStrings #-} module Haskoin.Keys.MnemonicSpec (spec) where -import           Control.Monad           (zipWithM_)-import           Data.Bits               (shiftR, (.&.))-import qualified Data.ByteString         as BS-import           Data.Either             (fromRight)-import           Data.List               (isPrefixOf)-import           Data.Maybe              (fromJust)-import           Data.Serialize          (Serialize, encode)-import           Data.Text               (Text)-import qualified Data.Text               as T-import           Data.Word               (Word32, Word64)+import           Control.Monad          (zipWithM_)+import           Data.Bits              (shiftR, (.&.))+import qualified Data.ByteString        as BS+import           Data.Either            (fromRight)+import           Data.List              (isPrefixOf)+import           Data.Maybe             (fromJust)+import           Data.Serialize         (Serialize, encode)+import           Data.Text              (Text)+import qualified Data.Text              as T+import           Data.Word              (Word32, Word64) import           Haskoin.Keys-import           Haskoin.Test import           Haskoin.Util+import           Haskoin.Util.Arbitrary import           Test.Hspec import           Test.HUnit-import           Test.QuickCheck         hiding ((.&.))+import           Test.QuickCheck        hiding ((.&.))  spec :: Spec spec =
test/Haskoin/KeysSpec.hs view
@@ -10,7 +10,7 @@ import           Haskoin.Constants import           Haskoin.Crypto import           Haskoin.Keys-import           Haskoin.Test+import           Haskoin.Util.Arbitrary import           Haskoin.Util import           Test.Hspec import           Test.QuickCheck
test/Haskoin/NetworkSpec.hs view
@@ -1,20 +1,20 @@ {-# LANGUAGE OverloadedStrings #-} module Haskoin.NetworkSpec (spec) where -import           Data.Maybe          (fromJust)-import           Data.Serialize      as S-import           Data.Text           (Text)-import           Data.Word           (Word32)+import           Data.Maybe             (fromJust)+import           Data.Serialize         as S+import           Data.Text              (Text)+import           Data.Word              (Word32) import           Haskoin.Address import           Haskoin.Constants import           Haskoin.Keys import           Haskoin.Network-import           Haskoin.Test import           Haskoin.Transaction import           Haskoin.Util-import           Haskoin.UtilSpec    (cerealID, customCerealID)+import           Haskoin.Util.Arbitrary+import           Haskoin.UtilSpec       (cerealID, customCerealID) import           Test.Hspec-import           Test.HUnit          (Assertion, assertBool, assertEqual)+import           Test.HUnit             (Assertion, assertBool, assertEqual) import           Test.QuickCheck  spec :: Spec
test/Haskoin/ScriptSpec.hs view
@@ -18,9 +18,9 @@ import           Haskoin.Constants import           Haskoin.Keys import           Haskoin.Script-import           Haskoin.Test import           Haskoin.Transaction import           Haskoin.Util+import           Haskoin.Util.Arbitrary import           Haskoin.UtilSpec        (cerealID, testJsonID) import           Test.Hspec import           Test.HUnit              as HUnit
− test/Haskoin/Test.hs 
@@ -1,23 +0,0 @@-{-|-Module      : Haskoin.Test-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--Arbitrary instances for testing.--}-module Haskoin.Test-    ( module X-    ) where--import           Haskoin.Test.Address     as X-import           Haskoin.Test.Block       as X-import           Haskoin.Test.Crypto      as X-import           Haskoin.Test.Keys        as X-import           Haskoin.Test.Message     as X-import           Haskoin.Test.Network     as X-import           Haskoin.Test.Script      as X-import           Haskoin.Test.Transaction as X-import           Haskoin.Test.Util        as X
− test/Haskoin/Test/Address.hs 
@@ -1,25 +0,0 @@-{-|-Module      : Haskoin.Test.Address-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--}-module Haskoin.Test.Address where--import           Haskoin.Address-import           Haskoin.Test.Crypto-import           Test.QuickCheck---- | Arbitrary pay-to-public-key-hash or pay-to-script-hash address.-arbitraryAddress :: Gen Address-arbitraryAddress = oneof [arbitraryPubKeyAddress, arbitraryScriptAddress]---- | Arbitrary pay-to-public-key-hash address.-arbitraryPubKeyAddress :: Gen Address-arbitraryPubKeyAddress = p2pkhAddr <$> arbitraryHash160---- | Arbitrary pay-to-script-hash address.-arbitraryScriptAddress :: Gen Address-arbitraryScriptAddress = p2shAddr <$> arbitraryHash160
− test/Haskoin/Test/Block.hs 
@@ -1,69 +0,0 @@-{-|-Module      : Haskoin.Test.Block-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--}-module Haskoin.Test.Block where--import           Haskoin.Block.Common-import           Haskoin.Block.Merkle-import           Haskoin.Constants-import           Haskoin.Test.Crypto-import           Haskoin.Test.Network-import           Haskoin.Test.Transaction-import           Test.QuickCheck---- | Block full or arbitrary transactions.-arbitraryBlock :: Network -> Gen Block-arbitraryBlock net = do-    h   <- arbitraryBlockHeader-    c   <- choose (0,10)-    txs <- vectorOf c (arbitraryTx net)-    return $ Block h txs---- | Block header with random hash.-arbitraryBlockHeader :: Gen BlockHeader-arbitraryBlockHeader =-    BlockHeader <$> arbitrary-                      <*> arbitraryBlockHash-                      <*> arbitraryHash256-                      <*> arbitrary-                      <*> arbitrary-                      <*> arbitrary---- | Arbitrary block hash.-arbitraryBlockHash :: Gen BlockHash-arbitraryBlockHash = BlockHash <$> arbitraryHash256---- | Arbitrary 'GetBlocks' object with at least one block hash.-arbitraryGetBlocks :: Gen GetBlocks-arbitraryGetBlocks =-    GetBlocks <$> arbitrary-              <*> listOf1 arbitraryBlockHash-              <*> arbitraryBlockHash---- | Arbitrary 'GetHeaders' object with at least one block header.-arbitraryGetHeaders :: Gen GetHeaders-arbitraryGetHeaders =-    GetHeaders <$> arbitrary-               <*> listOf1 arbitraryBlockHash-               <*> arbitraryBlockHash---- | Arbitrary 'Headers' object with at least one block header.-arbitraryHeaders :: Gen Headers-arbitraryHeaders =-    Headers <$> listOf1 ((,) <$> arbitraryBlockHeader <*> arbitraryVarInt)---- | Arbitrary 'MerkleBlock' with at least one hash.-arbitraryMerkleBlock :: Gen MerkleBlock-arbitraryMerkleBlock = do-    bh     <- arbitraryBlockHeader-    ntx    <- arbitrary-    hashes <- listOf1 arbitraryHash256-    c      <- choose (1,10)-    flags  <- vectorOf (c*8) arbitrary-    return $ MerkleBlock bh ntx hashes flags-
− test/Haskoin/Test/Crypto.hs 
@@ -1,33 +0,0 @@-{-|-Module      : Haskoin.Test.Crypto-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--}-module Haskoin.Test.Crypto where--import           Haskoin.Crypto.Hash-import           Haskoin.Test.Util-import           Test.QuickCheck---- | Arbitrary 160-bit hash.-arbitraryHash160 :: Gen Hash160-arbitraryHash160 =-    ripemd160 <$> arbitraryBSn 20---- | Arbitrary 256-bit hash.-arbitraryHash256 :: Gen Hash256-arbitraryHash256 =-    sha256 <$> arbitraryBSn 32---- | Arbitrary 512-bit hash.-arbitraryHash512 :: Gen Hash512-arbitraryHash512 =-    sha512 <$> arbitraryBSn 64---- | Arbitrary 32-bit checksum.-arbitraryCheckSum32 :: Gen CheckSum32-arbitraryCheckSum32 =-    checkSum32 <$> arbitraryBSn 4
− test/Haskoin/Test/Keys.hs 
@@ -1,85 +0,0 @@-{-|-Module      : Haskoin.Test.Keys-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--}-module Haskoin.Test.Keys where--import           Data.Bits             (clearBit)-import           Data.List             (foldl')-import           Data.Word             (Word32)-import           Haskoin.Crypto-import           Haskoin.Keys.Common-import           Haskoin.Keys.Extended-import           Haskoin.Test.Crypto-import           Test.QuickCheck---- | Arbitrary private key with arbitrary compressed flag.-arbitrarySecKeyI :: Gen SecKeyI-arbitrarySecKeyI = wrapSecKey <$> arbitrary <*> arbitrary---- | Arbitrary keypair, both either compressed or not.-arbitraryKeyPair :: Gen (SecKeyI, PubKeyI)-arbitraryKeyPair = do-    k <- arbitrarySecKeyI-    return (k, derivePubKeyI k)---- | Arbitrary extended private key.-arbitraryXPrvKey :: Gen XPrvKey-arbitraryXPrvKey =-    XPrvKey <$> arbitrary-            <*> arbitrary-            <*> arbitrary-            <*> arbitraryHash256-            <*> arbitrary---- | Arbitrary extended public key with its corresponding private key.-arbitraryXPubKey :: Gen (XPrvKey, XPubKey)-arbitraryXPubKey = (\k -> (k, deriveXPubKey k)) <$> arbitraryXPrvKey--{- Custom derivations -}---- | Arbitrary derivation index with last bit unset.-genIndex :: Gen Word32-genIndex = (`clearBit` 31) <$> arbitrary---- | Arbitrary BIP-32 path index. Can be hardened or not.-arbitraryBip32PathIndex :: Gen Bip32PathIndex-arbitraryBip32PathIndex =-    oneof [ Bip32SoftIndex <$> genIndex-          , Bip32HardIndex <$> genIndex-          ]---- | Arbitrary BIP-32 derivation path composed of only hardened derivations.-arbitraryHardPath :: Gen HardPath-arbitraryHardPath = foldl' (:|) Deriv <$> listOf genIndex---- | Arbitrary BIP-32 derivation path composed of only non-hardened derivations.-arbitrarySoftPath :: Gen SoftPath-arbitrarySoftPath = foldl' (:/) Deriv <$> listOf genIndex---- | Arbitrary derivation path composed of hardened and non-hardened derivations.-arbitraryDerivPath :: Gen DerivPath-arbitraryDerivPath = concatBip32Segments <$> listOf arbitraryBip32PathIndex---- | Arbitrary parsed derivation path. Can contain 'ParsedPrv', 'ParsedPub' or--- 'ParsedEmpty' elements.-arbitraryParsedPath :: Gen ParsedPath-arbitraryParsedPath =-    oneof [ ParsedPrv <$> arbitraryDerivPath-          , ParsedPub <$> arbitraryDerivPath-          , ParsedEmpty <$> arbitraryDerivPath-          ]---- | Arbitrary message hash, private key, nonce and corresponding signature. The--- signature is generated with a random message, random private key and a random--- nonce.-arbitrarySignature :: Gen (Hash256, SecKey, Sig)-arbitrarySignature = do-    m <- arbitraryHash256-    key <- arbitrary-    let sig = signHash key m-    return (m, key, sig)
− test/Haskoin/Test/Message.hs 
@@ -1,52 +0,0 @@-{-|-Module      : Haskoin.Test.Message-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--}-module Haskoin.Test.Message where--import           Haskoin.Constants-import           Haskoin.Network.Message-import           Haskoin.Test.Block-import           Haskoin.Test.Crypto-import           Haskoin.Test.Network-import           Haskoin.Test.Transaction-import           Test.QuickCheck---- | Arbitrary 'MessageHeader'.-arbitraryMessageHeader :: Gen MessageHeader-arbitraryMessageHeader =-    MessageHeader <$> arbitrary-                  <*> arbitraryMessageCommand-                  <*> arbitrary-                  <*> arbitraryCheckSum32---- | Arbitrary 'Message'.-arbitraryMessage :: Network -> Gen Message-arbitraryMessage net =-    oneof-        [ MVersion <$> arbitraryVersion-        , return MVerAck-        , MAddr <$> arbitraryAddr1-        , MInv <$> arbitraryInv1-        , MGetData <$> arbitraryGetData-        , MNotFound <$> arbitraryNotFound-        , MGetBlocks <$> arbitraryGetBlocks-        , MGetHeaders <$> arbitraryGetHeaders-        , MTx <$> arbitraryTx net-        , MBlock <$> arbitraryBlock net-        , MMerkleBlock <$> arbitraryMerkleBlock-        , MHeaders <$> arbitraryHeaders-        , return MGetAddr-        , MFilterLoad <$> arbitraryFilterLoad-        , MFilterAdd <$> arbitraryFilterAdd-        , return MFilterClear-        , MPing <$> arbitraryPing-        , MPong <$> arbitraryPong-        , MAlert <$> arbitraryAlert-        , MReject <$> arbitraryReject-        , return MSendHeaders-        ]
− test/Haskoin/Test/Network.hs 
@@ -1,178 +0,0 @@-{-|-Module      : Haskoin.Test.Network-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--}-module Haskoin.Test.Network where--import qualified Data.ByteString       as BS (empty, pack)-import qualified Data.ByteString.Char8 as C8-import           Data.Word             (Word16, Word32)-import           Haskoin.Network-import           Haskoin.Test.Crypto-import           Haskoin.Test.Util-import           Network.Socket        (SockAddr (..))-import           Test.QuickCheck---- | Arbitrary 'VarInt'.-arbitraryVarInt :: Gen VarInt-arbitraryVarInt = VarInt <$> arbitrary---- | Arbitrary 'VarString'.-arbitraryVarString :: Gen VarString-arbitraryVarString = VarString <$> arbitraryBS---- | Arbitrary 'NetworkAddress'.-arbitraryNetworkAddress :: Gen NetworkAddress-arbitraryNetworkAddress = do-    s <- arbitrary-    a <- arbitrary-    p <- arbitrary-    d <- oneof-        [ do-            b <- arbitrary-            c <- arbitrary-            d <- arbitrary-            return $ SockAddrInet6 (fromIntegral p) 0 (a,b,c,d) 0-        , return $ SockAddrInet (fromIntegral (p :: Word16)) a-        ]-    let n = sockToHostAddress d-    return $ NetworkAddress s n---- | Arbitrary 'NetworkAddressTime'.-arbitraryNetworkAddressTime :: Gen (Word32, NetworkAddress)-arbitraryNetworkAddressTime = (,) <$> arbitrary <*> arbitraryNetworkAddress---- | Arbitrary 'InvType'.-arbitraryInvType :: Gen InvType-arbitraryInvType = elements [InvError, InvTx, InvBlock, InvMerkleBlock]---- | Arbitrary 'InvVector'.-arbitraryInvVector :: Gen InvVector-arbitraryInvVector = InvVector <$> arbitraryInvType <*> arbitraryHash256---- | Arbitrary non-empty 'Inv'.-arbitraryInv1 :: Gen Inv-arbitraryInv1 = Inv <$> listOf1 arbitraryInvVector---- | Arbitrary 'Version'.-arbitraryVersion :: Gen Version-arbitraryVersion =-    Version <$> arbitrary-            <*> arbitrary-            <*> arbitrary-            <*> arbitraryNetworkAddress-            <*> arbitraryNetworkAddress-            <*> arbitrary-            <*> arbitraryVarString-            <*> arbitrary-            <*> arbitrary---- | Arbitrary non-empty 'Addr'.-arbitraryAddr1 :: Gen Addr-arbitraryAddr1 = Addr <$> listOf1 arbitraryNetworkAddressTime---- | Arbitrary 'Alert' with random payload and signature. Signature is not--- valid.-arbitraryAlert :: Gen Alert-arbitraryAlert = Alert <$> arbitraryVarString <*> arbitraryVarString---- | Arbitrary 'Reject'.-arbitraryReject :: Gen Reject-arbitraryReject = do-    m <- arbitraryMessageCommand-    c <- arbitraryRejectCode-    s <- arbitraryVarString-    d <- oneof [ return BS.empty-               , BS.pack <$> vectorOf 32 arbitrary-               ]-    return $ Reject m c s d---- | Arbitrary 'RejectCode'.-arbitraryRejectCode :: Gen RejectCode-arbitraryRejectCode =-    elements-        [ RejectMalformed-        , RejectInvalid-        , RejectInvalid-        , RejectDuplicate-        , RejectNonStandard-        , RejectDust-        , RejectInsufficientFee-        , RejectCheckpoint-        ]---- | Arbitrary non-empty 'GetData'.-arbitraryGetData :: Gen GetData-arbitraryGetData = GetData <$> listOf1 arbitraryInvVector---- | Arbitrary 'NotFound'.-arbitraryNotFound :: Gen NotFound-arbitraryNotFound = NotFound <$> listOf1 arbitraryInvVector---- | Arbitrary 'Ping'.-arbitraryPing :: Gen Ping-arbitraryPing = Ping <$> arbitrary---- | Arbitrary 'Pong'.-arbitraryPong :: Gen Pong-arbitraryPong = Pong <$> arbitrary---- | Arbitrary bloom filter flags.-arbitraryBloomFlags :: Gen BloomFlags-arbitraryBloomFlags =-    elements-        [ BloomUpdateNone-        , BloomUpdateAll-        , BloomUpdateP2PubKeyOnly-        ]---- | Arbitrary bloom filter with its corresponding number of elements--- and false positive rate.-arbitraryBloomFilter :: Gen (Int, Double, BloomFilter)-arbitraryBloomFilter = do-    n     <- choose (0,100000)-    fp    <- choose (1e-8,1)-    tweak <- arbitrary-    fl    <- arbitraryBloomFlags-    return (n, fp, bloomCreate n fp tweak fl)---- | Arbitrary 'FilterLoad'.-arbitraryFilterLoad :: Gen FilterLoad-arbitraryFilterLoad = do-    (_, _, bf) <- arbitraryBloomFilter-    return $ FilterLoad bf---- | Arbitrary 'FilterAdd'.-arbitraryFilterAdd :: Gen FilterAdd-arbitraryFilterAdd = FilterAdd <$> arbitraryBS---- | Arbitrary 'MessageCommand'.-arbitraryMessageCommand :: Gen MessageCommand-arbitraryMessageCommand = do-    ASCIIString str <- arbitrary-    elements-        [ MCVersion-        , MCVerAck-        , MCAddr-        , MCInv-        , MCGetData-        , MCNotFound-        , MCGetBlocks-        , MCGetHeaders-        , MCTx-        , MCBlock-        , MCMerkleBlock-        , MCHeaders-        , MCGetAddr-        , MCFilterLoad-        , MCFilterAdd-        , MCFilterClear-        , MCPing-        , MCPong-        , MCAlert-        , MCOther (C8.take 12 (C8.pack (filter (/= '\NUL') str)))-        ]
− test/Haskoin/Test/Script.hs 
@@ -1,379 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-|-Module      : Haskoin.Test.Script-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--}-module Haskoin.Test.Script where--import           Crypto.Secp256k1-import           Data.Maybe-import           Data.Word-import           Haskoin.Address-import           Haskoin.Constants-import           Haskoin.Keys.Common-import           Haskoin.Script-import           Haskoin.Test.Address-import           Haskoin.Test.Crypto-import           Haskoin.Test.Keys-import           Haskoin.Test.Util-import           Haskoin.Transaction.Common-import           Haskoin.Util-import           Test.QuickCheck---- | Arbitrary 'Script' with random script ops.-arbitraryScript :: Gen Script-arbitraryScript = Script <$> listOf arbitraryScriptOp---- | Arbitrary 'ScriptOp' (push operations have random data).-arbitraryScriptOp :: Gen ScriptOp-arbitraryScriptOp =-    oneof-          -- Pushing Data-        [ opPushData <$> arbitraryBS1-        , return OP_0-        , return OP_1NEGATE-        , return OP_RESERVED-        , return OP_1-        , return OP_2-        , return OP_3-        , return OP_4-        , return OP_5-        , return OP_6-        , return OP_7-        , return OP_8-        , return OP_9-        , return OP_10-        , return OP_11-        , return OP_12-        , return OP_13-        , return OP_14-        , return OP_15-        , return OP_16-        -- Flow control-        , return OP_NOP-        , return OP_VER-        , return OP_IF-        , return OP_NOTIF-        , return OP_VERIF-        , return OP_VERNOTIF-        , return OP_ELSE-        , return OP_ENDIF-        , return OP_VERIFY-        , return OP_RETURN-        -- Stack operations-        , return OP_TOALTSTACK-        , return OP_FROMALTSTACK-        , return OP_IFDUP-        , return OP_DEPTH-        , return OP_DROP-        , return OP_DUP-        , return OP_NIP-        , return OP_OVER-        , return OP_PICK-        , return OP_ROLL-        , return OP_ROT-        , return OP_SWAP-        , return OP_TUCK-        , return OP_2DROP-        , return OP_2DUP-        , return OP_3DUP-        , return OP_2OVER-        , return OP_2ROT-        , return OP_2SWAP-        -- Splice-        , return OP_CAT-        , return OP_SUBSTR-        , return OP_LEFT-        , return OP_RIGHT-        , return OP_SIZE-        -- Bitwise logic-        , return OP_INVERT-        , return OP_AND-        , return OP_OR-        , return OP_XOR-        , return OP_EQUAL-        , return OP_EQUALVERIFY-        , return OP_RESERVED1-        , return OP_RESERVED2-        -- Arithmetic-        , return OP_1ADD-        , return OP_1SUB-        , return OP_2MUL-        , return OP_2DIV-        , return OP_NEGATE-        , return OP_ABS-        , return OP_NOT-        , return OP_0NOTEQUAL-        , return OP_ADD-        , return OP_SUB-        , return OP_MUL-        , return OP_DIV-        , return OP_MOD-        , return OP_LSHIFT-        , return OP_RSHIFT-        , return OP_BOOLAND-        , return OP_BOOLOR-        , return OP_NUMEQUAL-        , return OP_NUMEQUALVERIFY-        , return OP_NUMNOTEQUAL-        , return OP_LESSTHAN-        , return OP_GREATERTHAN-        , return OP_LESSTHANOREQUAL-        , return OP_GREATERTHANOREQUAL-        , return OP_MIN-        , return OP_MAX-        , return OP_WITHIN-        -- Crypto-        , return OP_RIPEMD160-        , return OP_SHA1-        , return OP_SHA256-        , return OP_HASH160-        , return OP_HASH256-        , return OP_CODESEPARATOR-        , return OP_CHECKSIG-        , return OP_CHECKSIGVERIFY-        , return OP_CHECKMULTISIG-        , return OP_CHECKMULTISIGVERIFY-        -- Expansion-        , return OP_NOP1-        , return OP_NOP2-        , return OP_NOP3-        , return OP_NOP4-        , return OP_NOP5-        , return OP_NOP6-        , return OP_NOP7-        , return OP_NOP8-        , return OP_NOP9-        , return OP_NOP10-        -- Bitcoin Cash Nov 2018 hard fork-        , return OP_CHECKDATASIG-        , return OP_CHECKDATASIGVERIFY-        -- Bitcoin Cash May 2020 hard fork-        , return OP_REVERSEBYTES-        -- Other-        , return OP_PUBKEYHASH-        , return OP_PUBKEY-        , return $ OP_INVALIDOPCODE 0xff-        ]---- | Arbtirary 'ScriptOp' with a value in @[OP_1 .. OP_16]@.-arbitraryIntScriptOp :: Gen ScriptOp-arbitraryIntScriptOp =-    elements-        [ OP_1,  OP_2,  OP_3,  OP_4-        , OP_5,  OP_6,  OP_7,  OP_8-        , OP_9,  OP_10, OP_11, OP_12-        , OP_13, OP_14, OP_15, OP_16-        ]---- | Arbitrary 'PushDataType'.-arbitraryPushDataType :: Gen PushDataType-arbitraryPushDataType = elements [OPCODE, OPDATA1, OPDATA2, OPDATA4]---- | Arbitrary 'SigHash' (including invalid/unknown sighash codes).-arbitrarySigHash :: Gen SigHash-arbitrarySigHash = fromIntegral <$> (arbitrary :: Gen Word32)---- | Arbitrary valid 'SigHash'.-arbitraryValidSigHash :: Network -> Gen SigHash-arbitraryValidSigHash net = do-    sh <- elements [sigHashAll, sigHashNone, sigHashSingle]-    f1 <--        elements $-        if isJust (getSigHashForkId net)-            then [id, setForkIdFlag]-            else [id]-    f2 <- elements [id, setAnyoneCanPayFlag]-    return $ f1 $ f2 sh---- | Arbitrary message hash, private key and corresponding 'TxSignature'. The--- signature is generated deterministically using a random message and a random--- private key.-arbitraryTxSignature :: Network -> Gen (TxHash, SecKey, TxSignature)-arbitraryTxSignature net = do-    (m, key, sig) <- arbitrarySignature-    sh <- (fromIntegral <$> (arbitrary :: Gen Word8)) `suchThat` filterBad-    let txsig = TxSignature sig sh-    return (TxHash m, key, txsig)-  where-    filterBad sh = not $-        isSigHashUnknown sh ||-        isNothing (getSigHashForkId net) && hasForkIdFlag sh---- | Arbitrary transaction signature that could also be empty.-arbitraryTxSignatureEmpty :: Network -> Gen TxSignature-arbitraryTxSignatureEmpty net =-    frequency [ (1, return TxSignatureEmpty)-              , (10, lst3 <$> arbitraryTxSignature net)-              ]---- | Arbitrary m of n parameters.-arbitraryMSParam :: Gen (Int, Int)-arbitraryMSParam = do-    m <- choose (1,16)-    n <- choose (m,16)-    return (m, n)---- | Arbitrary 'ScriptOutput' (Can by any valid type).-arbitraryScriptOutput :: Network -> Gen ScriptOutput-arbitraryScriptOutput net =-    oneof $-    [ arbitraryPKOutput-    , arbitraryPKHashOutput-    , arbitraryMSOutput-    , arbitrarySHOutput-    , arbitraryDCOutput-    ] ++-    if getSegWit net-        then [arbitraryWPKHashOutput, arbitraryWSHOutput]-        else []---- | Arbitrary 'ScriptOutput' of type 'PayPK', 'PayPKHash' or 'PayMS'--- (Not 'PayScriptHash', 'DataCarrier', or SegWit)-arbitrarySimpleOutput :: Gen ScriptOutput-arbitrarySimpleOutput =-    oneof-        [ arbitraryPKOutput-        , arbitraryPKHashOutput-        , arbitraryMSOutput-        ]---- | Arbitrary 'ScriptOutput' of type 'PayPK'-arbitraryPKOutput :: Gen ScriptOutput-arbitraryPKOutput =  PayPK . snd <$> arbitraryKeyPair---- | Arbitrary 'ScriptOutput' of type 'PayPKHash'-arbitraryPKHashOutput :: Gen ScriptOutput-arbitraryPKHashOutput = PayPKHash <$> arbitraryHash160---- | Arbitrary 'PayWitnessPKHash' output.-arbitraryWPKHashOutput :: Gen ScriptOutput-arbitraryWPKHashOutput = PayWitnessPKHash <$> arbitraryHash160---- | Arbitrary 'PayWitnessScriptHash' output.-arbitraryWSHOutput :: Gen ScriptOutput-arbitraryWSHOutput = PayWitnessScriptHash <$> arbitraryHash256---- | Arbitrary 'ScriptOutput' of type 'PayMS'.-arbitraryMSOutput :: Gen ScriptOutput-arbitraryMSOutput = do-    (m, n) <- arbitraryMSParam-    keys <- map snd <$> vectorOf n arbitraryKeyPair-    return $ PayMulSig keys m---- | Arbitrary 'ScriptOutput' of type 'PayMS', only using compressed keys.-arbitraryMSOutputC :: Gen ScriptOutput-arbitraryMSOutputC = do-    (m, n) <- arbitraryMSParam-    keys <--        map snd <$>-        vectorOf n (arbitraryKeyPair `suchThat` (pubKeyCompressed . snd))-    return $ PayMulSig keys m---- | Arbitrary 'ScriptOutput' of type 'PayScriptHash'.-arbitrarySHOutput :: Gen ScriptOutput-arbitrarySHOutput = PayScriptHash . getAddrHash160 <$> arbitraryScriptAddress---- | Arbitrary 'ScriptOutput' of type 'DataCarrier'.-arbitraryDCOutput :: Gen ScriptOutput-arbitraryDCOutput = DataCarrier <$> arbitraryBS1---- | Arbitrary 'ScriptInput'.-arbitraryScriptInput :: Network -> Gen ScriptInput-arbitraryScriptInput net =-    oneof-        [ arbitraryPKInput net-        , arbitraryPKHashInput net-        , arbitraryMSInput net-        , arbitrarySHInput net-        ]---- | Arbitrary 'ScriptInput' of type 'SpendPK', 'SpendPKHash' or 'SpendMulSig'--- (not 'ScriptHashInput')-arbitrarySimpleInput :: Network -> Gen ScriptInput-arbitrarySimpleInput net =-    oneof-        [ arbitraryPKInput net-        , arbitraryPKHashInput net-        , arbitraryMSInput net-        ]---- | Arbitrary 'ScriptInput' of type 'SpendPK'.-arbitraryPKInput :: Network -> Gen ScriptInput-arbitraryPKInput net = RegularInput . SpendPK <$> arbitraryTxSignatureEmpty net---- | Arbitrary 'ScriptInput' of type 'SpendPK'.-arbitraryPKHashInput :: Network -> Gen ScriptInput-arbitraryPKHashInput net = do-    sig <- arbitraryTxSignatureEmpty net-    key <- snd <$> arbitraryKeyPair-    return $ RegularInput $ SpendPKHash sig key---- | Like 'arbitraryPKHashInput' without empty signatures.-arbitraryPKHashInputFull :: Network -> Gen ScriptInput-arbitraryPKHashInputFull net = do-    sig <- lst3 <$> arbitraryTxSignature net-    key <- snd <$> arbitraryKeyPair-    return $ RegularInput $ SpendPKHash sig key---- | Like above but only compressed.-arbitraryPKHashInputFullC :: Network -> Gen ScriptInput-arbitraryPKHashInputFullC net = do-    sig <- lst3 <$> arbitraryTxSignature net-    key <- fmap snd $ arbitraryKeyPair `suchThat` (pubKeyCompressed . snd)-    return $ RegularInput $ SpendPKHash sig key---- | Arbitrary 'ScriptInput' of type 'SpendMulSig'.-arbitraryMSInput :: Network -> Gen ScriptInput-arbitraryMSInput net = do-    m    <- fst <$> arbitraryMSParam-    sigs <- vectorOf m (arbitraryTxSignatureEmpty net)-    return $ RegularInput $ SpendMulSig sigs---- | Arbitrary 'ScriptInput' of type 'ScriptHashInput'.-arbitrarySHInput :: Network -> Gen ScriptInput-arbitrarySHInput net = do-    i <- arbitrarySimpleInput net-    ScriptHashInput (getRegularInput i) <$> arbitrarySimpleOutput---- | Arbitrary 'ScriptInput' of type 'ScriptHashInput' containing a--- 'RedeemScript' of type 'PayMulSig' and an input of type 'SpendMulSig'.-arbitraryMulSigSHInput :: Network -> Gen ScriptInput-arbitraryMulSigSHInput net =-    arbitraryMSOutput >>= \case-        rdm@(PayMulSig _ m) -> do-            sigs <- vectorOf m (arbitraryTxSignatureEmpty net)-            return $ ScriptHashInput (SpendMulSig sigs) rdm-        _ -> undefined---- | Arbitrary 'ScriptInput' of type 'ScriptHashInput' containing a--- 'RedeemScript' of type 'PayMulSig' and an input of type 'SpendMulSig'.-arbitraryMulSigSHInputC :: Network -> Gen ScriptInput-arbitraryMulSigSHInputC net =-    arbitraryMSOutputC >>= \case-        rdm@(PayMulSig _ m) -> do-          sigs <- vectorOf m (arbitraryTxSignatureEmpty net)-          return $ ScriptHashInput (SpendMulSig sigs) rdm-        _ -> undefined---- | Like 'arbitraryMulSigSHCInput' with no empty signatures.-arbitraryMulSigSHInputFull :: Network -> Gen ScriptInput-arbitraryMulSigSHInputFull net =-    arbitraryMSOutput >>= \case-        rdm@(PayMulSig _ m) -> do-            sigs <- map lst3 <$> vectorOf m (arbitraryTxSignature net)-            return $ ScriptHashInput (SpendMulSig sigs) rdm-        _ -> undefined---- | Like 'arbitraryMulSigSHCInput' with no empty signatures.-arbitraryMulSigSHInputFullC :: Network -> Gen ScriptInput-arbitraryMulSigSHInputFullC net =-    arbitraryMSOutputC >>= \case-        rdm@(PayMulSig _ m) -> do-            sigs <- map lst3 <$> vectorOf m (arbitraryTxSignature net)-            return $ ScriptHashInput (SpendMulSig sigs) rdm-        _ -> undefined
− test/Haskoin/Test/Transaction.hs 
@@ -1,278 +0,0 @@-{-|-Module      : Haskoin.Test.Transaction-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--}-module Haskoin.Test.Transaction where--import           Control.Monad-import qualified Data.ByteString     as BS-import           Data.Either         (fromRight)-import           Data.List           (nub, nubBy, permutations)-import           Data.Word           (Word64)-import           Haskoin.Address-import           Haskoin.Constants-import           Haskoin.Keys.Common-import           Haskoin.Script-import           Haskoin.Test.Crypto-import           Haskoin.Test.Keys-import           Haskoin.Test.Script-import           Haskoin.Test.Util-import           Haskoin.Transaction-import           Test.QuickCheck---- | Wrapped coin value for testing.-newtype TestCoin = TestCoin { getTestCoin :: Word64 }-    deriving (Eq, Show)--instance Coin TestCoin where-    coinValue = getTestCoin---- | Arbitrary transaction hash (for non-existent transaction).-arbitraryTxHash :: Gen TxHash-arbitraryTxHash = TxHash <$> arbitraryHash256---- | Arbitrary amount of Satoshi as 'Word64' (Between 1 and 21e14)-arbitrarySatoshi :: Network -> Gen TestCoin-arbitrarySatoshi net = TestCoin <$> choose (1, getMaxSatoshi net)---- | Arbitrary 'OutPoint'.-arbitraryOutPoint :: Gen OutPoint-arbitraryOutPoint = OutPoint <$> arbitraryTxHash <*> arbitrary---- | Arbitrary 'TxOut'.-arbitraryTxOut :: Network -> Gen TxOut-arbitraryTxOut net =-    TxOut <$> (getTestCoin <$> arbitrarySatoshi net)-          <*> (encodeOutputBS <$> arbitraryScriptOutput net)---- | Arbitrary 'TxIn'.-arbitraryTxIn :: Network -> Gen TxIn-arbitraryTxIn net =-    TxIn <$> arbitraryOutPoint-         <*> (encodeInputBS <$> arbitraryScriptInput net)-         <*> arbitrary---- | Arbitrary transaction. Can be regular or with witnesses.-arbitraryTx :: Network -> Gen Tx-arbitraryTx net = oneof [arbitraryLegacyTx net, arbitraryWitnessTx net]---- | Arbitrary regular transaction.-arbitraryLegacyTx :: Network -> Gen Tx-arbitraryLegacyTx net = arbitraryWLTx net False---- | Arbitrary witness transaction (witness data is fake).-arbitraryWitnessTx :: Network -> Gen Tx-arbitraryWitnessTx net = arbitraryWLTx net True---- | Arbitrary witness or legacy transaction.-arbitraryWLTx :: Network -> Bool -> Gen Tx-arbitraryWLTx net wit = do-    ni <- choose (0, 5)-    no <--        if wit-            then choose (0, 5)-            else choose-                     ( if ni == 0-                           then 2-                           else 0-                     , 5 -- avoid witness case-                      )-    inps <- vectorOf ni (arbitraryTxIn net)-    outs <- vectorOf no (arbitraryTxOut net)-    let uniqueInps = nubBy (\a b -> prevOutput a == prevOutput b) inps-    w <--        if wit-            then vectorOf (length uniqueInps) (listOf arbitraryBS)-            else return []-    Tx <$> arbitrary <*> pure uniqueInps <*> pure outs <*> pure w <*> arbitrary---- | Arbitrary transaction containing only inputs of type 'SpendPKHash',--- 'SpendScriptHash' (multisig) and outputs of type 'PayPKHash' and 'PaySH'.--- Only compressed public keys are used.-arbitraryAddrOnlyTx :: Network -> Gen Tx-arbitraryAddrOnlyTx net = do-    ni <- choose (0, 5)-    no <- choose (0, 5)-    inps <- vectorOf ni (arbitraryAddrOnlyTxIn net)-    outs <- vectorOf no (arbitraryAddrOnlyTxOut net)-    Tx <$> arbitrary <*> pure inps <*> pure outs <*> pure [] <*> arbitrary---- | Like 'arbitraryAddrOnlyTx' without empty signatures in the inputs.-arbitraryAddrOnlyTxFull :: Network -> Gen Tx-arbitraryAddrOnlyTxFull net = do-    ni <- choose (0, 5)-    no <- choose (0, 5)-    inps <- vectorOf ni (arbitraryAddrOnlyTxInFull net)-    outs <- vectorOf no (arbitraryAddrOnlyTxOut net)-    Tx <$> arbitrary <*> pure inps <*> pure outs <*> pure [] <*> arbitrary---- | Arbitrary TxIn that can only be of type 'SpendPKHash' or 'SpendScriptHash'--- (multisig). Only compressed public keys are used.-arbitraryAddrOnlyTxIn :: Network -> Gen TxIn-arbitraryAddrOnlyTxIn net = do-    inp <- oneof [arbitraryPKHashInput net, arbitraryMulSigSHInput net]-    TxIn <$> arbitraryOutPoint <*> pure (encodeInputBS inp) <*> arbitrary---- | like 'arbitraryAddrOnlyTxIn' with no empty signatures.-arbitraryAddrOnlyTxInFull :: Network -> Gen TxIn-arbitraryAddrOnlyTxInFull net = do-    inp <--        oneof [arbitraryPKHashInputFullC net, arbitraryMulSigSHInputFullC net]-    TxIn <$> arbitraryOutPoint <*> pure (encodeInputBS inp) <*> arbitrary---- | Arbitrary 'TxOut' that can only be of type 'PayPKHash' or 'PaySH'.-arbitraryAddrOnlyTxOut :: Network -> Gen TxOut-arbitraryAddrOnlyTxOut net = do-    v <- getTestCoin <$> arbitrarySatoshi net-    out <- oneof [arbitraryPKHashOutput, arbitrarySHOutput]-    return $ TxOut v $ encodeOutputBS out---- | Arbitrary 'SigInput' with the corresponding private keys used--- to generate the 'ScriptOutput' or 'RedeemScript'.-arbitrarySigInput :: Network -> Gen (SigInput, [SecKeyI])-arbitrarySigInput net =-    oneof-        [ wrapKey <$> arbitraryPKSigInput net-        , wrapKey <$> arbitraryPKHashSigInput net-        , arbitraryMSSigInput net-        , arbitrarySHSigInput net-        , wrapKey <$> arbitraryWPKHSigInput net-        , arbitraryWSHSigInput net-        ]---- | Arbitrary 'SigInput' with a 'ScriptOutput' of type 'PayPK'.-arbitraryPKSigInput :: Network -> Gen (SigInput, SecKeyI)-arbitraryPKSigInput net = arbitraryAnyInput net False---- | Arbitrary 'SigInput' with a 'ScriptOutput' of type 'PayPKHash'.-arbitraryPKHashSigInput :: Network -> Gen (SigInput, SecKeyI)-arbitraryPKHashSigInput net = arbitraryAnyInput net True---- | Arbitrary 'SigInput'.-arbitraryAnyInput :: Network -> Bool -> Gen (SigInput, SecKeyI)-arbitraryAnyInput net pkh = do-    (k, p) <- arbitraryKeyPair-    let out | pkh = PayPKHash $ getAddrHash160 $ pubKeyAddr p-            | otherwise = PayPK p-    (val, op, sh) <- arbitraryInputStuff net-    return (SigInput out val op sh Nothing, k)---- | Arbitrary value, out point and sighash for an input.-arbitraryInputStuff :: Network -> Gen (Word64, OutPoint, SigHash)-arbitraryInputStuff net = do-    val <- getTestCoin <$> arbitrarySatoshi net-    op <- arbitraryOutPoint-    sh <- arbitraryValidSigHash net-    return (val, op, sh)---- | Arbitrary 'SigInput' with a 'ScriptOutput' of type 'PayMulSig'.-arbitraryMSSigInput :: Network -> Gen (SigInput, [SecKeyI])-arbitraryMSSigInput net = do-    (m, n) <- arbitraryMSParam-    ks <- vectorOf n arbitraryKeyPair-    let out = PayMulSig (map snd ks) m-    (val, op, sh) <- arbitraryInputStuff net-    perm <- choose (0, n - 1)-    let ksPerm = map fst $ take m $ permutations ks !! perm-    return (SigInput out val op sh Nothing, ksPerm)---- | Arbitrary 'SigInput' with 'ScriptOutput' of type 'PaySH' and a--- 'RedeemScript'.-arbitrarySHSigInput :: Network -> Gen (SigInput, [SecKeyI])-arbitrarySHSigInput net = do-    (SigInput rdm val op sh _, ks) <- oneof-        [ wrapKey <$> arbitraryPKSigInput net-        , wrapKey <$> arbitraryPKHashSigInput net-        , arbitraryMSSigInput net-        ]-    let out = PayScriptHash $ getAddrHash160 $ payToScriptAddress rdm-    return (SigInput out val op sh $ Just rdm, ks)--arbitraryWPKHSigInput :: Network -> Gen (SigInput, SecKeyI)-arbitraryWPKHSigInput net = do-    (k, p) <- arbitraryKeyPair-    (val, op, sh) <- arbitraryInputStuff net-    let out = PayWitnessPKHash . getAddrHash160 $ pubKeyAddr p-    return (SigInput out val op sh Nothing, k)--arbitraryWSHSigInput :: Network -> Gen (SigInput, [SecKeyI])-arbitraryWSHSigInput net = do-    (SigInput rdm val op sh _, ks) <- oneof-        [ wrapKey <$> arbitraryPKSigInput net-        , wrapKey <$> arbitraryPKHashSigInput net-        , arbitraryMSSigInput net-        ]-    let out = PayWitnessScriptHash . getAddrHash256 $ payToWitnessScriptAddress rdm-    return (SigInput out val op sh $ Just rdm, ks)---- | Arbitrary 'Tx' (empty 'TxIn'), 'SigInputs' and private keys that can be--- passed to 'signTx' or 'detSignTx' to fully sign the 'Tx'.-arbitrarySigningData :: Network -> Gen (Tx, [SigInput], [SecKeyI])-arbitrarySigningData net = do-    v <- arbitrary-    ni <- choose (1, 5)-    no <- choose (1, 5)-    sigis <- vectorOf ni (arbitrarySigInput net)-    let uSigis = nubBy (\(a, _) (b, _) -> sigInputOP a == sigInputOP b) sigis-    inps <- forM uSigis $ \(s, _) -> TxIn (sigInputOP s) BS.empty <$> arbitrary-    outs <- vectorOf no (arbitraryTxOut net)-    l <- arbitrary-    perm <- choose (0, length inps - 1)-    let tx = Tx v (permutations inps !! perm) outs [] l-        keys = concatMap snd uSigis-    return (tx, map fst uSigis, keys)---- | Arbitrary transaction with empty inputs.-arbitraryEmptyTx :: Network -> Gen Tx-arbitraryEmptyTx net = do-    v    <- arbitrary-    no   <- choose (1,5)-    ni   <- choose (1,5)-    outs <- vectorOf no (arbitraryTxOut net)-    ops  <- vectorOf ni arbitraryOutPoint-    t    <- arbitrary-    s    <- arbitrary-    return $ Tx v (map (\op -> TxIn op BS.empty s) (nub ops)) outs [] t---- | Arbitrary partially-signed transactions.-arbitraryPartialTxs ::-       Network -> Gen ([Tx], [(ScriptOutput, Word64, OutPoint, Int, Int)])-arbitraryPartialTxs net = do-    tx <- arbitraryEmptyTx net-    res <--        forM (map prevOutput $ txIn tx) $ \op -> do-            (so, val, rdmM, prvs, m, n) <- arbitraryData-            txs <- mapM (singleSig so val rdmM tx op . secKeyData) prvs-            return (txs, (so, val, op, m, n))-    return (concatMap fst res, map snd res)-  where-    singleSig so val rdmM tx op prv = do-        sh <- arbitraryValidSigHash net-        let sigi = SigInput so val op sh rdmM-        return . fromRight (error "Could not decode transaction") $-            signTx net tx [sigi] [prv]-    arbitraryData = do-        (m, n) <- arbitraryMSParam-        val <- getTestCoin <$> arbitrarySatoshi net-        nPrv <- choose (m, n)-        keys <- vectorOf n arbitraryKeyPair-        perm <- choose (0, length keys - 1)-        let pubKeys = map snd keys-            prvKeys = take nPrv $ permutations (map fst keys) !! perm-        let so = PayMulSig pubKeys m-        elements-            [ (so, val, Nothing, prvKeys, m, n)-            , ( PayScriptHash $ getAddrHash160 $ payToScriptAddress so-              , val-              , Just so-              , prvKeys-              , m-              , n)-            ]--wrapKey :: (SigInput, SecKeyI) -> (SigInput, [SecKeyI])-wrapKey (s, k) = (s, [k])
− test/Haskoin/Test/Util.hs 
@@ -1,40 +0,0 @@-{-|-Module      : Haskoin.Test.Util-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--}-module Haskoin.Test.Util where--import           Data.ByteString       (ByteString, pack)-import           Data.Time.Clock       (UTCTime (..))-import           Data.Time.Clock.POSIX (posixSecondsToUTCTime)-import           Data.Word             (Word32)-import           Test.QuickCheck---- | Arbitrary strict 'ByteString'.-arbitraryBS :: Gen ByteString-arbitraryBS = pack <$> arbitrary---- | Arbitrary non-empty strict ByteString-arbitraryBS1 :: Gen ByteString-arbitraryBS1 = pack <$> listOf1 arbitrary---- | Arbitrary strict ByteString of a given length-arbitraryBSn :: Int -> Gen ByteString-arbitraryBSn n = pack <$> vectorOf n arbitrary---- | Arbitrary UTCTime that generates dates after 01 Jan 1970 01:00:00 CET-arbitraryUTCTime :: Gen UTCTime-arbitraryUTCTime = do-    w <- arbitrary :: Gen Word32-    return $ posixSecondsToUTCTime $ realToFrac w---- | Generate a Maybe from a Gen a-arbitraryMaybe :: Gen a -> Gen (Maybe a)-arbitraryMaybe g = frequency [ (1, return Nothing)-                             , (5, Just <$> g)-                             ]-
test/Haskoin/Transaction/PartialSpec.hs view
@@ -19,10 +19,10 @@ import           Haskoin.Crypto import           Haskoin.Keys import           Haskoin.Script-import           Haskoin.Test import           Haskoin.Transaction import           Haskoin.Transaction.Partial import           Haskoin.Util+import           Haskoin.Util.Arbitrary  spec :: Spec spec = describe "partially signed bitcoin transaction unit tests" $ do
test/Haskoin/TransactionSpec.hs view
@@ -14,10 +14,10 @@ import           Haskoin.Constants import           Haskoin.Keys import           Haskoin.Script-import           Haskoin.Test import           Haskoin.Transaction import           Haskoin.Transaction.Segwit (isSegwit) import           Haskoin.Util+import           Haskoin.Util.Arbitrary import           Haskoin.UtilSpec           (cerealID, testJsonID) import           Safe                       (readMay) import           Test.Hspec
test/Haskoin/UtilSpec.hs view
@@ -7,20 +7,20 @@     , customCerealID     ) where -import           Data.Aeson          (FromJSON, ToJSON)-import qualified Data.Aeson          as A-import           Data.Aeson.Encoding (encodingToLazyByteString)-import           Data.Aeson.Types    (Parser, parseMaybe)-import qualified Data.ByteString     as BS-import           Data.Either         (fromLeft, fromRight, isLeft, isRight)-import           Data.Foldable       (toList)-import           Data.List           (permutations)-import           Data.Map.Strict     (singleton)+import           Data.Aeson             (FromJSON, ToJSON)+import qualified Data.Aeson             as A+import           Data.Aeson.Encoding    (encodingToLazyByteString)+import           Data.Aeson.Types       (Parser, parseMaybe)+import qualified Data.ByteString        as BS+import           Data.Either            (fromLeft, fromRight, isLeft, isRight)+import           Data.Foldable          (toList)+import           Data.List              (permutations)+import           Data.Map.Strict        (singleton) import           Data.Maybe-import qualified Data.Sequence       as Seq-import           Data.Serialize      as S-import           Haskoin.Test+import qualified Data.Sequence          as Seq+import           Data.Serialize         as S import           Haskoin.Util+import           Haskoin.Util.Arbitrary import           Test.Hspec import           Test.QuickCheck