haskoin-core-0.15.0: test/Haskoin/TransactionSpec.hs
{-# LANGUAGE OverloadedStrings #-}
module Haskoin.TransactionSpec (spec) where
import qualified Data.ByteString as B
import Data.Either
import Data.Maybe
import Data.Serialize as S
import Data.String (fromString)
import Data.String.Conversions
import Data.Text (Text)
import Data.Word (Word32, Word64)
import Haskoin.Address
import Haskoin.Constants
import Haskoin.Keys
import Haskoin.Script
import Haskoin.Transaction
import Haskoin.Util
import Haskoin.Util.Arbitrary
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.HUnit
import Test.QuickCheck
serialVals :: [SerialBox]
serialVals =
[ SerialBox $ arbitraryTx =<< arbitraryNetwork
, SerialBox $ arbitraryWitnessTx =<< arbitraryNetwork
, SerialBox $ arbitraryLegacyTx =<< arbitraryNetwork
, SerialBox $ arbitraryTxIn =<< arbitraryNetwork
, SerialBox $ arbitraryTxOut =<< arbitraryNetwork
, SerialBox arbitraryOutPoint
]
readVals :: [ReadBox]
readVals =
[ ReadBox arbitraryTxHash
, ReadBox $ arbitraryTx =<< arbitraryNetwork
, ReadBox $ arbitraryTxIn =<< arbitraryNetwork
, ReadBox $ arbitraryTxOut =<< arbitraryNetwork
, ReadBox arbitraryOutPoint
]
jsonVals :: [JsonBox]
jsonVals =
[ JsonBox arbitraryTxHash
, JsonBox $ arbitraryTx =<< arbitraryNetwork
, JsonBox $ arbitraryWitnessTx =<< arbitraryNetwork
, JsonBox $ arbitraryLegacyTx =<< arbitraryNetwork
, JsonBox $ arbitraryTxIn =<< arbitraryNetwork
, JsonBox $ arbitraryTxOut =<< arbitraryNetwork
, JsonBox arbitraryOutPoint
]
spec :: Spec
spec = do
testIdentity serialVals readVals jsonVals []
describe "Transaction properties" $ do
prop "decode and encode txid" $
forAll arbitraryTxHash $ \h -> hexToTxHash (txHashToHex h) == Just h
prop "from string transaction id" $
forAll arbitraryTxHash $ \h -> fromString (cs $ txHashToHex h) == h
prop "building address tx" $
forAll arbitraryNetwork $ \net ->
forAll arbitraryAddress $
forAll (arbitrarySatoshi net) . testBuildAddrTx net
prop "guess transaction size" $
forAll arbitraryNetwork $ \net ->
forAll (arbitraryAddrOnlyTxFull net) (testGuessSize net)
prop "choose coins" $
forAll arbitraryNetwork $ \net ->
forAll (listOf (arbitrarySatoshi net)) testChooseCoins
prop "choose multisig coins" $
forAll arbitraryNetwork $ \net ->
forAll arbitraryMSParam $
forAll (listOf (arbitrarySatoshi net)) . testChooseMSCoins
prop "sign and validate transaction" $
forAll arbitraryNetwork $ \net ->
forAll (arbitrarySigningData net) (testDetSignTx net)
prop "sign and validate (nested) transaction" $
forAll arbitraryNetwork $ \net ->
forAll (arbitrarySigningData net) (testDetSignNestedTx net)
prop "merge partially signed transactions" $
forAll arbitraryNetwork $ \net ->
property $ forAll (arbitraryPartialTxs net) (testMergeTx net)
describe "Transaction vectors" $ do
it "compute txid from tx" $ mapM_ testTxidVector txidVectors
it "build pkhash transaction (generated from bitcoind)" $
mapM_ testPKHashVector pkHashVectors
-- Txid Vectors
testTxidVector :: (Text, Text) -> Assertion
testTxidVector (tid, tx) =
assertEqual "txid" (Just tid) (txHashToHex . txHash <$> txM)
where
txM = eitherToMaybe . S.decode =<< decodeHex tx
txidVectors :: [(Text, Text)]
txidVectors =
[ ( "23b397edccd3740a74adb603c9756370fafcde9bcc4483eb271ecad09a94dd63"
, "0100000001b14bdcbc3e01bdaad36cc08e81e69c82e1060bc14e518db2b49aa4\
\3ad90ba26000000000490047304402203f16c6f40162ab686621ef3000b04e75\
\418a0c0cb2d8aebeac894ae360ac1e780220ddc15ecdfc3507ac48e1681a33eb\
\60996631bf6bf5bc0a0682c4db743ce7ca2b01ffffffff0140420f0000000000\
\1976a914660d4ef3a743e3e696ad990364e555c271ad504b88ac00000000"
)
, ( "c99c49da4c38af669dea436d3e73780dfdb6c1ecf9958baa52960e8baee30e73"
, "01000000010276b76b07f4935c70acf54fbf1f438a4c397a9fb7e633873c4dd3\
\bc062b6b40000000008c493046022100d23459d03ed7e9511a47d13292d3430a\
\04627de6235b6e51a40f9cd386f2abe3022100e7d25b080f0bb8d8d5f878bba7\
\d54ad2fda650ea8d158a33ee3cbd11768191fd004104b0e2c879e4daf7b9ab68\
\350228c159766676a14f5815084ba166432aab46198d4cca98fa3e9981d0a90b\
\2effc514b76279476550ba3663fdcaff94c38420e9d5000000000100093d0000\
\0000001976a9149a7b0f3b80c6baaeedce0a0842553800f832ba1f88ac000000\
\00"
)
, ( "f7fdd091fa6d8f5e7a8c2458f5c38faffff2d3f1406b6e4fe2c99dcc0d2d1cbb"
, "01000000023d6cf972d4dff9c519eff407ea800361dd0a121de1da8b6f4138a2\
\f25de864b4000000008a4730440220ffda47bfc776bcd269da4832626ac332ad\
\fca6dd835e8ecd83cd1ebe7d709b0e022049cffa1cdc102a0b56e0e04913606c\
\70af702a1149dc3b305ab9439288fee090014104266abb36d66eb4218a6dd31f\
\09bb92cf3cfa803c7ea72c1fc80a50f919273e613f895b855fb7465ccbc8919a\
\d1bd4a306c783f22cd3227327694c4fa4c1c439affffffff21ebc9ba20594737\
\864352e95b727f1a565756f9d365083eb1a8596ec98c97b7010000008a473044\
\0220503ff10e9f1e0de731407a4a245531c9ff17676eda461f8ceeb8c06049fa\
\2c810220c008ac34694510298fa60b3f000df01caa244f165b727d4896eb84f8\
\1e46bcc4014104266abb36d66eb4218a6dd31f09bb92cf3cfa803c7ea72c1fc8\
\0a50f919273e613f895b855fb7465ccbc8919ad1bd4a306c783f22cd32273276\
\94c4fa4c1c439affffffff01f0da5200000000001976a914857ccd42dded6df3\
\2949d4646dfa10a92458cfaa88ac00000000"
)
, ( "afd9c17f8913577ec3509520bd6e5d63e9c0fd2a5f70c787993b097ba6ca9fae"
, "010000000370ac0a1ae588aaf284c308d67ca92c69a39e2db81337e563bf40c5\
\9da0a5cf63000000006a4730440220360d20baff382059040ba9be98947fd678\
\fb08aab2bb0c172efa996fd8ece9b702201b4fb0de67f015c90e7ac8a193aeab\
\486a1f587e0f54d0fb9552ef7f5ce6caec032103579ca2e6d107522f012cd00b\
\52b9a65fb46f0c57b9b8b6e377c48f526a44741affffffff7d815b6447e35fbe\
\a097e00e028fb7dfbad4f3f0987b4734676c84f3fcd0e804010000006b483045\
\022100c714310be1e3a9ff1c5f7cacc65c2d8e781fc3a88ceb063c6153bf9506\
\50802102200b2d0979c76e12bb480da635f192cc8dc6f905380dd4ac1ff35a4f\
\68f462fffd032103579ca2e6d107522f012cd00b52b9a65fb46f0c57b9b8b6e3\
\77c48f526a44741affffffff3f1f097333e4d46d51f5e77b53264db8f7f5d2e1\
\8217e1099957d0f5af7713ee010000006c493046022100b663499ef73273a378\
\8dea342717c2640ac43c5a1cf862c9e09b206fcb3f6bb8022100b09972e75972\
\d9148f2bdd462e5cb69b57c1214b88fc55ca638676c07cfc10d8032103579ca2\
\e6d107522f012cd00b52b9a65fb46f0c57b9b8b6e377c48f526a44741affffff\
\ff0380841e00000000001976a914bfb282c70c4191f45b5a6665cad1682f2c9c\
\fdfb88ac80841e00000000001976a9149857cc07bed33a5cf12b9c5e0500b675\
\d500c81188ace0fd1c00000000001976a91443c52850606c872403c0601e69fa\
\34b26f62db4a88ac00000000"
)
]
-- Build address transactions vectors generated from bitcoin-core raw tx API
testPKHashVector :: ([(Text, Word32)], [(Text, Word64)], Text) -> Assertion
testPKHashVector (is, os, res) =
assertEqual "Build PKHash Tx" (Right res) (encodeHex . S.encode <$> txE)
where
txE = buildAddrTx btc (map f is) os
f (tid, ix) = OutPoint (fromJust $ hexToTxHash tid) ix
pkHashVectors :: [([(Text, Word32)], [(Text, Word64)], Text)]
pkHashVectors =
[ ( [ ( "eb29eba154166f6541ebcc9cbdf5088756e026af051f123bcfb526df594549db"
, 14)
]
, [("14LsRquZfURNFrzpcLVGdaHTfAPjjwiSPb", 90000000)]
, "0100000001db494559df26b5cf3b121f05af26e0568708f5bd9ccceb41656f1654\
\a1eb29eb0e00000000ffffffff01804a5d05000000001976a91424aa604689cc58\
\2292b97668bedd91dd5bf9374c88ac00000000")
, ( [ ( "eb29eba154166f6541ebcc9cbdf5088756e026af051f123bcfb526df594549db"
, 0)
, ( "0001000000000000000000000000000000000000000000000000000000000000"
, 2147483647)
]
, [ ("14LsRquZfURNFrzpcLVGdaHTfAPjjwiSPb", 1)
, ("19VCgS642vzEA1sdByoSn6GsWBwraV8D4n", 2100000000000000)
]
, "0100000002db494559df26b5cf3b121f05af26e0568708f5bd9ccceb41656f1654\
\a1eb29eb0000000000ffffffff0000000000000000000000000000000000000000\
\000000000000000000000100ffffff7f00ffffffff0201000000000000001976a9\
\1424aa604689cc582292b97668bedd91dd5bf9374c88ac0040075af07507001976\
\a9145d16672f53981ff21c5f42b40d1954993cbca54f88ac00000000")
, ( [ ( "eb29eba154166f6541ebcc9cbdf5088756e026af051f123bcfb526df594549db"
, 0)
, ( "0001000000000000000000000000000000000000000000000000000000000000"
, 2147483647)
]
, []
, "0100000002db494559df26b5cf3b121f05af26e0568708f5bd9ccceb41656f1654a\
\1eb29eb0000000000ffffffff000000000000000000000000000000000000000000\
\0000000000000000000100ffffff7f00ffffffff0000000000")
, ( []
, [ ("14LsRquZfURNFrzpcLVGdaHTfAPjjwiSPb", 1)
, ("19VCgS642vzEA1sdByoSn6GsWBwraV8D4n", 2100000000000000)
]
, "01000000000201000000000000001976a91424aa604689cc582292b97668bedd91d\
\d5bf9374c88ac0040075af07507001976a9145d16672f53981ff21c5f42b40d1954\
\993cbca54f88ac00000000")
]
-- Transaction Properties --
testBuildAddrTx :: Network -> Address -> TestCoin -> Bool
testBuildAddrTx net a (TestCoin v)
| isPubKeyAddress a = Right (PayPKHash (getAddrHash160 a)) == out
| isScriptAddress a = Right (PayScriptHash (getAddrHash160 a)) == out
| otherwise = undefined
where
tx = buildAddrTx net [] [(fromJust (addrToText net a), v)]
out =
decodeOutputBS $
scriptOutput $
head $ txOut (fromRight (error "Could not build transaction") tx)
-- We compute an upper bound but it should be close enough to the real size
-- We give 2 bytes of slack on every signature (1 on r and 1 on s)
testGuessSize :: Network -> Tx -> Bool
testGuessSize net tx =
guess >= len && guess <= len + 2 * delta
where
delta = pki + sum (map fst msi)
guess = guessTxSize pki msi pkout msout
len = B.length $ S.encode tx
ins = map f $ txIn tx
f i =
fromRight (error "Could not decode input") $
decodeInputBS net $ scriptInput i
pki = length $ filter isSpendPKHash ins
msi = concatMap shData ins
shData (ScriptHashInput _ (PayMulSig keys r)) = [(r, length keys)]
shData _ = []
out =
map
(fromRight (error "Could not decode transaction output") .
decodeOutputBS . scriptOutput) $
txOut tx
pkout = length $ filter isPayPKHash out
msout = length $ filter isPayScriptHash out
testChooseCoins :: [TestCoin] -> Word64 -> Word64 -> Int -> Property
testChooseCoins coins target byteFee nOut = nOut >= 0 ==>
case chooseCoins target byteFee nOut True coins of
Right (chosen, change) ->
let outSum = sum $ map coinValue chosen
fee = guessTxFee byteFee nOut (length chosen)
in outSum == target + change + fee
Left _ ->
let fee = guessTxFee byteFee nOut (length coins)
in target == 0 || s < target + fee
where
s = sum $ map coinValue coins
testChooseMSCoins :: (Int, Int) -> [TestCoin]
-> Word64 -> Word64 -> Int -> Property
testChooseMSCoins (m, n) coins target byteFee nOut = nOut >= 0 ==>
case chooseMSCoins target byteFee (m,n) nOut True coins of
Right (chosen,change) ->
let outSum = sum $ map coinValue chosen
fee = guessMSTxFee byteFee (m,n) nOut (length chosen)
in outSum == target + change + fee
Left _ ->
let fee = guessMSTxFee byteFee (m,n) nOut (length coins)
in target == 0 || s < target + fee
where
s = sum $ map coinValue coins
{- Signing Transactions -}
testDetSignTx :: Network -> (Tx, [SigInput], [SecKeyI]) -> Bool
testDetSignTx net (tx, sigis, prv) =
not (verifyStdTx net tx verData) &&
not (verifyStdTx net txSigP verData) &&
verifyStdTx net txSigC verData
where
txSigP =
fromRight (error "Could not decode transaction") $
signTx net tx sigis (map secKeyData (tail prv))
txSigC =
fromRight (error "Could not decode transaction") $
signTx net txSigP sigis [secKeyData (head prv)]
verData = map (\(SigInput s v o _ _) -> (s, v, o)) sigis
testDetSignNestedTx :: Network -> (Tx, [SigInput], [SecKeyI]) -> Bool
testDetSignNestedTx net (tx, sigis, prv) =
not (verifyStdTx net tx verData) &&
not (verifyStdTx net txSigP verData) &&
verifyStdTx net txSigC verData
where
txSigP =
fromRight (error "Could not decode transaction") $
signNestedWitnessTx net tx sigis (secKeyData <$> tail prv)
txSigC =
fromRight (error "Could not decode transaction") $
signNestedWitnessTx net txSigP sigis [secKeyData (head prv)]
verData = handleSegwit <$> sigis
handleSegwit (SigInput s v o _ _)
| isSegwit s = (toP2SH $ encodeOutput s, v, o)
| otherwise = (s, v, o)
testMergeTx :: Network -> ([Tx], [(ScriptOutput, Word64, OutPoint, Int, Int)]) -> Bool
testMergeTx net (txs, os) =
and [ isRight mergeRes
, length (txIn mergedTx) == length os
, if enoughSigs
then isValid
else not isValid
-- Signature count == min (length txs) (sum required signatures)
, sum (map snd sigMap) == min (length txs) (sum (map fst sigMap))
]
where
outs = map (\(so, val, op, _, _) -> (so, val, op)) os
mergeRes = mergeTxs net txs outs
mergedTx = fromRight (error "Could not merge") mergeRes
isValid = verifyStdTx net mergedTx outs
enoughSigs = all (\(m, c) -> c >= m) sigMap
sigMap =
map (\((_, _, _, m, _), inp) -> (m, sigCnt inp)) $
zip os $ txIn mergedTx
sigCnt inp =
case decodeInputBS net $ scriptInput inp of
Right (RegularInput (SpendMulSig sigs)) -> length sigs
Right (ScriptHashInput (SpendMulSig sigs) _) -> length sigs
_ -> error "Invalid input script type"