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