Main.hs (22964B)
1 {-# LANGUAGE OverloadedStrings #-} 2 3 module Main where 4 5 import Bitcoin.Prim.Tx 6 import Bitcoin.Prim.Tx.Sighash 7 import qualified Data.ByteString as BS 8 import qualified Data.ByteString.Base16 as B16 9 import Data.List.NonEmpty (NonEmpty(..)) 10 import qualified Data.List.NonEmpty as NE 11 import Data.Word (Word64) 12 import Test.Tasty 13 import qualified Test.Tasty.HUnit as H 14 import Test.Tasty.QuickCheck as QC hiding (Witness) 15 import Test.QuickCheck 16 ( Gen, Arbitrary(..), elements, oneof, chooseInt, forAll, (==>) ) 17 18 -- main ------------------------------------------------------------------------ 19 20 main :: IO () 21 main = defaultMain $ 22 testGroup "ppad-tx" [ 23 testGroup "serialisation" [ 24 testGroup "round-trip" [ 25 roundtrip_legacy_simple 26 , roundtrip_segwit 27 , roundtrip_multi_io 28 ] 29 , testGroup "known vectors" [ 30 parse_satoshi_hal 31 , parse_first_segwit 32 ] 33 ] 34 , testGroup "txid" [ 35 txid_satoshi_hal 36 ] 37 , testGroup "edge cases" [ 38 edge_empty_scriptsig 39 , edge_max_sequence 40 , edge_zero_locktime 41 , edge_multi_witness 42 ] 43 , testGroup "validation" [ 44 test_mkTxId_valid 45 , test_mkTxId_short 46 , test_mkTxId_long 47 , test_mkTxId_empty 48 , test_from_bytes_truncated 49 , test_from_bytes_trailing 50 , test_from_bytes_garbage 51 , test_from_base16_invalid_hex 52 , test_sighash_segwit_oob 53 ] 54 , testGroup "sighash" [ 55 testGroup "legacy" [ 56 sighash_legacy_minimal 57 ] 58 , testGroup "BIP143 segwit" [ 59 bip143_native_p2wpkh 60 , bip143_p2sh_p2wpkh 61 ] 62 ] 63 , testGroup "properties" [ 64 testGroup "round-trip" [ 65 prop_roundtrip_bytes 66 , prop_roundtrip_base16 67 ] 68 , testGroup "serialisation" [ 69 prop_legacy_no_witnesses 70 , prop_segwit_longer 71 ] 72 , testGroup "txid" [ 73 prop_txid_32_bytes 74 , prop_txid_ignores_witnesses 75 ] 76 , testGroup "sighash" [ 77 prop_sighash_legacy_32_bytes 78 , prop_sighash_segwit_32_bytes 79 , prop_sighash_single_bug 80 ] 81 ] 82 ] 83 84 -- helpers --------------------------------------------------------------------- 85 86 -- | Decode hex, failing the test on invalid input. 87 hex :: BS.ByteString -> BS.ByteString 88 hex h = case B16.decode h of 89 Just bs -> bs 90 Nothing -> error "test error: invalid hex literal" 91 92 -- | Assert round-trip: from_bytes (to_bytes tx) == Just tx 93 assertRoundtrip :: Tx -> H.Assertion 94 assertRoundtrip tx = 95 let bs = to_bytes tx 96 in case from_bytes bs of 97 Nothing -> H.assertFailure "from_bytes returned Nothing" 98 Just tx' -> H.assertEqual "round-trip mismatch" tx tx' 99 100 -- | Assert parsing from hex succeeds. 101 assertParses :: BS.ByteString -> H.Assertion 102 assertParses rawHex = 103 case from_base16 rawHex of 104 Nothing -> H.assertFailure "from_base16 returned Nothing" 105 Just _ -> pure () 106 107 -- round-trip tests ------------------------------------------------------------ 108 109 -- Simple legacy tx: 1 input, 1 output, no witnesses 110 roundtrip_legacy_simple :: TestTree 111 roundtrip_legacy_simple = H.testCase "simple legacy tx" $ 112 assertRoundtrip legacyTx 113 where 114 legacyTx = Tx 115 { tx_version = 1 116 , tx_inputs = txin :| [] 117 , tx_outputs = txout :| [] 118 , tx_witnesses = [] 119 , tx_locktime = 0 120 } 121 txin = TxIn 122 { txin_prevout = OutPoint 123 { op_txid = TxId (BS.replicate 32 0xab) 124 , op_vout = 0 125 } 126 , txin_script_sig = hex "483045022100abcd" 127 , txin_sequence = 0xffffffff 128 } 129 txout = TxOut 130 { txout_value = 50000 131 , txout_script_pubkey = hex "76a91489abcdef" 132 } 133 134 -- Segwit tx with witnesses 135 roundtrip_segwit :: TestTree 136 roundtrip_segwit = H.testCase "segwit tx with witnesses" $ 137 assertRoundtrip segwitTx 138 where 139 segwitTx = Tx 140 { tx_version = 2 141 , tx_inputs = txin :| [] 142 , tx_outputs = txout :| [] 143 , tx_witnesses = [witness] 144 , tx_locktime = 500000 145 } 146 txin = TxIn 147 { txin_prevout = OutPoint 148 { op_txid = TxId (BS.replicate 32 0x12) 149 , op_vout = 1 150 } 151 , txin_script_sig = BS.empty -- segwit: empty scriptSig 152 , txin_sequence = 0xfffffffe 153 } 154 txout = TxOut 155 { txout_value = 100000000 156 , txout_script_pubkey = hex "0014abcdef1234567890" 157 } 158 witness = Witness 159 [ hex "304402201234" 160 , hex "0279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798" 161 ] 162 163 -- Multiple inputs and outputs 164 roundtrip_multi_io :: TestTree 165 roundtrip_multi_io = H.testCase "multiple inputs/outputs" $ 166 assertRoundtrip multiTx 167 where 168 multiTx = Tx 169 { tx_version = 1 170 , tx_inputs = txin1 :| [txin2, txin3] 171 , tx_outputs = txout1 :| [txout2] 172 , tx_witnesses = [] 173 , tx_locktime = 123456 174 } 175 txin1 = TxIn 176 { txin_prevout = OutPoint 177 { op_txid = TxId (BS.replicate 32 0x11) 178 , op_vout = 0 179 } 180 , txin_script_sig = hex "4730440220" 181 , txin_sequence = 0xffffffff 182 } 183 txin2 = TxIn 184 { txin_prevout = OutPoint 185 { op_txid = TxId (BS.replicate 32 0x22) 186 , op_vout = 2 187 } 188 , txin_script_sig = hex "483045022100" 189 , txin_sequence = 0xffffffff 190 } 191 txin3 = TxIn 192 { txin_prevout = OutPoint 193 { op_txid = TxId (BS.replicate 32 0x33) 194 , op_vout = 5 195 } 196 , txin_script_sig = hex "00" 197 , txin_sequence = 0xfffffffe 198 } 199 txout1 = TxOut 200 { txout_value = 10000000 201 , txout_script_pubkey = hex "76a914" 202 } 203 txout2 = TxOut 204 { txout_value = 5000000 205 , txout_script_pubkey = hex "a914" 206 } 207 208 -- known vector tests ---------------------------------------------------------- 209 210 -- First Bitcoin transaction ever (block 170, Satoshi to Hal Finney) 211 -- TxId: f4184fc596403b9d638783cf57adfe4c75c605f6356fbc91338530e9831e9e16 212 satoshiHalRaw :: BS.ByteString 213 satoshiHalRaw = 214 "0100000001c997a5e56e104102fa209c6a852dd90660a20b2d9c352423edce25857fcd37\ 215 \04000000004847304402204e45e16932b8af514961a1d3a1a25fdf3f4f7732e9d624c6c6\ 216 \1548ab5fb8cd410220181522ec8eca07de4860a4acdd12909d831cc56cbbac46220822\ 217 \21a8768d1d0901ffffffff0200ca9a3b00000000434104ae1a62fe09c5f51b13905f07f0\ 218 \6b99a2f7159b2225f374cd378d71302fa28414e7aab37397f554a7df5f142c21c1b7303\ 219 \b8a0626f1baded5c72a704f7e6cd84cac00286bee0000000043410411db93e1dcdb8a01\ 220 \6b49840f8c53bc1eb68a382e97b1482ecad7b148a6909a5cb2e0eaddfb84ccf9744464f8\ 221 \2e160bfa9b8b64f9d4c03f999b8643f656b412a3ac00000000" 222 223 satoshiHalTxId :: BS.ByteString 224 satoshiHalTxId = "f4184fc596403b9d638783cf57adfe4c75c605f6356fbc91338530e9831e9e16" 225 226 parse_satoshi_hal :: TestTree 227 parse_satoshi_hal = H.testCase "parse Satoshi->Hal tx (block 170)" $ 228 assertParses satoshiHalRaw 229 230 txid_satoshi_hal :: TestTree 231 txid_satoshi_hal = H.testCase "txid of Satoshi->Hal tx" $ do 232 case from_base16 satoshiHalRaw of 233 Nothing -> H.assertFailure "failed to parse tx" 234 Just tx -> do 235 let TxId computed = txid tx 236 -- txid is displayed big-endian, but stored little-endian 237 expected = BS.reverse (hex satoshiHalTxId) 238 H.assertEqual "txid mismatch" expected computed 239 240 -- First segwit tx on mainnet (block 481824) 241 firstSegwitRaw :: BS.ByteString 242 firstSegwitRaw = 243 "0200000000010140d43a99926d43eb0e619bf0b3d83b4a31f60c176beecfb9d35bf45e54\ 244 \d0f7420100000017160014a4b4ca48de0b3fffc15404a1acdc8dbaae226955ffffffff01\ 245 \00e1f5050000000017a9144a1154d50b03292b3024370901711946cb7cccc38702483045\ 246 \0221008604ef8f6d8afa892dee0f31259b6ce02dd70c545cfcfed8148179971f48d59202\ 247 \20770b9e1e5cf7f8c5d28c48abe49a3a25f1cf9e8a5b0d8f1c8f2f1c2dde88aa370121\ 248 \03d2e15674941bad4a996372cb87e1856d3652606d98562fe39c5e9e7e413f210500000000" 249 250 parse_first_segwit :: TestTree 251 parse_first_segwit = H.testCase "parse first segwit tx (block 481824)" $ 252 assertParses firstSegwitRaw 253 254 -- edge case tests ------------------------------------------------------------- 255 256 -- Empty scriptSig (common in segwit) 257 edge_empty_scriptsig :: TestTree 258 edge_empty_scriptsig = H.testCase "empty scriptSig" $ 259 assertRoundtrip tx 260 where 261 tx = Tx 262 { tx_version = 2 263 , tx_inputs = txin :| [] 264 , tx_outputs = txout :| [] 265 , tx_witnesses = [witness] 266 , tx_locktime = 0 267 } 268 txin = TxIn 269 { txin_prevout = OutPoint 270 { op_txid = TxId (BS.replicate 32 0xff) 271 , op_vout = 0 272 } 273 , txin_script_sig = BS.empty 274 , txin_sequence = 0xffffffff 275 } 276 txout = TxOut 277 { txout_value = 1000 278 , txout_script_pubkey = hex "0014abcdef" 279 } 280 witness = Witness [hex "3044", hex "02"] 281 282 -- Maximum sequence number (0xffffffff) 283 edge_max_sequence :: TestTree 284 edge_max_sequence = H.testCase "maximum sequence (0xffffffff)" $ 285 assertRoundtrip tx 286 where 287 tx = Tx 288 { tx_version = 1 289 , tx_inputs = txin :| [] 290 , tx_outputs = txout :| [] 291 , tx_witnesses = [] 292 , tx_locktime = 0 293 } 294 txin = TxIn 295 { txin_prevout = OutPoint 296 { op_txid = TxId (BS.replicate 32 0x00) 297 , op_vout = 0xffffffff -- max vout too 298 } 299 , txin_script_sig = hex "00" 300 , txin_sequence = 0xffffffff 301 } 302 txout = TxOut 303 { txout_value = 0 304 , txout_script_pubkey = hex "6a" -- OP_RETURN 305 } 306 307 -- Zero locktime 308 edge_zero_locktime :: TestTree 309 edge_zero_locktime = H.testCase "zero locktime" $ 310 assertRoundtrip tx 311 where 312 tx = Tx 313 { tx_version = 1 314 , tx_inputs = txin :| [] 315 , tx_outputs = txout :| [] 316 , tx_witnesses = [] 317 , tx_locktime = 0 318 } 319 txin = TxIn 320 { txin_prevout = OutPoint 321 { op_txid = TxId (BS.replicate 32 0xaa) 322 , op_vout = 0 323 } 324 , txin_script_sig = hex "51" -- OP_1 325 , txin_sequence = 0 326 } 327 txout = TxOut 328 { txout_value = 100 329 , txout_script_pubkey = hex "51" 330 } 331 332 -- Multiple witness items per input 333 edge_multi_witness :: TestTree 334 edge_multi_witness = H.testCase "multiple witness items" $ 335 assertRoundtrip tx 336 where 337 tx = Tx 338 { tx_version = 2 339 , tx_inputs = txin1 :| [txin2] 340 , tx_outputs = txout :| [] 341 , tx_witnesses = [witness1, witness2] 342 , tx_locktime = 0 343 } 344 txin1 = TxIn 345 { txin_prevout = OutPoint 346 { op_txid = TxId (BS.replicate 32 0x01) 347 , op_vout = 0 348 } 349 , txin_script_sig = BS.empty 350 , txin_sequence = 0xffffffff 351 } 352 txin2 = TxIn 353 { txin_prevout = OutPoint 354 { op_txid = TxId (BS.replicate 32 0x02) 355 , op_vout = 1 356 } 357 , txin_script_sig = BS.empty 358 , txin_sequence = 0xffffffff 359 } 360 txout = TxOut 361 { txout_value = 50000 362 , txout_script_pubkey = hex "0014" 363 } 364 -- 5 witness items for input 1 365 witness1 = Witness 366 [ BS.empty -- empty item (common in multisig) 367 , hex "304402201234" 368 , hex "3045022100abcd" 369 , hex "522102" 370 , hex "ae" 371 ] 372 -- 2 witness items for input 2 373 witness2 = Witness 374 [ hex "3044" 375 , hex "03" 376 ] 377 378 -- validation tests ----------------------------------------------------------- 379 380 -- mkTxId: valid 32-byte input accepted 381 test_mkTxId_valid :: TestTree 382 test_mkTxId_valid = H.testCase "mkTxId accepts 32 bytes" $ 383 case mkTxId (BS.replicate 32 0x00) of 384 Nothing -> H.assertFailure "mkTxId returned Nothing" 385 Just _ -> pure () 386 387 -- mkTxId: 31 bytes rejected 388 test_mkTxId_short :: TestTree 389 test_mkTxId_short = H.testCase "mkTxId rejects 31 bytes" $ 390 H.assertEqual "should be Nothing" 391 Nothing (mkTxId (BS.replicate 31 0x00)) 392 393 -- mkTxId: 33 bytes rejected 394 test_mkTxId_long :: TestTree 395 test_mkTxId_long = H.testCase "mkTxId rejects 33 bytes" $ 396 H.assertEqual "should be Nothing" 397 Nothing (mkTxId (BS.replicate 33 0x00)) 398 399 -- mkTxId: empty input rejected 400 test_mkTxId_empty :: TestTree 401 test_mkTxId_empty = H.testCase "mkTxId rejects empty" $ 402 H.assertEqual "should be Nothing" 403 Nothing (mkTxId BS.empty) 404 405 -- from_bytes: truncated input rejected 406 test_from_bytes_truncated :: TestTree 407 test_from_bytes_truncated = 408 H.testCase "from_bytes rejects truncated input" $ do 409 let full = to_bytes legacyTx1 410 truncated = BS.take (BS.length full - 1) full 411 H.assertEqual "should be Nothing" 412 Nothing (from_bytes truncated) 413 414 -- from_bytes: trailing bytes rejected 415 test_from_bytes_trailing :: TestTree 416 test_from_bytes_trailing = 417 H.testCase "from_bytes rejects trailing bytes" $ do 418 let full = to_bytes legacyTx1 419 padded = full <> BS.singleton 0x00 420 H.assertEqual "should be Nothing" 421 Nothing (from_bytes padded) 422 423 -- from_bytes: garbage rejected 424 test_from_bytes_garbage :: TestTree 425 test_from_bytes_garbage = 426 H.testCase "from_bytes rejects garbage" $ 427 H.assertEqual "should be Nothing" 428 Nothing (from_bytes (BS.pack [0xde, 0xad])) 429 430 -- from_base16: invalid hex rejected 431 test_from_base16_invalid_hex :: TestTree 432 test_from_base16_invalid_hex = 433 H.testCase "from_base16 rejects invalid hex" $ 434 H.assertEqual "should be Nothing" 435 Nothing (from_base16 "not valid hex!!!") 436 437 -- sighash_segwit: out-of-range index returns Nothing 438 test_sighash_segwit_oob :: TestTree 439 test_sighash_segwit_oob = 440 H.testCase "sighash_segwit rejects out-of-range index" $ do 441 let rawTx = hex $ mconcat 442 [ "0100000002fff7f7881a8099afa6940d42d1e7f6362bec" 443 , "38171ea3edf433541db4e4ad969f0000000000eeffffff" 444 , "ef51e1b804cc89d182d279655c3aa89e815b1b309fe287" 445 , "d9b2b55d57b90ec68a0100000000ffffffff02202cb206" 446 , "000000001976a9148280b37df378db99f66f85c95a783a" 447 , "76ac7a6d5988ac9093510d000000001976a9143bde42db" 448 , "ee7e4dbe6a21b2d50ce2f0167faa815988ac11000000" 449 ] 450 case from_bytes rawTx of 451 Nothing -> H.assertFailure "failed to parse tx" 452 Just tx -> 453 H.assertEqual "should be Nothing" 454 Nothing 455 (sighash_segwit tx 99 "script" 0 SIGHASH_ALL) 456 457 -- | A minimal legacy tx used by validation tests. 458 legacyTx1 :: Tx 459 legacyTx1 = Tx 460 { tx_version = 1 461 , tx_inputs = txin :| [] 462 , tx_outputs = txout :| [] 463 , tx_witnesses = [] 464 , tx_locktime = 0 465 } 466 where 467 txin = TxIn 468 { txin_prevout = OutPoint 469 { op_txid = TxId (BS.replicate 32 0x00) 470 , op_vout = 0 471 } 472 , txin_script_sig = hex "00" 473 , txin_sequence = 0xffffffff 474 } 475 txout = TxOut 476 { txout_value = 0 477 , txout_script_pubkey = hex "6a" 478 } 479 480 -- legacy sighash vectors ---------------------------------------------------- 481 482 -- Minimal tx: 1-in/1-out, signing input 0, SIGHASH_ALL, 483 -- scriptPubKey = OP_1 (0x51) 484 sighash_legacy_minimal :: TestTree 485 sighash_legacy_minimal = 486 H.testCase "minimal tx SIGHASH_ALL" $ do 487 let tx = Tx 488 { tx_version = 1 489 , tx_inputs = txin :| [] 490 , tx_outputs = txout :| [] 491 , tx_witnesses = [] 492 , tx_locktime = 0 493 } 494 txin = TxIn 495 { txin_prevout = OutPoint 496 { op_txid = TxId (BS.replicate 32 0x00) 497 , op_vout = 0 498 } 499 , txin_script_sig = hex "00" 500 , txin_sequence = 0xffffffff 501 } 502 txout = TxOut 503 { txout_value = 0 504 , txout_script_pubkey = hex "6a" 505 } 506 script_pubkey = hex "51" 507 expected = hex 508 "049b7618cbda49a0190c5eea6f97320b\ 509 \930aa32b64be6e71ed20041067685c45" 510 result = sighash_legacy tx 0 script_pubkey SIGHASH_ALL 511 H.assertEqual "sighash mismatch" expected result 512 513 -- BIP143 sighash vectors ----------------------------------------------------- 514 515 -- Native P2WPKH (BIP143 example) 516 -- https://github.com/bitcoin/bips/blob/master/bip-0143.mediawiki 517 bip143_native_p2wpkh :: TestTree 518 bip143_native_p2wpkh = H.testCase "native P2WPKH" $ do 519 let rawTx = hex $ mconcat 520 [ "0100000002fff7f7881a8099afa6940d42d1e7f6362bec38171ea3edf43354" 521 , "1db4e4ad969f0000000000eeffffffef51e1b804cc89d182d279655c3aa89e" 522 , "815b1b309fe287d9b2b55d57b90ec68a0100000000ffffffff02202cb20600" 523 , "0000001976a9148280b37df378db99f66f85c95a783a76ac7a6d5988ac9093" 524 , "510d000000001976a9143bde42dbee7e4dbe6a21b2d50ce2f0167faa815988" 525 , "ac11000000" 526 ] 527 case from_bytes rawTx of 528 Nothing -> H.assertFailure "failed to parse BIP143 tx" 529 Just tx -> do 530 let inputIdx = 1 531 -- scriptCode for P2WPKH (without length prefix) 532 scriptCode = hex 533 "76a9141d0f172a0ecb48aee1be1f2687d2963ae33f71a188ac" 534 value = 600000000 :: Word64 535 expected = hex 536 "c37af31116d1b27caf68aae9e3ac82f1477929014d5b917657d0eb49478cb670" 537 case sighash_segwit tx inputIdx scriptCode value SIGHASH_ALL of 538 Nothing -> H.assertFailure "sighash_segwit returned Nothing" 539 Just result -> H.assertEqual "sighash mismatch" expected result 540 541 -- P2SH-P2WPKH (BIP143 example) 542 bip143_p2sh_p2wpkh :: TestTree 543 bip143_p2sh_p2wpkh = H.testCase "P2SH-P2WPKH" $ do 544 let rawTx = hex $ mconcat 545 [ "0100000001db6b1b20aa0fd7b23880be2ecbd4a98130974cf4748fb66092ac" 546 , "4d3ceb1a54770100000000feffffff02b8b4eb0b000000001976a914a457b6" 547 , "84d7f0d539a46a45bbc043f35b59d0d96388ac0008af2f000000001976a914" 548 , "fd270b1ee6abcaea97fea7ad0402e8bd8ad6d77c88ac92040000" 549 ] 550 case from_bytes rawTx of 551 Nothing -> H.assertFailure "failed to parse BIP143 tx" 552 Just tx -> do 553 let inputIdx = 0 554 -- scriptCode without length prefix 555 scriptCode = hex 556 "76a91479091972186c449eb1ded22b78e40d009bdf008988ac" 557 value = 1000000000 :: Word64 558 expected = hex 559 "64f3b0f4dd2bb3aa1ce8566d220cc74dda9df97d8490cc81d89d735c92e59fb6" 560 case sighash_segwit tx inputIdx scriptCode value SIGHASH_ALL of 561 Nothing -> H.assertFailure "sighash_segwit returned Nothing" 562 Just result -> H.assertEqual "sighash mismatch" expected result 563 564 -- Arbitrary instances -------------------------------------------------------- 565 566 instance Arbitrary TxId where 567 arbitrary = TxId . BS.pack <$> vectorOf 32 arbitrary 568 569 instance Arbitrary OutPoint where 570 arbitrary = OutPoint <$> arbitrary <*> arbitrary 571 572 instance Arbitrary TxIn where 573 arbitrary = TxIn 574 <$> arbitrary 575 <*> arbitraryScript 576 <*> arbitrary 577 578 instance Arbitrary TxOut where 579 arbitrary = TxOut 580 <$> arbitrary 581 <*> arbitraryScript 582 583 instance Arbitrary Witness where 584 arbitrary = Witness <$> listOf arbitraryScript 585 586 instance Arbitrary SighashType where 587 arbitrary = elements 588 [ SIGHASH_ALL 589 , SIGHASH_NONE 590 , SIGHASH_SINGLE 591 , SIGHASH_ALL_ANYONECANPAY 592 , SIGHASH_NONE_ANYONECANPAY 593 , SIGHASH_SINGLE_ANYONECANPAY 594 ] 595 596 -- | Generate arbitrary script-like bytestrings (0-200 bytes). 597 arbitraryScript :: Gen BS.ByteString 598 arbitraryScript = do 599 len <- chooseInt (0, 200) 600 BS.pack <$> vectorOf len arbitrary 601 602 -- | Generate a NonEmpty list of 1-5 items. 603 arbitraryNonEmpty :: Arbitrary a => Gen (NonEmpty a) 604 arbitraryNonEmpty = do 605 x <- arbitrary 606 xs <- listOf1to4 607 pure (x :| xs) 608 where 609 listOf1to4 = do 610 n <- chooseInt (0, 4) 611 vectorOf n arbitrary 612 613 -- | Generate a valid legacy transaction (no witnesses). 614 genLegacyTx :: Gen Tx 615 genLegacyTx = do 616 ver <- arbitrary 617 ins <- arbitraryNonEmpty 618 outs <- arbitraryNonEmpty 619 lt <- arbitrary 620 pure $ Tx ver ins outs [] lt 621 622 -- | Generate a valid segwit transaction (with witnesses). 623 genSegwitTx :: Gen Tx 624 genSegwitTx = do 625 ver <- arbitrary 626 ins <- arbitraryNonEmpty 627 outs <- arbitraryNonEmpty 628 -- One witness per input 629 let numInputs = NE.length ins 630 wits <- vectorOf numInputs arbitrary 631 lt <- arbitrary 632 pure $ Tx ver ins outs wits lt 633 634 -- | Generate any valid transaction. 635 instance Arbitrary Tx where 636 arbitrary = oneof [genLegacyTx, genSegwitTx] 637 638 -- property tests ------------------------------------------------------------- 639 640 -- Round-trip: from_bytes (to_bytes tx) == Just tx 641 prop_roundtrip_bytes :: TestTree 642 prop_roundtrip_bytes = QC.testProperty "from_bytes . to_bytes == Just" $ 643 \tx -> from_bytes (to_bytes tx) === Just (tx :: Tx) 644 645 -- Round-trip: from_base16 (to_base16 tx) == Just tx 646 prop_roundtrip_base16 :: TestTree 647 prop_roundtrip_base16 = QC.testProperty "from_base16 . to_base16 == Just" $ 648 \tx -> from_base16 (to_base16 tx) === Just (tx :: Tx) 649 650 -- Legacy tx (no witnesses): to_bytes == to_bytes_legacy 651 prop_legacy_no_witnesses :: TestTree 652 prop_legacy_no_witnesses = 653 QC.testProperty "legacy tx: to_bytes == to_bytes_legacy" $ 654 forAll genLegacyTx $ \tx -> 655 to_bytes tx === to_bytes_legacy tx 656 657 -- Segwit tx: to_bytes is longer than to_bytes_legacy (when witnesses present) 658 prop_segwit_longer :: TestTree 659 prop_segwit_longer = 660 QC.testProperty "segwit tx: to_bytes longer than to_bytes_legacy" $ 661 forAll genSegwitTx $ \tx -> 662 not (null (tx_witnesses tx)) ==> 663 BS.length (to_bytes tx) > BS.length (to_bytes_legacy tx) 664 665 -- TxId is always 32 bytes 666 prop_txid_32_bytes :: TestTree 667 prop_txid_32_bytes = QC.testProperty "txid is always 32 bytes" $ 668 \tx -> let TxId bs = txid tx in BS.length bs === 32 669 670 -- TxId ignores witnesses (same txid with or without witnesses) 671 prop_txid_ignores_witnesses :: TestTree 672 prop_txid_ignores_witnesses = 673 QC.testProperty "txid ignores witnesses" $ 674 forAll genSegwitTx $ \tx -> 675 let txNoWit = tx { tx_witnesses = [] } 676 in txid tx === txid txNoWit 677 678 -- sighash_legacy always returns 32 bytes 679 prop_sighash_legacy_32_bytes :: TestTree 680 prop_sighash_legacy_32_bytes = 681 QC.testProperty "sighash_legacy is always 32 bytes" $ 682 forAll genLegacyTx $ \tx -> 683 forAll arbitraryScript $ \spk -> 684 forAll arbitrary $ \st -> 685 BS.length (sighash_legacy tx 0 spk st) === 32 686 687 -- sighash_segwit returns Just 32 bytes for valid index 688 prop_sighash_segwit_32_bytes :: TestTree 689 prop_sighash_segwit_32_bytes = 690 QC.testProperty "sighash_segwit is 32 bytes for valid index" $ 691 forAll genSegwitTx $ \tx -> 692 forAll arbitraryScript $ \sc -> 693 forAll (arbitrary :: Gen Word64) $ \val -> 694 forAll arbitrary $ \st -> 695 case sighash_segwit tx 0 sc val st of 696 Nothing -> False -- should succeed for index 0 697 Just bs -> BS.length bs == 32 698 699 -- SIGHASH_SINGLE bug: returns 0x01 ++ 0x00*31 when index >= outputs 700 prop_sighash_single_bug :: TestTree 701 prop_sighash_single_bug = 702 QC.testProperty "SIGHASH_SINGLE bug when index >= outputs" $ 703 forAll genLegacyTx $ \tx -> 704 let numOutputs = NE.length (tx_outputs tx) 705 bugValue = BS.cons 0x01 (BS.replicate 31 0x00) 706 in forAll arbitraryScript $ \spk -> 707 sighash_legacy tx numOutputs spk SIGHASH_SINGLE === bugValue