Main.hs (59423B)
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.Int (Int32) 10 import Data.List.NonEmpty (NonEmpty(..)) 11 import qualified Data.List.NonEmpty as NE 12 import Data.Word (Word8, Word32, Word64) 13 import Test.Tasty 14 import qualified Test.Tasty.HUnit as H 15 import Test.Tasty.QuickCheck as QC hiding (Witness) 16 17 -- main ----------------------------------------------------------------------- 18 19 main :: IO () 20 main = defaultMain $ 21 testGroup "ppad-tx" [ 22 testGroup "serialisation" [ 23 testGroup "round-trip" [ 24 roundtrip_legacy_simple 25 , roundtrip_segwit 26 , roundtrip_multi_io 27 ] 28 , testGroup "known vectors" [ 29 parse_satoshi_hal 30 , parse_first_segwit 31 ] 32 , testGroup "compactSize" [ 33 test_compact_non_minimal_fd 34 , test_compact_non_minimal_fe 35 , test_compact_non_minimal_ff 36 ] 37 ] 38 , testGroup "txid" [ 39 txid_satoshi_hal 40 , txid_first_segwit 41 ] 42 , testGroup "edge cases" [ 43 edge_empty_scriptsig 44 , edge_max_sequence 45 , edge_zero_locktime 46 , edge_multi_witness 47 ] 48 , testGroup "validation" [ 49 test_mk_txid_valid 50 , test_mk_txid_short 51 , test_mk_txid_long 52 , test_mk_txid_empty 53 , test_from_bytes_truncated 54 , test_from_bytes_trailing 55 , test_from_bytes_garbage 56 , test_from_base16_invalid_hex 57 , test_sighash_segwit_oob 58 , test_from_bytes_huge_length 59 , test_from_bytes_huge_count 60 , test_from_bytes_superfluous_witness 61 , test_to_bytes_empty_witnesses 62 , test_fixtures_parse 63 ] 64 , testGroup "sighash" [ 65 testGroup "legacy" [ 66 sighash_legacy_minimal 67 , testGroup "codeseparators" [ 68 codesep_no_op 69 , codesep_strip_simple 70 , codesep_inside_push 71 , codesep_inside_pushdata1 72 , codesep_inside_pushdata2 73 , codesep_inside_pushdata4 74 , codesep_malformed_tail 75 ] 76 , testGroup "Bitcoin Core sighash.json" [ 77 bc_sighash_1 78 , bc_sighash_2 79 , bc_sighash_4 80 , bc_sighash_9 81 , bc_sighash_14 82 , bc_sighash_20 83 ] 84 ] 85 , testGroup "BIP143 segwit" [ 86 bip143_native_p2wpkh 87 , bip143_p2sh_p2wpkh 88 , testGroup "P2SH-P2WSH multi-sighash" [ 89 bip143_p2sh_p2wsh_all 90 , bip143_p2sh_p2wsh_none 91 , bip143_p2sh_p2wsh_single 92 , bip143_p2sh_p2wsh_all_acp 93 , bip143_p2sh_p2wsh_none_acp 94 , bip143_p2sh_p2wsh_single_acp 95 ] 96 ] 97 , testGroup "BIP341 taproot" [ 98 testGroup "key-path (wallet-test-vectors.json)" [ 99 bip341_kp_in0_single 100 , bip341_kp_in1_single_acp 101 , bip341_kp_in3_all 102 , bip341_kp_in4_default 103 , bip341_kp_in6_none 104 , bip341_kp_in7_none_acp 105 , bip341_kp_in8_all_acp 106 ] 107 , testGroup "script-path (rust-bitcoin)" [ 108 rb_script_path_all 109 ] 110 , testGroup "validation" [ 111 taproot_invalid_ht 112 , taproot_invalid_idx 113 , taproot_amounts_mismatch 114 , taproot_spks_mismatch 115 , taproot_bad_annex_prefix 116 , taproot_empty_annex 117 , taproot_short_leaf_hash 118 , taproot_single_oob 119 ] 120 ] 121 ] 122 , testGroup "properties" [ 123 testGroup "round-trip" [ 124 prop_roundtrip_bytes 125 , prop_roundtrip_base16 126 ] 127 , testGroup "serialisation" [ 128 prop_legacy_no_witnesses 129 , prop_segwit_longer 130 ] 131 , testGroup "txid" [ 132 prop_txid_32_bytes 133 , prop_txid_ignores_witnesses 134 ] 135 , testGroup "sighash" [ 136 prop_sighash_legacy_32_bytes 137 , prop_sighash_segwit_32_bytes 138 , prop_sighash_single_bug 139 , prop_sighash_segwit_oob 140 , prop_sighash_legacy_acp_invariant 141 , prop_sighash_legacy_none_invariant 142 , prop_sighash_legacy_none_acp_invariant 143 , prop_strip_codesep_idempotent 144 , prop_strip_codesep_no_0xab_unchanged 145 , prop_taproot_keypath_neq_scriptpath 146 , prop_taproot_csep_changes_hash 147 , prop_taproot_annex_commits 148 , prop_taproot_acp_ignores_other_inputs 149 , prop_taproot_none_ignores_outputs 150 ] 151 ] 152 ] 153 154 -- helpers -------------------------------------------------------------------- 155 156 -- | Decode a hex literal. Total: an invalid literal decodes to empty 157 -- bytes, which no vector expects, and the "fixtures parse" test 158 -- checks the transaction fixtures explicitly. 159 hex :: BS.ByteString -> BS.ByteString 160 hex h = case B16.decode h of 161 Just bs -> bs 162 Nothing -> BS.empty 163 164 -- | Assert round-trip: from_bytes (to_bytes tx) == Just tx 165 assertRoundtrip :: Tx -> H.Assertion 166 assertRoundtrip tx = 167 let bs = to_bytes tx 168 in case from_bytes bs of 169 Nothing -> H.assertFailure "from_bytes returned Nothing" 170 Just tx' -> H.assertEqual "round-trip mismatch" tx tx' 171 172 -- | Assert parsing from hex succeeds. 173 assertParses :: BS.ByteString -> H.Assertion 174 assertParses rawHex = 175 case from_base16 rawHex of 176 Nothing -> H.assertFailure "from_base16 returned Nothing" 177 Just _ -> pure () 178 179 -- round-trip tests ----------------------------------------------------------- 180 181 -- Simple legacy tx: 1 input, 1 output, no witnesses 182 roundtrip_legacy_simple :: TestTree 183 roundtrip_legacy_simple = H.testCase "simple legacy tx" $ 184 assertRoundtrip legacyTx 185 where 186 legacyTx = Tx 187 { tx_version = 1 188 , tx_inputs = txin :| [] 189 , tx_outputs = txout :| [] 190 , tx_locktime = 0 191 } 192 txin = TxIn 193 { txin_prevout = OutPoint 194 { op_txid = tid 0xab 195 , op_vout = 0 196 } 197 , txin_script_sig = hex "483045022100abcd" 198 , txin_sequence = 0xffffffff 199 , txin_witness = Witness [] 200 } 201 txout = TxOut 202 { txout_value = 50000 203 , txout_script_pubkey = hex "76a91489abcdef" 204 } 205 206 -- Segwit tx with witnesses 207 roundtrip_segwit :: TestTree 208 roundtrip_segwit = H.testCase "segwit tx with witnesses" $ 209 assertRoundtrip segwitTx 210 where 211 segwitTx = Tx 212 { tx_version = 2 213 , tx_inputs = txin :| [] 214 , tx_outputs = txout :| [] 215 , tx_locktime = 500000 216 } 217 txin = TxIn 218 { txin_prevout = OutPoint 219 { op_txid = tid 0x12 220 , op_vout = 1 221 } 222 , txin_script_sig = BS.empty -- segwit: empty scriptSig 223 , txin_sequence = 0xfffffffe 224 , txin_witness = wit 225 } 226 txout = TxOut 227 { txout_value = 100000000 228 , txout_script_pubkey = hex "0014abcdef1234567890" 229 } 230 wit = Witness 231 [ hex "304402201234" 232 , hex ("0279be667ef9dcbbac55a06295ce870b" 233 <> "07029bfcdb2dce28d959f2815b16f81798") 234 ] 235 236 -- Multiple inputs and outputs 237 roundtrip_multi_io :: TestTree 238 roundtrip_multi_io = H.testCase "multiple inputs/outputs" $ 239 assertRoundtrip multiTx 240 where 241 multiTx = Tx 242 { tx_version = 1 243 , tx_inputs = txin1 :| [txin2, txin3] 244 , tx_outputs = txout1 :| [txout2] 245 , tx_locktime = 123456 246 } 247 txin1 = TxIn 248 { txin_prevout = OutPoint 249 { op_txid = tid 0x11 250 , op_vout = 0 251 } 252 , txin_script_sig = hex "4730440220" 253 , txin_sequence = 0xffffffff 254 , txin_witness = Witness [] 255 } 256 txin2 = TxIn 257 { txin_prevout = OutPoint 258 { op_txid = tid 0x22 259 , op_vout = 2 260 } 261 , txin_script_sig = hex "483045022100" 262 , txin_sequence = 0xffffffff 263 , txin_witness = Witness [] 264 } 265 txin3 = TxIn 266 { txin_prevout = OutPoint 267 { op_txid = tid 0x33 268 , op_vout = 5 269 } 270 , txin_script_sig = hex "00" 271 , txin_sequence = 0xfffffffe 272 , txin_witness = Witness [] 273 } 274 txout1 = TxOut 275 { txout_value = 10000000 276 , txout_script_pubkey = hex "76a914" 277 } 278 txout2 = TxOut 279 { txout_value = 5000000 280 , txout_script_pubkey = hex "a914" 281 } 282 283 -- known vector tests --------------------------------------------------------- 284 285 -- First Bitcoin transaction ever (block 170, Satoshi to Hal Finney) 286 -- TxId: f4184fc596403b9d638783cf57adfe4c75c605f6356fbc91338530e9831e9e16 287 satoshiHalRaw :: BS.ByteString 288 satoshiHalRaw = 289 "0100000001c997a5e56e104102fa209c6a852dd90660a20b2d9c352423edce25857fcd37\ 290 \04000000004847304402204e45e16932b8af514961a1d3a1a25fdf3f4f7732e9d624c6c6\ 291 \1548ab5fb8cd410220181522ec8eca07de4860a4acdd12909d831cc56cbbac46220822\ 292 \21a8768d1d0901ffffffff0200ca9a3b00000000434104ae1a62fe09c5f51b13905f07f0\ 293 \6b99a2f7159b2225f374cd378d71302fa28414e7aab37397f554a7df5f142c21c1b7303\ 294 \b8a0626f1baded5c72a704f7e6cd84cac00286bee0000000043410411db93e1dcdb8a01\ 295 \6b49840f8c53bc1eb68a382e97b1482ecad7b148a6909a5cb2e0eaddfb84ccf9744464f8\ 296 \2e160bfa9b8b64f9d4c03f999b8643f656b412a3ac00000000" 297 298 satoshiHalTxId :: BS.ByteString 299 satoshiHalTxId = 300 "f4184fc596403b9d638783cf57adfe4c75c605f6356fbc91338530e9831e9e16" 301 302 parse_satoshi_hal :: TestTree 303 parse_satoshi_hal = H.testCase "parse Satoshi->Hal tx (block 170)" $ 304 assertParses satoshiHalRaw 305 306 txid_satoshi_hal :: TestTree 307 txid_satoshi_hal = H.testCase "txid of Satoshi->Hal tx" $ do 308 case from_base16 satoshiHalRaw of 309 Nothing -> H.assertFailure "failed to parse tx" 310 Just tx -> do 311 let computed = un_txid (txid tx) 312 -- txid is displayed big-endian, but stored little-endian 313 expected = BS.reverse (hex satoshiHalTxId) 314 H.assertEqual "txid mismatch" expected computed 315 316 -- First segwit tx on mainnet (block 481824) 317 firstSegwitRaw :: BS.ByteString 318 firstSegwitRaw = 319 "0200000000010140d43a99926d43eb0e619bf0b3d83b4a31f60c176beecfb9d35bf45e54\ 320 \d0f7420100000017160014a4b4ca48de0b3fffc15404a1acdc8dbaae226955ffffffff01\ 321 \00e1f5050000000017a9144a1154d50b03292b3024370901711946cb7cccc38702483045\ 322 \0221008604ef8f6d8afa892dee0f31259b6ce02dd70c545cfcfed8148179971f48d59202\ 323 \20770b9e1e5cf7f8c5d28c48abe49a3a25f1cf9e8a5b0d8f1c8f2f1c2dde88aa370121\ 324 \03d2e15674941bad4a996372cb87e1856d3652606d98562fe39c5e9e7e413f210500000000" 325 326 parse_first_segwit :: TestTree 327 parse_first_segwit = H.testCase "parse first segwit tx (block 481824)" $ 328 assertParses firstSegwitRaw 329 330 -- edge case tests ------------------------------------------------------------ 331 332 -- Empty scriptSig (common in segwit) 333 edge_empty_scriptsig :: TestTree 334 edge_empty_scriptsig = H.testCase "empty scriptSig" $ 335 assertRoundtrip tx 336 where 337 tx = Tx 338 { tx_version = 2 339 , tx_inputs = txin :| [] 340 , tx_outputs = txout :| [] 341 , tx_locktime = 0 342 } 343 txin = TxIn 344 { txin_prevout = OutPoint 345 { op_txid = tid 0xff 346 , op_vout = 0 347 } 348 , txin_script_sig = BS.empty 349 , txin_sequence = 0xffffffff 350 , txin_witness = wit 351 } 352 txout = TxOut 353 { txout_value = 1000 354 , txout_script_pubkey = hex "0014abcdef" 355 } 356 wit = Witness [hex "3044", hex "02"] 357 358 -- Maximum sequence number (0xffffffff) 359 edge_max_sequence :: TestTree 360 edge_max_sequence = H.testCase "maximum sequence (0xffffffff)" $ 361 assertRoundtrip tx 362 where 363 tx = Tx 364 { tx_version = 1 365 , tx_inputs = txin :| [] 366 , tx_outputs = txout :| [] 367 , tx_locktime = 0 368 } 369 txin = TxIn 370 { txin_prevout = OutPoint 371 { op_txid = tid 0x00 372 , op_vout = 0xffffffff -- max vout too 373 } 374 , txin_script_sig = hex "00" 375 , txin_sequence = 0xffffffff 376 , txin_witness = Witness [] 377 } 378 txout = TxOut 379 { txout_value = 0 380 , txout_script_pubkey = hex "6a" -- OP_RETURN 381 } 382 383 -- Zero locktime 384 edge_zero_locktime :: TestTree 385 edge_zero_locktime = H.testCase "zero locktime" $ 386 assertRoundtrip tx 387 where 388 tx = Tx 389 { tx_version = 1 390 , tx_inputs = txin :| [] 391 , tx_outputs = txout :| [] 392 , tx_locktime = 0 393 } 394 txin = TxIn 395 { txin_prevout = OutPoint 396 { op_txid = tid 0xaa 397 , op_vout = 0 398 } 399 , txin_script_sig = hex "51" -- OP_1 400 , txin_sequence = 0 401 , txin_witness = Witness [] 402 } 403 txout = TxOut 404 { txout_value = 100 405 , txout_script_pubkey = hex "51" 406 } 407 408 -- Multiple witness items per input 409 edge_multi_witness :: TestTree 410 edge_multi_witness = H.testCase "multiple witness items" $ 411 assertRoundtrip tx 412 where 413 tx = Tx 414 { tx_version = 2 415 , tx_inputs = txin1 :| [txin2] 416 , tx_outputs = txout :| [] 417 , tx_locktime = 0 418 } 419 txin1 = TxIn 420 { txin_prevout = OutPoint 421 { op_txid = tid 0x01 422 , op_vout = 0 423 } 424 , txin_script_sig = BS.empty 425 , txin_sequence = 0xffffffff 426 , txin_witness = witness1 427 } 428 txin2 = TxIn 429 { txin_prevout = OutPoint 430 { op_txid = tid 0x02 431 , op_vout = 1 432 } 433 , txin_script_sig = BS.empty 434 , txin_sequence = 0xffffffff 435 , txin_witness = witness2 436 } 437 txout = TxOut 438 { txout_value = 50000 439 , txout_script_pubkey = hex "0014" 440 } 441 -- 5 witness items for input 1 442 witness1 = Witness 443 [ BS.empty -- empty item (common in multisig) 444 , hex "304402201234" 445 , hex "3045022100abcd" 446 , hex "522102" 447 , hex "ae" 448 ] 449 -- 2 witness items for input 2 450 witness2 = Witness 451 [ hex "3044" 452 , hex "03" 453 ] 454 455 -- validation tests ----------------------------------------------------------- 456 457 -- mk_txid: valid 32-byte input accepted 458 test_mk_txid_valid :: TestTree 459 test_mk_txid_valid = H.testCase "mk_txid accepts 32 bytes" $ 460 case mk_txid (BS.replicate 32 0x00) of 461 Nothing -> H.assertFailure "mk_txid returned Nothing" 462 Just _ -> pure () 463 464 -- mk_txid: 31 bytes rejected 465 test_mk_txid_short :: TestTree 466 test_mk_txid_short = H.testCase "mk_txid rejects 31 bytes" $ 467 H.assertEqual "should be Nothing" 468 Nothing (mk_txid (BS.replicate 31 0x00)) 469 470 -- mk_txid: 33 bytes rejected 471 test_mk_txid_long :: TestTree 472 test_mk_txid_long = H.testCase "mk_txid rejects 33 bytes" $ 473 H.assertEqual "should be Nothing" 474 Nothing (mk_txid (BS.replicate 33 0x00)) 475 476 -- mk_txid: empty input rejected 477 test_mk_txid_empty :: TestTree 478 test_mk_txid_empty = H.testCase "mk_txid rejects empty" $ 479 H.assertEqual "should be Nothing" 480 Nothing (mk_txid BS.empty) 481 482 -- from_bytes: truncated input rejected 483 test_from_bytes_truncated :: TestTree 484 test_from_bytes_truncated = 485 H.testCase "from_bytes rejects truncated input" $ do 486 let full = to_bytes legacyTx1 487 truncated = BS.take (BS.length full - 1) full 488 H.assertEqual "should be Nothing" 489 Nothing (from_bytes truncated) 490 491 -- from_bytes: trailing bytes rejected 492 test_from_bytes_trailing :: TestTree 493 test_from_bytes_trailing = 494 H.testCase "from_bytes rejects trailing bytes" $ do 495 let full = to_bytes legacyTx1 496 padded = full <> BS.singleton 0x00 497 H.assertEqual "should be Nothing" 498 Nothing (from_bytes padded) 499 500 -- from_bytes: garbage rejected 501 test_from_bytes_garbage :: TestTree 502 test_from_bytes_garbage = 503 H.testCase "from_bytes rejects garbage" $ 504 H.assertEqual "should be Nothing" 505 Nothing (from_bytes (BS.pack [0xde, 0xad])) 506 507 -- from_bytes: a compactSize length >= 2^63 is rejected (it used to wrap 508 -- to a negative Int and crash with a negative index) 509 test_from_bytes_huge_length :: TestTree 510 test_from_bytes_huge_length = 511 H.testCase "from_bytes rejects huge lengths without crashing" $ do 512 let prefix = hex "0100000001" <> BS.replicate 36 0x00 513 script_len = hex "ff0000000000000080" 514 H.assertEqual "scriptSig" Nothing 515 (from_bytes (prefix <> script_len <> hex "ffffffff")) 516 H.assertEqual "maximal" Nothing 517 (from_bytes (prefix <> hex "ffffffffffffffffff" <> hex "ffffffff")) 518 519 -- from_bytes: a count exceeding the remaining input is rejected (a huge 520 -- witness item count used to wrap negative and parse as zero items) 521 test_from_bytes_huge_count :: TestTree 522 test_from_bytes_huge_count = 523 H.testCase "from_bytes rejects counts exceeding the input" $ do 524 let tx = mconcat 525 [ hex "0100000000010100", BS.replicate 35 0x00, hex "00ffffffff" 526 , hex "01", BS.replicate 8 0x00, hex "00" 527 , hex "ff0000000000000080" -- witness item count 2^63 528 , hex "00000000" 529 ] 530 H.assertEqual "witness item count" Nothing (from_bytes tx) 531 H.assertEqual "input count" Nothing 532 (from_bytes (hex "01000000ffffffffffffffffff00000000")) 533 534 -- from_bytes: a segwit marker and flag with only empty witnesses is 535 -- invalid (Bitcoin Core: "superfluous witness record") 536 test_from_bytes_superfluous_witness :: TestTree 537 test_from_bytes_superfluous_witness = 538 H.testCase "from_bytes rejects a segwit tx with no witness data" $ do 539 let tx = mconcat 540 [ hex "0100000000010100", BS.replicate 35 0x00, hex "00ffffffff" 541 , hex "01", BS.replicate 8 0x00, hex "00" 542 , hex "00" -- empty witness stack 543 , hex "00000000" 544 ] 545 H.assertEqual "should be Nothing" Nothing (from_bytes tx) 546 547 -- to_bytes: all-empty witnesses serialise in the legacy format 548 test_to_bytes_empty_witnesses :: TestTree 549 test_to_bytes_empty_witnesses = 550 H.testCase "to_bytes uses the legacy format for empty witnesses" $ do 551 let tx = strip_witnesses legacyTx1 552 H.assertEqual "legacy" (to_bytes_legacy tx) (to_bytes tx) 553 554 -- every transaction fixture literal parses 555 test_fixtures_parse :: TestTree 556 test_fixtures_parse = 557 H.testCase "fixtures parse" $ do 558 H.assertBool "BIP143 P2SH-P2WSH" (is_just (from_base16 p2shP2wshTxHex)) 559 H.assertBool "BIP341" (is_just (from_base16 bip341TxHex)) 560 where 561 is_just = maybe False (const True) 562 563 -- from_base16: invalid hex rejected 564 test_from_base16_invalid_hex :: TestTree 565 test_from_base16_invalid_hex = 566 H.testCase "from_base16 rejects invalid hex" $ 567 H.assertEqual "should be Nothing" 568 Nothing (from_base16 "not valid hex!!!") 569 570 -- sighash_segwit: out-of-range index returns Nothing 571 test_sighash_segwit_oob :: TestTree 572 test_sighash_segwit_oob = 573 H.testCase "sighash_segwit rejects out-of-range index" $ do 574 let rawTx = hex $ mconcat 575 [ "0100000002fff7f7881a8099afa6940d42d1e7f6362bec" 576 , "38171ea3edf433541db4e4ad969f0000000000eeffffff" 577 , "ef51e1b804cc89d182d279655c3aa89e815b1b309fe287" 578 , "d9b2b55d57b90ec68a0100000000ffffffff02202cb206" 579 , "000000001976a9148280b37df378db99f66f85c95a783a" 580 , "76ac7a6d5988ac9093510d000000001976a9143bde42db" 581 , "ee7e4dbe6a21b2d50ce2f0167faa815988ac11000000" 582 ] 583 case from_bytes rawTx of 584 Nothing -> H.assertFailure "failed to parse tx" 585 Just tx -> 586 H.assertEqual "should be Nothing" 587 Nothing 588 (sighash_segwit tx 99 "script" 0 (encode_sighash SIGHASH_ALL)) 589 590 -- | A minimal legacy tx used by validation tests. 591 legacyTx1 :: Tx 592 legacyTx1 = Tx 593 { tx_version = 1 594 , tx_inputs = txin :| [] 595 , tx_outputs = txout :| [] 596 , tx_locktime = 0 597 } 598 where 599 txin = TxIn 600 { txin_prevout = OutPoint 601 { op_txid = tid 0x00 602 , op_vout = 0 603 } 604 , txin_script_sig = hex "00" 605 , txin_sequence = 0xffffffff 606 , txin_witness = Witness [] 607 } 608 txout = TxOut 609 { txout_value = 0 610 , txout_script_pubkey = hex "6a" 611 } 612 613 -- legacy sighash vectors ---------------------------------------------------- 614 615 -- Minimal tx: 1-in/1-out, signing input 0, SIGHASH_ALL, 616 -- scriptPubKey = OP_1 (0x51) 617 sighash_legacy_minimal :: TestTree 618 sighash_legacy_minimal = 619 H.testCase "minimal tx SIGHASH_ALL" $ do 620 let tx = Tx 621 { tx_version = 1 622 , tx_inputs = txin :| [] 623 , tx_outputs = txout :| [] 624 , tx_locktime = 0 625 } 626 txin = TxIn 627 { txin_prevout = OutPoint 628 { op_txid = tid 0x00 629 , op_vout = 0 630 } 631 , txin_script_sig = hex "00" 632 , txin_sequence = 0xffffffff 633 , txin_witness = Witness [] 634 } 635 txout = TxOut 636 { txout_value = 0 637 , txout_script_pubkey = hex "6a" 638 } 639 script_pubkey = hex "51" 640 expected = hex 641 "049b7618cbda49a0190c5eea6f97320b\ 642 \930aa32b64be6e71ed20041067685c45" 643 result = sighash_legacy tx 0 script_pubkey 644 (encode_sighash SIGHASH_ALL) 645 H.assertEqual "sighash mismatch" expected result 646 647 -- BIP143 sighash vectors ----------------------------------------------------- 648 649 -- Native P2WPKH (BIP143 example) 650 -- https://github.com/bitcoin/bips/blob/master/bip-0143.mediawiki 651 bip143_native_p2wpkh :: TestTree 652 bip143_native_p2wpkh = H.testCase "native P2WPKH" $ do 653 let rawTx = hex $ mconcat 654 [ "0100000002fff7f7881a8099afa6940d42d1e7f6362bec38171ea3edf43354" 655 , "1db4e4ad969f0000000000eeffffffef51e1b804cc89d182d279655c3aa89e" 656 , "815b1b309fe287d9b2b55d57b90ec68a0100000000ffffffff02202cb20600" 657 , "0000001976a9148280b37df378db99f66f85c95a783a76ac7a6d5988ac9093" 658 , "510d000000001976a9143bde42dbee7e4dbe6a21b2d50ce2f0167faa815988" 659 , "ac11000000" 660 ] 661 case from_bytes rawTx of 662 Nothing -> H.assertFailure "failed to parse BIP143 tx" 663 Just tx -> do 664 let inputIdx = 1 665 -- scriptCode for P2WPKH (without length prefix) 666 scriptCode = hex 667 "76a9141d0f172a0ecb48aee1be1f2687d2963ae33f71a188ac" 668 value = 600000000 :: Word64 669 expected = hex 670 "c37af31116d1b27caf68aae9e3ac82f1477929014d5b917657d0eb49478cb670" 671 case sighash_segwit tx inputIdx scriptCode value 672 (encode_sighash SIGHASH_ALL) of 673 Nothing -> H.assertFailure "sighash_segwit returned Nothing" 674 Just result -> H.assertEqual "sighash mismatch" expected result 675 676 -- P2SH-P2WPKH (BIP143 example) 677 bip143_p2sh_p2wpkh :: TestTree 678 bip143_p2sh_p2wpkh = H.testCase "P2SH-P2WPKH" $ do 679 let rawTx = hex $ mconcat 680 [ "0100000001db6b1b20aa0fd7b23880be2ecbd4a98130974cf4748fb66092ac" 681 , "4d3ceb1a54770100000000feffffff02b8b4eb0b000000001976a914a457b6" 682 , "84d7f0d539a46a45bbc043f35b59d0d96388ac0008af2f000000001976a914" 683 , "fd270b1ee6abcaea97fea7ad0402e8bd8ad6d77c88ac92040000" 684 ] 685 case from_bytes rawTx of 686 Nothing -> H.assertFailure "failed to parse BIP143 tx" 687 Just tx -> do 688 let inputIdx = 0 689 -- scriptCode without length prefix 690 scriptCode = hex 691 "76a91479091972186c449eb1ded22b78e40d009bdf008988ac" 692 value = 1000000000 :: Word64 693 expected = hex 694 "64f3b0f4dd2bb3aa1ce8566d220cc74dda9df97d8490cc81d89d735c92e59fb6" 695 case sighash_segwit tx inputIdx scriptCode value 696 (encode_sighash SIGHASH_ALL) of 697 Nothing -> H.assertFailure "sighash_segwit returned Nothing" 698 Just result -> H.assertEqual "sighash mismatch" expected result 699 700 -- Arbitrary instances -------------------------------------------------------- 701 702 instance Arbitrary TxId where 703 arbitrary = maybe null_txid id . mk_txid . BS.pack <$> vectorOf 32 arbitrary 704 705 instance Arbitrary OutPoint where 706 arbitrary = OutPoint <$> arbitrary <*> arbitrary 707 708 instance Arbitrary TxIn where 709 arbitrary = TxIn 710 <$> arbitrary 711 <*> arbitraryScript 712 <*> arbitrary 713 <*> pure (Witness []) 714 715 instance Arbitrary TxOut where 716 arbitrary = TxOut 717 <$> arbitrary 718 <*> arbitraryScript 719 720 instance Arbitrary Witness where 721 arbitrary = Witness <$> listOf arbitraryScript 722 723 instance Arbitrary SighashType where 724 arbitrary = elements 725 [ SIGHASH_ALL 726 , SIGHASH_NONE 727 , SIGHASH_SINGLE 728 , SIGHASH_ALL_ANYONECANPAY 729 , SIGHASH_NONE_ANYONECANPAY 730 , SIGHASH_SINGLE_ANYONECANPAY 731 ] 732 733 -- | Generate arbitrary script-like bytestrings (0-200 bytes). 734 arbitraryScript :: Gen BS.ByteString 735 arbitraryScript = do 736 len <- chooseInt (0, 200) 737 BS.pack <$> vectorOf len arbitrary 738 739 -- | Generate a NonEmpty list of 1-5 items. 740 arbitraryNonEmpty :: Arbitrary a => Gen (NonEmpty a) 741 arbitraryNonEmpty = do 742 x <- arbitrary 743 xs <- listOf1to4 744 pure (x :| xs) 745 where 746 listOf1to4 = do 747 n <- chooseInt (0, 4) 748 vectorOf n arbitrary 749 750 -- | Generate a valid legacy transaction (no witnesses). 751 genLegacyTx :: Gen Tx 752 genLegacyTx = do 753 ver <- arbitrary 754 ins <- arbitraryNonEmpty 755 outs <- arbitraryNonEmpty 756 lt <- arbitrary 757 pure $ Tx ver ins outs lt 758 759 -- | Generate a valid segwit transaction (with witnesses). 760 genSegwitTx :: Gen Tx 761 genSegwitTx = do 762 ver <- arbitrary 763 ins <- arbitraryNonEmpty 764 outs <- arbitraryNonEmpty 765 -- One witness per input, at least one of them non-empty (a segwit 766 -- serialisation requires witness data) 767 let numInputs = NE.length ins 768 w0 <- Witness <$> listOf1 arbitraryScript 769 ws <- vectorOf (numInputs - 1) arbitrary 770 lt <- arbitrary 771 let set i w = i { txin_witness = w } 772 ins' = case ins of 773 i :| is -> set i w0 :| zipWith set is ws 774 pure $ Tx ver ins' outs lt 775 776 -- | Generate any valid transaction. 777 instance Arbitrary Tx where 778 arbitrary = oneof [genLegacyTx, genSegwitTx] 779 780 -- property tests ------------------------------------------------------------- 781 782 -- Round-trip: from_bytes (to_bytes tx) == Just tx 783 prop_roundtrip_bytes :: TestTree 784 prop_roundtrip_bytes = QC.testProperty "from_bytes . to_bytes == Just" $ 785 \tx -> from_bytes (to_bytes tx) === Just (tx :: Tx) 786 787 -- Round-trip: from_base16 (to_base16 tx) == Just tx 788 prop_roundtrip_base16 :: TestTree 789 prop_roundtrip_base16 = QC.testProperty "from_base16 . to_base16 == Just" $ 790 \tx -> from_base16 (to_base16 tx) === Just (tx :: Tx) 791 792 -- Legacy tx (no witnesses): to_bytes == to_bytes_legacy 793 prop_legacy_no_witnesses :: TestTree 794 prop_legacy_no_witnesses = 795 QC.testProperty "legacy tx: to_bytes == to_bytes_legacy" $ 796 forAll genLegacyTx $ \tx -> 797 to_bytes tx === to_bytes_legacy tx 798 799 -- Segwit tx: to_bytes is longer than to_bytes_legacy (when witnesses present) 800 prop_segwit_longer :: TestTree 801 prop_segwit_longer = 802 QC.testProperty "segwit tx: to_bytes longer than to_bytes_legacy" $ 803 forAll genSegwitTx $ \tx -> 804 BS.length (to_bytes tx) > BS.length (to_bytes_legacy tx) 805 806 -- TxId is always 32 bytes 807 prop_txid_32_bytes :: TestTree 808 prop_txid_32_bytes = QC.testProperty "txid is always 32 bytes" $ 809 \tx -> BS.length (un_txid (txid tx)) === 32 810 811 -- TxId ignores witnesses (same txid with or without witnesses) 812 prop_txid_ignores_witnesses :: TestTree 813 prop_txid_ignores_witnesses = 814 QC.testProperty "txid ignores witnesses" $ 815 forAll genSegwitTx $ \tx -> 816 let txNoWit = strip_witnesses tx 817 in txid tx === txid txNoWit 818 819 -- sighash_legacy always returns 32 bytes 820 prop_sighash_legacy_32_bytes :: TestTree 821 prop_sighash_legacy_32_bytes = 822 QC.testProperty "sighash_legacy is always 32 bytes" $ 823 forAll genLegacyTx $ \tx -> 824 forAll arbitraryScript $ \spk -> 825 forAll arbitrary $ \st -> 826 BS.length (sighash_legacy tx 0 spk (encode_sighash st)) === 32 827 828 -- sighash_segwit returns Just 32 bytes for any valid index 829 prop_sighash_segwit_32_bytes :: TestTree 830 prop_sighash_segwit_32_bytes = 831 QC.testProperty "sighash_segwit is 32 bytes for valid index" $ 832 forAll genSegwitTx $ \tx -> 833 let nIns = NE.length (tx_inputs tx) 834 in forAll (chooseInt (0, nIns - 1)) $ \idx -> 835 forAll arbitraryScript $ \sc -> 836 forAll (arbitrary :: Gen Word64) $ \val -> 837 forAll arbitrary $ \st -> 838 case sighash_segwit tx idx sc val (encode_sighash st) of 839 Nothing -> False -- should succeed for valid index 840 Just bs -> BS.length bs == 32 841 842 -- SIGHASH_SINGLE bug: returns 0x01 ++ 0x00*31 when index >= outputs 843 prop_sighash_single_bug :: TestTree 844 prop_sighash_single_bug = 845 QC.testProperty "SIGHASH_SINGLE bug when index >= outputs" $ 846 forAll genLegacyTx $ \tx -> 847 let numOutputs = NE.length (tx_outputs tx) 848 bugValue = BS.cons 0x01 (BS.replicate 31 0x00) 849 in forAll arbitraryScript $ \spk -> 850 sighash_legacy tx numOutputs spk 851 (encode_sighash SIGHASH_SINGLE) === bugValue 852 853 -- sighash_segwit: out-of-range index always returns Nothing 854 prop_sighash_segwit_oob :: TestTree 855 prop_sighash_segwit_oob = 856 QC.testProperty "sighash_segwit returns Nothing for oob index" $ 857 forAll genSegwitTx $ \tx -> 858 let nIns = NE.length (tx_inputs tx) 859 in forAll (chooseInt (nIns, nIns + 10)) $ \idx -> 860 forAll arbitraryScript $ \sc -> 861 forAll (arbitrary :: Gen Word64) $ \val -> 862 forAll arbitrary $ \st -> 863 sighash_segwit tx idx sc val (encode_sighash st) 864 === Nothing 865 866 -- ANYONECANPAY commits to only the signing input. Appending extra 867 -- inputs to the tx (without displacing index 0) must not change the 868 -- hash. 869 prop_sighash_legacy_acp_invariant :: TestTree 870 prop_sighash_legacy_acp_invariant = 871 QC.testProperty "SIGHASH_ALL|ANYONECANPAY ignores appended inputs" $ 872 forAll genLegacyTx $ \tx -> 873 forAll (QC.listOf1 (arbitrary :: Gen TxIn)) $ \extras -> 874 forAll arbitraryScript $ \spk -> 875 let tx' = tx { tx_inputs = appendInputs (tx_inputs tx) extras } 876 ht = encode_sighash SIGHASH_ALL_ANYONECANPAY 877 h1 = sighash_legacy tx 0 spk ht 878 h2 = sighash_legacy tx' 0 spk ht 879 in h1 === h2 880 881 -- SIGHASH_NONE strips outputs from the preimage. Appending extra 882 -- outputs must not change the hash. 883 prop_sighash_legacy_none_invariant :: TestTree 884 prop_sighash_legacy_none_invariant = 885 QC.testProperty "SIGHASH_NONE ignores appended outputs" $ 886 forAll genLegacyTx $ \tx -> 887 forAll (QC.listOf1 (arbitrary :: Gen TxOut)) $ \extras -> 888 forAll arbitraryScript $ \spk -> 889 let tx' = tx { tx_outputs = appendOutputs (tx_outputs tx) extras } 890 ht = encode_sighash SIGHASH_NONE 891 h1 = sighash_legacy tx 0 spk ht 892 h2 = sighash_legacy tx' 0 spk ht 893 in h1 === h2 894 895 -- SIGHASH_NONE|ANYONECANPAY ignores both other inputs and all outputs. 896 prop_sighash_legacy_none_acp_invariant :: TestTree 897 prop_sighash_legacy_none_acp_invariant = 898 QC.testProperty 899 "SIGHASH_NONE|ANYONECANPAY ignores appended inputs and outputs" $ 900 forAll genLegacyTx $ \tx -> 901 forAll (QC.listOf1 (arbitrary :: Gen TxIn)) $ \extraIns -> 902 forAll (QC.listOf1 (arbitrary :: Gen TxOut)) $ \extraOuts -> 903 forAll arbitraryScript $ \spk -> 904 let tx' = tx 905 { tx_inputs = appendInputs (tx_inputs tx) extraIns 906 , tx_outputs = appendOutputs (tx_outputs tx) extraOuts 907 } 908 ht = encode_sighash SIGHASH_NONE_ANYONECANPAY 909 h1 = sighash_legacy tx 0 spk ht 910 h2 = sighash_legacy tx' 0 spk ht 911 in h1 === h2 912 913 -- | Append items to a NonEmpty list. 914 appendInputs :: NonEmpty TxIn -> [TxIn] -> NonEmpty TxIn 915 appendInputs (x :| xs) extras = x :| (xs ++ extras) 916 917 appendOutputs :: NonEmpty TxOut -> [TxOut] -> NonEmpty TxOut 918 appendOutputs (x :| xs) extras = x :| (xs ++ extras) 919 920 -- compactSize non-minimal rejection ----------------------------------------- 921 922 -- Build a legacy tx whose input scriptSig length is encoded with a 923 -- non-minimal compactSize tag. We construct the bytes directly. 924 -- 925 -- Layout (legacy): 926 -- version(4) | n_inputs(compact) | outpoint(36) | scriptSig_len(compact) 927 -- | scriptSig | sequence(4) | n_outputs(compact) | outputs... | locktime(4) 928 -- 929 -- We use a 0-byte scriptSig but encode its length with a non-minimal tag. 930 nonMinimalLegacyTx :: BS.ByteString -> BS.ByteString 931 nonMinimalLegacyTx badLen = BS.concat 932 [ BS.pack [0x01, 0x00, 0x00, 0x00] -- version 1 933 , BS.pack [0x01] -- 1 input 934 , BS.replicate 32 0x00 -- outpoint txid 935 , BS.pack [0x00, 0x00, 0x00, 0x00] -- outpoint vout 936 , badLen -- non-minimal compactSize 937 , BS.pack [0xff, 0xff, 0xff, 0xff] -- sequence 938 , BS.pack [0x01] -- 1 output 939 , BS.replicate 8 0x00 -- value 940 , BS.pack [0x00] -- empty scriptPubKey 941 , BS.pack [0x00, 0x00, 0x00, 0x00] -- locktime 942 ] 943 944 test_compact_non_minimal_fd :: TestTree 945 test_compact_non_minimal_fd = 946 H.testCase "rejects 0xfd encoding of value < 0xfd" $ 947 H.assertEqual "should be Nothing" 948 Nothing 949 (from_bytes (nonMinimalLegacyTx (BS.pack [0xfd, 0x00, 0x00]))) 950 951 test_compact_non_minimal_fe :: TestTree 952 test_compact_non_minimal_fe = 953 H.testCase "rejects 0xfe encoding of value <= 0xffff" $ 954 H.assertEqual "should be Nothing" 955 Nothing 956 (from_bytes 957 (nonMinimalLegacyTx (BS.pack [0xfe, 0x00, 0x00, 0x00, 0x00]))) 958 959 test_compact_non_minimal_ff :: TestTree 960 test_compact_non_minimal_ff = 961 H.testCase "rejects 0xff encoding of value <= 0xffffffff" $ 962 H.assertEqual "should be Nothing" 963 Nothing 964 (from_bytes (nonMinimalLegacyTx 965 (BS.pack [0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00]))) 966 967 -- segwit txid known vector -------------------------------------------------- 968 969 -- Regression vector: txid of firstSegwitRaw, displayed big-endian. 970 firstSegwitTxId :: BS.ByteString 971 firstSegwitTxId = 972 "c586389e5e4b3acb9d6c8be1c19ae8ab2795397633176f5a6442a261bbdefc3a" 973 974 txid_first_segwit :: TestTree 975 txid_first_segwit = H.testCase "txid of first-segwit fixture" $ 976 case from_base16 firstSegwitRaw of 977 Nothing -> H.assertFailure "failed to parse tx" 978 Just tx -> do 979 let computed = un_txid (txid tx) 980 expected = BS.reverse (hex firstSegwitTxId) 981 H.assertEqual "txid mismatch" expected computed 982 983 -- BIP143 P2SH-P2WSH multi-sighash vectors ----------------------------------- 984 985 -- Shared fixture: unsigned tx, scriptCode, input index, value. 986 -- Source: https://github.com/bitcoin/bips/blob/master/bip-0143.mediawiki 987 p2shP2wshTx :: Tx 988 p2shP2wshTx = maybe placeholder_tx id (from_base16 p2shP2wshTxHex) 989 990 p2shP2wshTxHex :: BS.ByteString 991 p2shP2wshTxHex = mconcat 992 [ "010000000136641869ca081e70f394c6948e8af409e18b619df2ed74aa106c" 993 , "1ca29787b96e0100000000ffffffff0200e9a435000000001976a914389ffc" 994 , "e9cd9ae88dcc0631e88a821ffdbe9bfe2688acc0832f05000000001976a914" 995 , "7480a33f950689af511e6e84c138dbbd3c3ee41588ac00000000" 996 ] 997 998 -- | A minimal transaction standing in for a fixture that fails to parse 999 -- (which the "fixtures parse" test reports). 1000 placeholder_tx :: Tx 1001 placeholder_tx = Tx 1 1002 (TxIn (OutPoint null_txid 0) BS.empty 0 (Witness []) :| []) 1003 (TxOut 0 BS.empty :| []) 0 1004 1005 -- | A fixture txid: 32 copies of a byte. 1006 tid :: Word8 -> TxId 1007 tid w = maybe null_txid id (mk_txid (BS.replicate 32 w)) 1008 1009 -- | Clear every input's witness. 1010 strip_witnesses :: Tx -> Tx 1011 strip_witnesses tx = 1012 tx { tx_inputs = fmap (\i -> i { txin_witness = Witness [] }) 1013 (tx_inputs tx) } 1014 1015 p2shP2wshScriptCode :: BS.ByteString 1016 p2shP2wshScriptCode = hex $ mconcat 1017 [ "56210307b8ae49ac90a048e9b53357a2354b3334e9c8bee813ecb98e99a7e07e8c" 1018 , "3ba32103b28f0c28bfab54554ae8c658ac5c3e0ce6e79ad336331f78c428dd43ee" 1019 , "a8449b21034b8113d703413d57761b8b9781957b8c0ac1dfe69f492580ca4195f5" 1020 , "0376ba4a21033400f6afecb833092a9a21cfdf1ed1376e58c5d1f47de746831239" 1021 , "87e967a8f42103a6d48b1131e94ba04d9737d61acdaa1322008af9602b3b14862c" 1022 , "07a1789aac162102d8b661b0b3302ee2f162b09e07a55ad5dfbe673a9f01d9f0c1" 1023 , "9617681024306b56ae" 1024 ] 1025 1026 p2shP2wshValue :: Word64 1027 p2shP2wshValue = 987654321 -- 9.87654321 BTC 1028 1029 assertP2shP2wshSighash :: SighashType -> BS.ByteString -> H.Assertion 1030 assertP2shP2wshSighash st expectedHex = 1031 case sighash_segwit p2shP2wshTx 0 p2shP2wshScriptCode p2shP2wshValue 1032 (encode_sighash st) of 1033 Nothing -> H.assertFailure "sighash_segwit returned Nothing" 1034 Just res -> H.assertEqual "sighash mismatch" (hex expectedHex) res 1035 1036 bip143_p2sh_p2wsh_all :: TestTree 1037 bip143_p2sh_p2wsh_all = H.testCase "SIGHASH_ALL" $ 1038 assertP2shP2wshSighash SIGHASH_ALL 1039 "185c0be5263dce5b4bb50a047973c1b6272bfbd0103a89444597dc40b248ee7c" 1040 1041 bip143_p2sh_p2wsh_none :: TestTree 1042 bip143_p2sh_p2wsh_none = H.testCase "SIGHASH_NONE" $ 1043 assertP2shP2wshSighash SIGHASH_NONE 1044 "e9733bc60ea13c95c6527066bb975a2ff29a925e80aa14c213f686cbae5d2f36" 1045 1046 bip143_p2sh_p2wsh_single :: TestTree 1047 bip143_p2sh_p2wsh_single = H.testCase "SIGHASH_SINGLE" $ 1048 assertP2shP2wshSighash SIGHASH_SINGLE 1049 "1e1f1c303dc025bd664acb72e583e933fae4cff9148bf78c157d1e8f78530aea" 1050 1051 bip143_p2sh_p2wsh_all_acp :: TestTree 1052 bip143_p2sh_p2wsh_all_acp = H.testCase "SIGHASH_ALL|ANYONECANPAY" $ 1053 assertP2shP2wshSighash SIGHASH_ALL_ANYONECANPAY 1054 "2a67f03e63a6a422125878b40b82da593be8d4efaafe88ee528af6e5a9955c6e" 1055 1056 bip143_p2sh_p2wsh_none_acp :: TestTree 1057 bip143_p2sh_p2wsh_none_acp = H.testCase "SIGHASH_NONE|ANYONECANPAY" $ 1058 assertP2shP2wshSighash SIGHASH_NONE_ANYONECANPAY 1059 "781ba15f3779d5542ce8ecb5c18716733a5ee42a6f51488ec96154934e2c890a" 1060 1061 bip143_p2sh_p2wsh_single_acp :: TestTree 1062 bip143_p2sh_p2wsh_single_acp = H.testCase "SIGHASH_SINGLE|ANYONECANPAY" $ 1063 assertP2shP2wshSighash SIGHASH_SINGLE_ANYONECANPAY 1064 "511e8e52ed574121fc1b654970395502128263f62662e076dc6baf05c2e6a99b" 1065 1066 -- Bitcoin Core sighash.json legacy vectors ---------------------------------- 1067 1068 -- These exercise the raw 32-bit hashType code path. Bitcoin Core's 1069 -- sighash.json uses non-canonical hashType values that commit the full 1070 -- 32 bits to the preimage; the SighashType ADT can't construct them. 1071 -- 1072 -- Source: github.com/bitcoin/bitcoin src/test/data/sighash.json (first 1073 -- 20 entries). Expected hashes are stored big-endian (via 1074 -- uint256::GetHex) so we reverse before comparing. 1075 -- 1076 -- Bitcoin Core's hashType field is int32_t (signed); we cast to Word32. 1077 bcHashType :: Int32 -> Word32 1078 bcHashType = fromIntegral 1079 1080 -- | Run a Bitcoin-Core sighash.json legacy vector. 1081 bcSighashCase 1082 :: TestName 1083 -> BS.ByteString -- ^ raw tx hex 1084 -> BS.ByteString -- ^ scriptCode hex 1085 -> Int -- ^ input index 1086 -> Int32 -- ^ signed hashType 1087 -> BS.ByteString -- ^ expected hash hex (big-endian display) 1088 -> TestTree 1089 bcSighashCase name rawHex scriptHex idx ht expectedHex = 1090 H.testCase name $ 1091 case from_base16 rawHex of 1092 Nothing -> H.assertFailure "failed to parse tx" 1093 Just tx -> 1094 let result = sighash_legacy tx idx (hex scriptHex) (bcHashType ht) 1095 expected = BS.reverse (hex expectedHex) 1096 in H.assertEqual "sighash mismatch" expected result 1097 1098 bc_sighash_1 :: TestTree 1099 bc_sighash_1 = bcSighashCase 1100 "entry 1: idx=2, hashType=0x6f29291f (ALL)" 1101 (mconcat 1102 [ "907c2bc503ade11cc3b04eb2918b6f547b0630ab569273824748c87ea14b0696" 1103 , "526c66ba740200000004ab65ababfd1f9bdd4ef073c7afc4ae00da8a66f429c9" 1104 , "17a0081ad1e1dabce28d373eab81d8628de802000000096aab5253ab52000052" 1105 , "ad042b5f25efb33beec9f3364e8a9139e8439d9d7e26529c3c30b6c3fd89f868" 1106 , "4cfd68ea0200000009ab53526500636a52ab599ac2fe02a526ed040000000008" 1107 , "535300516352515164370e010000000003006300ab2ec229" 1108 ]) 1109 "" 1110 2 1111 1864164639 1112 "31af167a6cf3f9d5f6875caa4d31704ceb0eba078d132b78dab52c3b8997317e" 1113 1114 -- NOTE: raw hex is on a single line to avoid manual-splitting errors. 1115 bc_sighash_2 :: TestTree 1116 bc_sighash_2 = bcSighashCase 1117 "entry 2: idx=0, hashType=0xad118f9c (ALL|ACP)" 1118 "a0aa3126041621a6dea5b800141aa696daf28408959dfb2df96095db9fa425ad3f427f2f6103000000015360290e9c6063fa26912c2e7fb6a0ad80f1c5fea1771d42f12976092e7a85a4229fdb6e890000000001abc109f6e47688ac0e4682988785744602b8c87228fcef0695085edf19088af1a9db126e93000000000665516aac536affffffff8fe53e0806e12dfd05d67ac68f4768fdbe23fc48ace22a5aa8ba04c96d58e2750300000009ac51abac63ab5153650524aa680455ce7b000000000000499e50030000000008636a00ac526563ac5051ee030000000003abacabd2b6fe000000000003516563910fb6b5" 1119 "65" 1120 0 1121 (-1391424484) 1122 "48d6a1bd2cd9eec54eb866fc71209418a950402b5d7e52363bfb75c98e141175" 1123 1124 bc_sighash_4 :: TestTree 1125 bc_sighash_4 = bcSighashCase 1126 "entry 4: idx=1, hashType=0x46fb4ce9 (ALL|ACP)" 1127 (mconcat 1128 [ "73107cbd025c22ebc8c3e0a47b2a760739216a528de8d4dab5d45cbeb3051ceb" 1129 , "ae73b01ca10200000007ab6353656a636affffffffe26816dffc670841e6a6c8" 1130 , "c61c586da401df1261a330a6c6b3dd9f9a0789bc9e000000000800ac6552ac6a" 1131 , "ac51ffffffff0174a8f0010000000004ac52515100000000" 1132 ]) 1133 "5163ac63635151ac" 1134 1 1135 1190874345 1136 "06e328de263a87b09beabe222a21627a6ea5c7f560030da31610c4611f4a46bc" 1137 1138 bc_sighash_9 :: TestTree 1139 bc_sighash_9 = bcSighashCase 1140 "entry 9: idx=0, hashType=0x8b07e3c3 (SINGLE|ACP)" 1141 (mconcat 1142 [ "d3b7421e011f4de0f1cea9ba7458bf3486bee722519efab711a963fa8c100970" 1143 , "cf7488b7bb0200000003525352dcd61b300148be5d05000000000000000000" 1144 ]) 1145 "535251536aac536a" 1146 0 1147 (-1960128125) 1148 "29aa6d2d752d3310eba20442770ad345b7f6a35f96161ede5f07b33e92053e2a" 1149 1150 bc_sighash_14 :: TestTree 1151 bc_sighash_14 = bcSighashCase 1152 "entry 14: idx=1, hashType=0x9604e295 (ALL|ACP, strips 2x 0xab)" 1153 "f40a750702af06efff3ea68e5d56e42bc41cdb8b6065c98f1221fe04a325a898cb61f3d7ee030000000363acacffffffffb5788174aef79788716f96af779d7959147a0c2e0e5bfb6c2dba2df5b4b97894030000000965510065535163ac6affffffff0445e6fd0200000000096aac536365526a526aa6546b000000000008acab656a6552535141a0fd010000000000c897ea030000000008526500ab526a6a631b39dba3" 1154 "00abab5163ac" 1155 1 1156 (-1778064747) 1157 "d76d0fc0abfa72d646df888bce08db957e627f72962647016eeae5a8412354cf" 1158 1159 bc_sighash_20 :: TestTree 1160 bc_sighash_20 = bcSighashCase 1161 "entry 20: idx=0, hashType=0xcab2f825 (ALL)" 1162 (mconcat 1163 [ "c2b0b99001acfecf7da736de0ffaef8134a9676811602a6299ba5a2563a23bb0" 1164 , "9e8cbedf9300000000026300ffffffff042997c50300000000045252536a2724" 1165 , "37030000000007655353ab6363ac663752030000000002ab6a6d5c9000000000" 1166 , "00066a6a5265abab00000000" 1167 ]) 1168 "52ac525163515251" 1169 0 1170 (-894181723) 1171 "8b300032a1915a4ac05cea2f7d44c26f2a08d109a71602636f15866563eaafdc" 1172 1173 -- strip_codeseparators tests ------------------------------------------------- 1174 1175 -- A script containing 0x00, OP_1, OP_IF, OP_CHECKSIG and no 0xab. Strip 1176 -- should be a no-op. 1177 codesep_no_op :: TestTree 1178 codesep_no_op = H.testCase "no 0xab: unchanged" $ 1179 H.assertEqual "" (BS.pack [0x00, 0x51, 0x63, 0xac]) 1180 (strip_codeseparators (BS.pack [0x00, 0x51, 0x63, 0xac])) 1181 1182 -- Two OP_CODESEPARATOR bytes in opcode position get stripped. 1183 codesep_strip_simple :: TestTree 1184 codesep_strip_simple = H.testCase "0xab at opcode position stripped" $ 1185 H.assertEqual "" (BS.pack [0x00, 0x51, 0x63, 0xac]) 1186 (strip_codeseparators (BS.pack [0x00, 0xab, 0xab, 0x51, 0x63, 0xac])) 1187 1188 -- A direct push (opcode 0x02) of two 0xab bytes: data preserved. 1189 codesep_inside_push :: TestTree 1190 codesep_inside_push = H.testCase "0xab inside push data preserved" $ 1191 let s = BS.pack [0x02, 0xab, 0xab, 0x51] -- push 2 bytes, then OP_1 1192 in H.assertEqual "" s (strip_codeseparators s) 1193 1194 -- OP_PUSHDATA1 with 3 bytes of 0xab, followed by a lone 0xab opcode and 1195 -- OP_1. The data must be preserved; the trailing 0xab opcode stripped. 1196 codesep_inside_pushdata1 :: TestTree 1197 codesep_inside_pushdata1 = 1198 H.testCase "OP_PUSHDATA1 data preserved, trailing 0xab stripped" $ 1199 let input = BS.pack [0x4c, 0x03, 0xab, 0xab, 0xab, 0xab, 0x51] 1200 expected = BS.pack [0x4c, 0x03, 0xab, 0xab, 0xab, 0x51] 1201 in H.assertEqual "" expected (strip_codeseparators input) 1202 1203 -- OP_PUSHDATA2 with 2 bytes of 0xab data (LE length = 0x0002), then a 1204 -- lone 0xab opcode and OP_1. Exercises the n0 + n1 * 0x100 arithmetic. 1205 codesep_inside_pushdata2 :: TestTree 1206 codesep_inside_pushdata2 = 1207 H.testCase "OP_PUSHDATA2 data preserved, trailing 0xab stripped" $ 1208 let input = BS.pack [0x4d, 0x02, 0x00, 0xab, 0xab, 0xab, 0x51] 1209 expected = BS.pack [0x4d, 0x02, 0x00, 0xab, 0xab, 0x51] 1210 in H.assertEqual "" expected (strip_codeseparators input) 1211 1212 -- OP_PUSHDATA4 with 1 byte of 0xab data (LE length = 0x00000001), then 1213 -- a lone 0xab opcode. Exercises the 4-byte LE length decode. 1214 codesep_inside_pushdata4 :: TestTree 1215 codesep_inside_pushdata4 = 1216 H.testCase "OP_PUSHDATA4 data preserved, trailing 0xab stripped" $ 1217 let input = BS.pack [0x4e, 0x01, 0x00, 0x00, 0x00, 0xab, 0xab, 0x51] 1218 expected = BS.pack [0x4e, 0x01, 0x00, 0x00, 0x00, 0xab, 0x51] 1219 in H.assertEqual "" expected (strip_codeseparators input) 1220 1221 -- Malformed tail: OP_PUSHDATA2 with a truncated length header (only 1222 -- one byte available). Per docstring, copied verbatim. 1223 codesep_malformed_tail :: TestTree 1224 codesep_malformed_tail = 1225 H.testCase "malformed tail copied verbatim" $ 1226 let input = BS.pack [0x4d, 0x00] 1227 in H.assertEqual "" input (strip_codeseparators input) 1228 1229 -- | Arbitrary ByteString generator (QuickCheck has no built-in instance). 1230 genByteString :: Gen BS.ByteString 1231 genByteString = BS.pack <$> arbitrary 1232 1233 prop_strip_codesep_idempotent :: TestTree 1234 prop_strip_codesep_idempotent = 1235 QC.testProperty "strip_codeseparators is idempotent" $ 1236 forAll genByteString $ \s -> 1237 strip_codeseparators (strip_codeseparators s) 1238 === strip_codeseparators s 1239 1240 prop_strip_codesep_no_0xab_unchanged :: TestTree 1241 prop_strip_codesep_no_0xab_unchanged = 1242 QC.testProperty "strip_codeseparators is no-op without 0xab bytes" $ 1243 forAll (resize 500 $ BS.pack . filter (/= 0xab) <$> arbitrary) $ \s -> 1244 strip_codeseparators s === s 1245 1246 -- BIP341 taproot test vectors ----------------------------------------------- 1247 1248 -- Shared fixture: 9-input / 2-output transaction from BIP341 1249 -- wallet-test-vectors.json (keyPathSpending[0]). 1250 bip341Tx :: Tx 1251 bip341Tx = maybe placeholder_tx id (from_base16 bip341TxHex) 1252 1253 bip341TxHex :: BS.ByteString 1254 bip341TxHex = 1255 "020000000001097de20cbff686da83a54981d2b9bab3586f4ca7e48f57f5b55963115f3b334e9c010000000000000000d7b7cab57b1393ace2d064f4d4a2cb8af6def61273e127517d44759b6dafdd990000000000fffffffff8e1f583384333689228c5d28eac13366be082dc57441760d957275419a41842000000006b4830450221008f3b8f8f0537c420654d2283673a761b7ee2ea3c130753103e08ce79201cf32a022079e7ab904a1980ef1c5890b648c8783f4d10103dd62f740d13daa79e298d50c201210279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798fffffffff0689180aa63b30cb162a73c6d2a38b7eeda2a83ece74310fda0843ad604853b0100000000feffffffaa5202bdf6d8ccd2ee0f0202afbbb7461d9264a25e5bfd3c5a52ee1239e0ba6c0000000000feffffff956149bdc66faa968eb2be2d2faa29718acbfe3941215893a2a3446d32acd050000000000000000000e664b9773b88c09c32cb70a2a3e4da0ced63b7ba3b22f848531bbb1d5d5f4c94010000000000000000e9aa6b8e6c9de67619e6a3924ae25696bb7b694bb677a632a74ef7eadfd4eabf0000000000ffffffffa778eb6a263dc090464cd125c466b5a99667720b1c110468831d058aa1b82af10100000000ffffffff0200ca9a3b000000001976a91406afd46bcdfd22ef94ac122aa11f241244a37ecc88ac807840cb0000000020ac9a87f5594be208f8532db38cff670c450ed2fea8fcdefcc9a663f78bab962b0141ed7c1647cb97379e76892be0cacff57ec4a7102aa24296ca39af7541246d8ff14d38958d4cc1e2e478e4d4a764bbfd835b16d4e314b72937b29833060b87276c030141052aedffc554b41f52b521071793a6b88d6dbca9dba94cf34c83696de0c1ec35ca9c5ed4ab28059bd606a4f3a657eec0bb96661d42921b5f50a95ad33675b54f83000141ff45f742a876139946a149ab4d9185574b98dc919d2eb6754f8abaa59d18b025637a3aa043b91817739554f4ed2026cf8022dbd83e351ce1fabc272841d2510a010140b4010dd48a617db09926f729e79c33ae0b4e94b79f04a1ae93ede6315eb3669de185a17d2b0ac9ee09fd4c64b678a0b61a0a86fa888a273c8511be83bfd6810f0247304402202b795e4de72646d76eab3f0ab27dfa30b810e856ff3a46c9a702df53bb0d8cc302203ccc4d822edab5f35caddb10af1be93583526ccfbade4b4ead350781e2f8adcd012102f9308a019258c31049344f85f89d5229b531c845836f99b08601f113bce036f90141a3785919a2ce3c4ce26f298c3d51619bc474ae24014bcdd31328cd8cfbab2eff3395fa0a16fe5f486d12f22a9cedded5ae74feb4bbe5351346508c5405bcfee0020141ea0c6ba90763c2d3a296ad82ba45881abb4f426b3f87af162dd24d5109edc1cdd11915095ba47c3a9963dc1e6c432939872bc49212fe34c632cd3ab9fed429c4820141bbc9584a11074e83bc8c6759ec55401f0ae7b03ef290c3139814f545b58a9f8127258000874f44bc46db7646322107d4d86aec8e73b8719a61fff761d75b5dd9810065cd1d" 1256 1257 -- Amounts and scriptPubKeys for the 9 prevouts, in order. 1258 bip341Amounts :: [Word64] 1259 bip341Amounts = 1260 [ 420000000, 462000000, 294000000, 504000000, 630000000 1261 , 378000000, 672000000, 546000000, 588000000 1262 ] 1263 1264 bip341Spks :: [BS.ByteString] 1265 bip341Spks = map hex 1266 [ "512053a1f6e454df1aa2776a2814a721372d6258050de330b3c6d10ee8f4e0dda343" 1267 , "5120147c9c57132f6e7ecddba9800bb0c4449251c92a1e60371ee77557b6620f3ea3" 1268 , "76a914751e76e8199196d454941c45d1b3a323f1433bd688ac" 1269 , "5120e4d810fd50586274face62b8a807eb9719cef49c04177cc6b76a9a4251d5450e" 1270 , "512091b64d5324723a985170e4dc5a0f84c041804f2cd12660fa5dec09fc21783605" 1271 , "00147dd65592d0ab2fe0d0257d571abf032cd9db93dc" 1272 , "512075169f4001aa68f15bbed28b218df1d0a62cbbcf1188c6665110c293c907b831" 1273 , "5120712447206d7a5238acc7ff53fbe94a3b64539ad291c7cdbc490b7577e4b17df5" 1274 , "512077e30a5522dd9f894c3f8b8bd4c4b2cf82ca7da8a3ea6a239655c39c050ab220" 1275 ] 1276 1277 -- | Run a BIP341 key-path vector against bip341Tx. 1278 bip341Case :: TestName -> Int -> Word8 -> BS.ByteString -> TestTree 1279 bip341Case name idx ht expectedHex = 1280 H.testCase name $ 1281 case sighash_taproot_keypath bip341Tx idx 1282 bip341Amounts bip341Spks Nothing ht of 1283 Nothing -> H.assertFailure "sighash_taproot_keypath returned Nothing" 1284 Just res -> H.assertEqual "sighash mismatch" (hex expectedHex) res 1285 1286 bip341_kp_in0_single :: TestTree 1287 bip341_kp_in0_single = bip341Case 1288 "idx=0, hashType=0x03 (SINGLE)" 0 0x03 1289 "2514a6272f85cfa0f45eb907fcb0d121b808ed37c6ea160a5a9046ed5526d555" 1290 1291 bip341_kp_in1_single_acp :: TestTree 1292 bip341_kp_in1_single_acp = bip341Case 1293 "idx=1, hashType=0x83 (SINGLE|ACP)" 1 0x83 1294 "325a644af47e8a5a2591cda0ab0723978537318f10e6a63d4eed783b96a71a4d" 1295 1296 bip341_kp_in3_all :: TestTree 1297 bip341_kp_in3_all = bip341Case 1298 "idx=3, hashType=0x01 (ALL)" 3 0x01 1299 "bf013ea93474aa67815b1b6cc441d23b64fa310911d991e713cd34c7f5d46669" 1300 1301 bip341_kp_in4_default :: TestTree 1302 bip341_kp_in4_default = bip341Case 1303 "idx=4, hashType=0x00 (DEFAULT)" 4 0x00 1304 "4f900a0bae3f1446fd48490c2958b5a023228f01661cda3496a11da502a7f7ef" 1305 1306 bip341_kp_in6_none :: TestTree 1307 bip341_kp_in6_none = bip341Case 1308 "idx=6, hashType=0x02 (NONE)" 6 0x02 1309 "15f25c298eb5cdc7eb1d638dd2d45c97c4c59dcaec6679cfc16ad84f30876b85" 1310 1311 bip341_kp_in7_none_acp :: TestTree 1312 bip341_kp_in7_none_acp = bip341Case 1313 "idx=7, hashType=0x82 (NONE|ACP)" 7 0x82 1314 "cd292de50313804dabe4685e83f923d2969577191a3e1d2882220dca88cbeb10" 1315 1316 bip341_kp_in8_all_acp :: TestTree 1317 bip341_kp_in8_all_acp = bip341Case 1318 "idx=8, hashType=0x81 (ALL|ACP)" 8 0x81 1319 "cccb739eca6c13a8a89e6e5cd317ffe55669bbda23f2fd37b0f18755e008edd2" 1320 1321 -- taproot validation tests -------------------------------------------------- 1322 1323 -- A tiny well-formed taproot context for negative tests. 1324 tinyTaprootTx :: Tx 1325 tinyTaprootTx = Tx 1326 { tx_version = 2 1327 , tx_inputs = txin :| [] 1328 , tx_outputs = txout :| [] 1329 , tx_locktime = 0 1330 } 1331 where 1332 txin = TxIn 1333 { txin_prevout = OutPoint (tid 0xab) 0 1334 , txin_script_sig = BS.empty 1335 , txin_sequence = 0xffffffff 1336 , txin_witness = Witness [] 1337 } 1338 txout = TxOut 1339 { txout_value = 1000 1340 , txout_script_pubkey = hex "5120" <> BS.replicate 32 0x00 1341 } 1342 1343 tinyAmts :: [Word64] 1344 tinyAmts = [100000] 1345 1346 tinySpks :: [BS.ByteString] 1347 tinySpks = [hex "5120" <> BS.replicate 32 0x00] 1348 1349 taproot_invalid_ht :: TestTree 1350 taproot_invalid_ht = 1351 H.testCase "rejects non-canonical hashType (0x04)" $ 1352 H.assertEqual "should be Nothing" Nothing $ 1353 sighash_taproot_keypath tinyTaprootTx 0 tinyAmts tinySpks Nothing 0x04 1354 1355 taproot_invalid_idx :: TestTree 1356 taproot_invalid_idx = 1357 H.testCase "rejects out-of-range input index" $ 1358 H.assertEqual "should be Nothing" Nothing $ 1359 sighash_taproot_keypath tinyTaprootTx 7 tinyAmts tinySpks Nothing 0x00 1360 1361 taproot_amounts_mismatch :: TestTree 1362 taproot_amounts_mismatch = 1363 H.testCase "rejects amounts length mismatch" $ 1364 H.assertEqual "should be Nothing" Nothing $ 1365 sighash_taproot_keypath tinyTaprootTx 0 [] tinySpks Nothing 0x00 1366 1367 taproot_spks_mismatch :: TestTree 1368 taproot_spks_mismatch = 1369 H.testCase "rejects scriptPubKeys length mismatch" $ 1370 H.assertEqual "should be Nothing" Nothing $ 1371 sighash_taproot_keypath tinyTaprootTx 0 tinyAmts [] Nothing 0x00 1372 1373 taproot_bad_annex_prefix :: TestTree 1374 taproot_bad_annex_prefix = 1375 H.testCase "rejects annex without 0x50 prefix" $ 1376 H.assertEqual "should be Nothing" Nothing $ 1377 sighash_taproot_keypath tinyTaprootTx 0 tinyAmts tinySpks 1378 (Just (BS.pack [0xff, 0xaa])) 0x00 1379 1380 taproot_empty_annex :: TestTree 1381 taproot_empty_annex = 1382 H.testCase "rejects empty annex" $ 1383 H.assertEqual "should be Nothing" Nothing $ 1384 sighash_taproot_keypath tinyTaprootTx 0 tinyAmts tinySpks 1385 (Just BS.empty) 0x00 1386 1387 taproot_short_leaf_hash :: TestTree 1388 taproot_short_leaf_hash = 1389 H.testCase "scriptpath rejects non-32-byte tap leaf hash" $ 1390 H.assertEqual "should be Nothing" Nothing $ 1391 sighash_taproot_scriptpath tinyTaprootTx 0 tinyAmts tinySpks Nothing 1392 (BS.replicate 31 0x00) 0xffffffff 0x00 1393 1394 -- BIP341: SIGHASH_SINGLE without a corresponding output is rejected. 1395 -- tinyTaprootTx has 1 output; idx=0 is in range, so use a 2-input tx 1396 -- and index the second input with SINGLE (no output 1). 1397 taproot_single_oob :: TestTree 1398 taproot_single_oob = 1399 H.testCase "rejects SIGHASH_SINGLE with idx >= n_outputs" $ 1400 let txin2 = TxIn 1401 { txin_prevout = OutPoint (tid 0xcd) 0 1402 , txin_script_sig = BS.empty 1403 , txin_sequence = 0xffffffff 1404 , txin_witness = Witness [] 1405 } 1406 tx2 = tinyTaprootTx 1407 { tx_inputs = (NE.head (tx_inputs tinyTaprootTx)) :| [txin2] } 1408 amts = [100000, 200000] 1409 spks = tinySpks ++ tinySpks 1410 in H.assertEqual "should be Nothing" Nothing $ 1411 sighash_taproot_keypath tx2 1 amts spks Nothing 0x03 1412 1413 -- rust-bitcoin script-path vector ------------------------------------------- 1414 1415 -- Source: rust-bitcoin bitcoin/src/crypto/sighash.rs, 1416 -- sighashes_with_script_path_raw_hash test. P2TR input, ALL hashType, 1417 -- precomputed tap leaf hash, default codesep position. 1418 -- NOTE: raw hex on a single line to avoid manual-splitting errors. 1419 rb_script_path_all :: TestTree 1420 rb_script_path_all = H.testCase 1421 "script-path, hashType=0x01 (ALL), default codesep" $ do 1422 let rawTx = "020000000189fc651483f9296b906455dd939813bf086b1bbe7c77635e157c8e14ae29062195010000004445b5c7044561320000000000160014331414dbdada7fb578f700f38fb69995fc9b5ab958020000000000001976a914268db0a8104cc6d8afd91233cc8b3d1ace8ac3ef88ac580200000000000017a914ec00dcb368d6a693e11986d265f659d2f59e8be2875802000000000000160014c715799a49a0bae3956df9c17cb4440a673ac0df6f010000" 1423 amount = 3468315 :: Word64 -- 0x000000000034ec1b LE 1424 spk = hex 1425 "512028055142ea437db73382e991861446040b61dd2185c4891d7daf6893d79f7182" 1426 leaf = hex 1427 "15a2530514e399f8b5cf0b3d3112cf5b289eaa3e308ba2071b58392fdc6da68a" 1428 expected = hex 1429 "d66de5274a60400c7b08c86ba6b7f198f40660079edf53aca89d2a9501317f2e" 1430 case from_base16 rawTx of 1431 Nothing -> H.assertFailure "failed to parse tx" 1432 Just tx -> 1433 case sighash_taproot_scriptpath tx 0 [amount] [spk] Nothing 1434 leaf 0xffffffff 0x01 of 1435 Nothing -> 1436 H.assertFailure "sighash_taproot_scriptpath returned Nothing" 1437 Just res -> H.assertEqual "sighash mismatch" expected res 1438 1439 -- taproot properties -------------------------------------------------------- 1440 1441 -- | 32-byte tap leaf hash generator. 1442 genTapLeaf :: Gen BS.ByteString 1443 genTapLeaf = BS.pack <$> vectorOf 32 arbitrary 1444 1445 -- key-path and script-path differ in spend_type (0 vs 2) and in the 1446 -- 37-byte tail appended for script-path. Hashes must differ for any 1447 -- choice of leaf hash and codeseparator position. 1448 prop_taproot_keypath_neq_scriptpath :: TestTree 1449 prop_taproot_keypath_neq_scriptpath = 1450 QC.testProperty "taproot key-path /= script-path for any leaf, csep" $ 1451 forAll genTapLeaf $ \leaf -> 1452 forAll (arbitrary :: Gen Word32) $ \csep -> 1453 let kp = sighash_taproot_keypath bip341Tx 0 1454 bip341Amounts bip341Spks Nothing 0x00 1455 sp = sighash_taproot_scriptpath bip341Tx 0 1456 bip341Amounts bip341Spks Nothing leaf csep 0x00 1457 in kp =/= sp 1458 1459 -- Different codeseparator positions commit to different preimages. 1460 prop_taproot_csep_changes_hash :: TestTree 1461 prop_taproot_csep_changes_hash = 1462 QC.testProperty "taproot script-path: distinct csep => distinct hash" $ 1463 forAll genTapLeaf $ \leaf -> 1464 forAll (arbitrary :: Gen (Word32, Word32)) $ \(c1, c2) -> 1465 c1 /= c2 ==> 1466 let mk c = sighash_taproot_scriptpath bip341Tx 0 1467 bip341Amounts bip341Spks Nothing leaf c 0x01 1468 in mk c1 =/= mk c2 1469 1470 -- | Annex generator: arbitrary payload prefixed with the mandatory 1471 -- 0x50 byte. 1472 genAnnex :: Gen BS.ByteString 1473 genAnnex = do 1474 payload <- resize 64 arbitrary 1475 pure (BS.cons 0x50 (BS.pack payload)) 1476 1477 -- Distinct well-formed annexes produce distinct sighashes, confirming 1478 -- the annex bytes are committed to the preimage. 1479 prop_taproot_annex_commits :: TestTree 1480 prop_taproot_annex_commits = 1481 QC.testProperty "taproot distinct annexes yield distinct hashes" $ 1482 forAll genAnnex $ \a1 -> 1483 forAll genAnnex $ \a2 -> 1484 a1 /= a2 ==> 1485 let mk a = sighash_taproot_keypath bip341Tx 0 1486 bip341Amounts bip341Spks (Just a) 0x01 1487 in mk a1 =/= mk a2 1488 1489 -- ANYONECANPAY omits sha_prevouts, sha_amounts, sha_scriptpubkeys, and 1490 -- sha_sequences from the preimage. Permuting the OTHER (non-signing) 1491 -- entries in amounts and scriptPubKeys must not change the hash. 1492 prop_taproot_acp_ignores_other_inputs :: TestTree 1493 prop_taproot_acp_ignores_other_inputs = 1494 QC.testProperty "taproot ACP ignores other inputs' amounts/spks" $ 1495 let idx = 0 1496 ht = 0x81 :: Word8 -- ALL|ACP 1497 h1 = sighash_taproot_keypath bip341Tx idx 1498 bip341Amounts bip341Spks Nothing ht 1499 -- Mutate the *other* amounts and scriptPubKeys arbitrarily. 1500 mutAmts = take 1 bip341Amounts ++ map (* 7) (drop 1 bip341Amounts) 1501 mutSpks = take 1 bip341Spks 1502 ++ map (BS.cons 0xff) (drop 1 bip341Spks) 1503 h2 = sighash_taproot_keypath bip341Tx idx 1504 mutAmts mutSpks Nothing ht 1505 in h1 === h2 1506 1507 -- For NONE (no SINGLE bit), sha_outputs is omitted. Appending extra 1508 -- outputs to the tx must not change the hash. 1509 prop_taproot_none_ignores_outputs :: TestTree 1510 prop_taproot_none_ignores_outputs = 1511 QC.testProperty "taproot NONE ignores appended outputs" $ 1512 forAll (QC.listOf1 (arbitrary :: Gen TxOut)) $ \extras -> 1513 let idx = 6 1514 ht = 0x02 :: Word8 -- NONE 1515 tx' = bip341Tx 1516 { tx_outputs = appendOutputs (tx_outputs bip341Tx) extras } 1517 h1 = sighash_taproot_keypath bip341Tx idx 1518 bip341Amounts bip341Spks Nothing ht 1519 h2 = sighash_taproot_keypath tx' idx 1520 bip341Amounts bip341Spks Nothing ht 1521 in h1 === h2 1522