commit a262ca7229f32df1d4115f3dc88f97c25aa2b252
parent b8ac52c57913728e7179337b2866aea58f330356
Author: Jared Tobin <jared@jtobin.io>
Date: Sun, 17 May 2026 08:36:38 -0230
Merge branch 'beef-tests'
Release-readiness work on the sighash module and the test/bench suite.
Three logical commits:
031cb97 sighash: widen API to take 32-bit hashType; expand coverage
8794de1 sighash: strip OP_CODESEPARATOR in legacy preimage
1deaeff sighash: address review feedback on codeseparator strip
API change (Bitcoin.Prim.Tx.Sighash)
-----------------------------------
sighash_legacy and sighash_segwit now take the raw 32-bit hashType
that gets committed verbatim to the signature preimage, matching
Bitcoin consensus (the full Word32 is committed; only the low byte
determines behaviour - low 5 bits select base, bit 0x80 selects
ANYONECANPAY). The SighashType ADT remains the canonical-byte enum;
new encode_sighash :: SighashType -> Word32 bridges the two.
Internally, dispatch now uses a private BaseType
(BaseAll | BaseNone | BaseSingle) keyed off the low byte, replacing
the previous SighashType-based pattern matching.
Consensus fix
-------------
serialize_legacy_sighash now strips every OP_CODESEPARATOR (0xab)
opcode from the scriptCode before hashing, matching Bitcoin Core's
CTransactionSignatureSerializer::SerializeScriptCode. A new
strip_codeseparators :: ByteString -> ByteString helper walks
opcodes, properly skipping push-data sections so that 0xab bytes
appearing inside data pushes are preserved. The BIP143 segwit path
is unchanged (per spec, codeseparator trimming there is the
caller's responsibility).
Tests (31 -> 60)
----------------
- BIP143 P2SH-P2WSH multi-sighash vectors (6 variants on one
fixture)
- First-segwit fixture txid regression vector
- compactSize non-minimal-encoding rejection
- sighash_segwit out-of-range index property
- Legacy sighash spec-invariant properties (ACP ignores appended
inputs; NONE ignores appended outputs; NONE|ACP ignores both)
- Five Bitcoin Core sighash.json legacy vectors exercising
non-canonical 32-bit hashType values
- OP_CODESEPARATOR strip unit tests covering direct push,
OP_PUSHDATA1/2/4, and malformed-tail handling
- Properties: strip is idempotent; strip is a no-op when input
contains no 0xab byte (resize 500 for longer scripts)
- Re-added BC sighash.json entry 14, whose scriptCode contains
two embedded OP_CODESEPARATOR bytes (validates the strip)
Benches
-------
- sighash_legacy and sighash_segwit added to criterion and weigh,
covering small/medium/large transactions across ALL/NONE/SINGLE
and ALL|ACP hash types
Notes for users
---------------
- Existing callers passing SighashType must wrap with
encode_sighash, e.g. sighash_legacy tx i spk SIGHASH_ALL becomes
sighash_legacy tx i spk (encode_sighash SIGHASH_ALL)
- sighash_legacy does not validate idx; an out-of-range index
produces a deterministic but consensus-undefined hash. This
matches Bitcoin Core (which asserts on the same precondition).
Contrast sighash_segwit, which validates and returns Nothing
Diffstat:
| M | bench/Main.hs | | | 52 | ++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| M | bench/Weight.hs | | | 45 | +++++++++++++++++++++++++++++++++++++++++++++ |
| M | lib/Bitcoin/Prim/Tx/Sighash.hs | | | 207 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++------------------------- |
| M | test/Main.hs | | | 452 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--- |
4 files changed, 677 insertions(+), 79 deletions(-)
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -7,6 +7,7 @@ import Control.DeepSeq
import Criterion.Main
import qualified Data.ByteString as BS
import Data.List.NonEmpty (NonEmpty(..))
+import Data.Word (Word64)
import Bitcoin.Prim.Tx
import Bitcoin.Prim.Tx.Sighash
@@ -97,6 +98,20 @@ smallSegwitBytes = to_bytes smallSegwitTx
mediumSegwitBytes = to_bytes mediumSegwitTx
largeSegwitBytes = to_bytes largeSegwitTx
+-- sighash inputs --------------------------------------------------------------
+
+-- | Typical P2PKH scriptPubKey (25 bytes).
+sampleScriptPubKey :: BS.ByteString
+sampleScriptPubKey = BS.replicate 25 0x00
+
+-- | Typical P2WPKH scriptCode (26 bytes).
+sampleScriptCode :: BS.ByteString
+sampleScriptCode = BS.replicate 26 0x00
+
+-- | Sample input value (1 BTC in satoshis).
+sampleValue :: Word64
+sampleValue = 100000000
+
-- benchmarks ------------------------------------------------------------------
main :: IO ()
@@ -135,4 +150,41 @@ main = defaultMain
, bench "large-legacy" $ nf txid largeLegacyTx
, bench "large-segwit" $ nf txid largeSegwitTx
]
+ , bgroup "sighash"
+ [ bgroup "sighash_legacy"
+ [ bench "small / SIGHASH_ALL" $
+ nf (sighashLegacy smallLegacyTx SIGHASH_ALL) 0
+ , bench "medium / SIGHASH_ALL" $
+ nf (sighashLegacy mediumLegacyTx SIGHASH_ALL) 0
+ , bench "large / SIGHASH_ALL" $
+ nf (sighashLegacy largeLegacyTx SIGHASH_ALL) 0
+ , bench "medium / SIGHASH_NONE" $
+ nf (sighashLegacy mediumLegacyTx SIGHASH_NONE) 0
+ , bench "medium / SIGHASH_SINGLE" $
+ nf (sighashLegacy mediumLegacyTx SIGHASH_SINGLE) 0
+ , bench "medium / SIGHASH_ALL|ACP" $
+ nf (sighashLegacy mediumLegacyTx
+ SIGHASH_ALL_ANYONECANPAY) 0
+ ]
+ , bgroup "sighash_segwit"
+ [ bench "small / SIGHASH_ALL" $
+ nf (sighashSegwit smallSegwitTx SIGHASH_ALL) 0
+ , bench "medium / SIGHASH_ALL" $
+ nf (sighashSegwit mediumSegwitTx SIGHASH_ALL) 0
+ , bench "large / SIGHASH_ALL" $
+ nf (sighashSegwit largeSegwitTx SIGHASH_ALL) 0
+ , bench "medium / SIGHASH_NONE" $
+ nf (sighashSegwit mediumSegwitTx SIGHASH_NONE) 0
+ , bench "medium / SIGHASH_SINGLE" $
+ nf (sighashSegwit mediumSegwitTx SIGHASH_SINGLE) 0
+ , bench "medium / SIGHASH_ALL|ACP" $
+ nf (sighashSegwit mediumSegwitTx
+ SIGHASH_ALL_ANYONECANPAY) 0
+ ]
+ ]
]
+ where
+ sighashLegacy tx st i =
+ sighash_legacy tx i sampleScriptPubKey (encode_sighash st)
+ sighashSegwit tx st i =
+ sighash_segwit tx i sampleScriptCode sampleValue (encode_sighash st)
diff --git a/bench/Weight.hs b/bench/Weight.hs
@@ -6,6 +6,7 @@ module Main where
import Control.DeepSeq
import qualified Data.ByteString as BS
import Data.List.NonEmpty (NonEmpty(..))
+import Data.Word (Word64)
import qualified Weigh as W
import Bitcoin.Prim.Tx
@@ -97,6 +98,17 @@ smallSegwitBytes = to_bytes smallSegwitTx
mediumSegwitBytes = to_bytes mediumSegwitTx
largeSegwitBytes = to_bytes largeSegwitTx
+-- sighash inputs --------------------------------------------------------------
+
+sampleScriptPubKey :: BS.ByteString
+sampleScriptPubKey = BS.replicate 25 0x00
+
+sampleScriptCode :: BS.ByteString
+sampleScriptCode = BS.replicate 26 0x00
+
+sampleValue :: Word64
+sampleValue = 100000000
+
-- allocation benchmarks -------------------------------------------------------
main :: IO ()
@@ -132,3 +144,36 @@ main = W.mainWith $ do
W.func "txid/medium-segwit" txid mediumSegwitTx
W.func "txid/large-legacy" txid largeLegacyTx
W.func "txid/large-segwit" txid largeSegwitTx
+
+ -- sighash_legacy
+ W.func "sighash_legacy/small / SIGHASH_ALL"
+ (sighashLegacy smallLegacyTx SIGHASH_ALL) 0
+ W.func "sighash_legacy/medium / SIGHASH_ALL"
+ (sighashLegacy mediumLegacyTx SIGHASH_ALL) 0
+ W.func "sighash_legacy/large / SIGHASH_ALL"
+ (sighashLegacy largeLegacyTx SIGHASH_ALL) 0
+ W.func "sighash_legacy/medium / SIGHASH_NONE"
+ (sighashLegacy mediumLegacyTx SIGHASH_NONE) 0
+ W.func "sighash_legacy/medium / SIGHASH_SINGLE"
+ (sighashLegacy mediumLegacyTx SIGHASH_SINGLE) 0
+ W.func "sighash_legacy/medium / SIGHASH_ALL|ACP"
+ (sighashLegacy mediumLegacyTx SIGHASH_ALL_ANYONECANPAY) 0
+
+ -- sighash_segwit
+ W.func "sighash_segwit/small / SIGHASH_ALL"
+ (sighashSegwit smallSegwitTx SIGHASH_ALL) 0
+ W.func "sighash_segwit/medium / SIGHASH_ALL"
+ (sighashSegwit mediumSegwitTx SIGHASH_ALL) 0
+ W.func "sighash_segwit/large / SIGHASH_ALL"
+ (sighashSegwit largeSegwitTx SIGHASH_ALL) 0
+ W.func "sighash_segwit/medium / SIGHASH_NONE"
+ (sighashSegwit mediumSegwitTx SIGHASH_NONE) 0
+ W.func "sighash_segwit/medium / SIGHASH_SINGLE"
+ (sighashSegwit mediumSegwitTx SIGHASH_SINGLE) 0
+ W.func "sighash_segwit/medium / SIGHASH_ALL|ACP"
+ (sighashSegwit mediumSegwitTx SIGHASH_ALL_ANYONECANPAY) 0
+ where
+ sighashLegacy tx st i =
+ sighash_legacy tx i sampleScriptPubKey (encode_sighash st)
+ sighashSegwit tx st i =
+ sighash_segwit tx i sampleScriptCode sampleValue (encode_sighash st)
diff --git a/lib/Bitcoin/Prim/Tx/Sighash.hs b/lib/Bitcoin/Prim/Tx/Sighash.hs
@@ -14,12 +14,16 @@
module Bitcoin.Prim.Tx.Sighash (
-- * Sighash Types
SighashType(..)
+ , encode_sighash
-- * Legacy Sighash
, sighash_legacy
-- * BIP143 Segwit Sighash
, sighash_segwit
+
+ -- * Internal
+ , strip_codeseparators
) where
import Bitcoin.Prim.Tx
@@ -34,13 +38,21 @@ import Bitcoin.Prim.Tx
, to_strict
)
import qualified Crypto.Hash.SHA256 as SHA256
+import Data.Bits ((.&.))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BSB
import qualified Data.List.NonEmpty as NE
-import Data.Word (Word8, Word64)
+import Data.Word (Word8, Word32, Word64)
import GHC.Generics (Generic)
--- | Sighash type flags.
+-- | Canonical sighash type flags.
+--
+-- The Bitcoin consensus rules commit the full 32-bit @hashType@ to
+-- the signature preimage and only use its low byte for behavioral
+-- dispatch (low 5 bits select base type; bit 0x80 selects
+-- ANYONECANPAY). 'SighashType' enumerates the six canonical
+-- single-byte hashTypes; pass arbitrary 32-bit values directly when
+-- reproducing non-canonical hashes.
data SighashType
= SIGHASH_ALL
| SIGHASH_NONE
@@ -50,35 +62,40 @@ data SighashType
| SIGHASH_SINGLE_ANYONECANPAY
deriving (Eq, Show, Generic)
--- | Encode sighash type to byte value.
-sighash_byte :: SighashType -> Word8
-sighash_byte !st = case st of
- SIGHASH_ALL -> 0x01
- SIGHASH_NONE -> 0x02
- SIGHASH_SINGLE -> 0x03
+-- | Encode a canonical 'SighashType' to its 32-bit hashType value.
+--
+-- @
+-- encode_sighash SIGHASH_ALL == 0x01
+-- encode_sighash SIGHASH_SINGLE_ANYONECANPAY == 0x83
+-- @
+encode_sighash :: SighashType -> Word32
+encode_sighash !st = case st of
+ SIGHASH_ALL -> 0x01
+ SIGHASH_NONE -> 0x02
+ SIGHASH_SINGLE -> 0x03
SIGHASH_ALL_ANYONECANPAY -> 0x81
SIGHASH_NONE_ANYONECANPAY -> 0x82
SIGHASH_SINGLE_ANYONECANPAY -> 0x83
-{-# INLINE sighash_byte #-}
-
--- | Check if ANYONECANPAY flag is set.
-is_anyonecanpay :: SighashType -> Bool
-is_anyonecanpay !st = case st of
- SIGHASH_ALL_ANYONECANPAY -> True
- SIGHASH_NONE_ANYONECANPAY -> True
- SIGHASH_SINGLE_ANYONECANPAY -> True
- _ -> False
-{-# INLINE is_anyonecanpay #-}
-
--- | Get base sighash type (without ANYONECANPAY).
-base_type :: SighashType -> SighashType
-base_type !st = case st of
- SIGHASH_ALL_ANYONECANPAY -> SIGHASH_ALL
- SIGHASH_NONE_ANYONECANPAY -> SIGHASH_NONE
- SIGHASH_SINGLE_ANYONECANPAY -> SIGHASH_SINGLE
- other -> other
+{-# INLINE encode_sighash #-}
+
+-- | Internal base sighash classification derived from a 32-bit hashType.
+data BaseType = BaseAll | BaseNone | BaseSingle
+ deriving Eq
+
+-- | Behavioral base type: @hashType & 0x1f@. 2 → NONE, 3 → SINGLE,
+-- anything else → ALL.
+base_type :: Word32 -> BaseType
+base_type !ht = case ht .&. 0x1f of
+ 2 -> BaseNone
+ 3 -> BaseSingle
+ _ -> BaseAll
{-# INLINE base_type #-}
+-- | Check ANYONECANPAY flag: @hashType & 0x80@.
+is_anyonecanpay :: Word32 -> Bool
+is_anyonecanpay !ht = (ht .&. 0x80) /= 0
+{-# INLINE is_anyonecanpay #-}
+
-- | 32 zero bytes.
zero32 :: BS.ByteString
zero32 = BS.replicate 32 0x00
@@ -94,36 +111,95 @@ hash256 :: BS.ByteString -> BS.ByteString
hash256 = SHA256.hash . SHA256.hash
{-# INLINE hash256 #-}
+-- | Strip @OP_CODESEPARATOR@ (0xab) opcodes from a script, skipping
+-- push-data sections so that data bytes equal to 0xab are preserved.
+--
+-- This is consensus-required preprocessing for the legacy sighash
+-- scriptCode (see Bitcoin Core's @CTransactionSignatureSerializer@).
+-- BIP143 segwit sighash does /not/ perform this stripping; for
+-- segwit, the caller is responsible for trimming the scriptCode to
+-- the portion after the last executed @OP_CODESEPARATOR@.
+--
+-- On a malformed script (truncated push data), the malformed tail is
+-- copied verbatim without further codeseparator processing.
+strip_codeseparators :: BS.ByteString -> BS.ByteString
+strip_codeseparators !script
+ | not (0xab `BS.elem` script) = script -- fast path: nothing to strip
+ | otherwise = BS.pack (go (BS.unpack script))
+ where
+ go :: [Word8] -> [Word8]
+ go [] = []
+ go (b : rest)
+ | b == 0xab = go rest
+ | b >= 0x01 && b <= 0x4b = push (fromIntegral b) [b] rest
+ | b == 0x4c = case rest of
+ (n : rest') -> push (fromIntegral n) [b, n] rest'
+ [] -> [b]
+ | b == 0x4d = case rest of
+ (n0 : n1 : rest') ->
+ let !len = fromIntegral n0
+ + fromIntegral n1 * 0x100
+ in push len [b, n0, n1] rest'
+ _ -> b : rest
+ | b == 0x4e = case rest of
+ (n0 : n1 : n2 : n3 : rest') ->
+ let !len = fromIntegral n0
+ + fromIntegral n1 * 0x100
+ + fromIntegral n2 * 0x10000
+ + fromIntegral n3 * 0x1000000
+ in push len [b, n0, n1, n2, n3] rest'
+ _ -> b : rest
+ | otherwise = b : go rest
+
+ -- | Copy a push header and N data bytes verbatim. On truncation,
+ -- @splitAt@ yields @(available, [])@ so @go []@ closes the
+ -- recursion naturally; the malformed tail is preserved.
+ push :: Int -> [Word8] -> [Word8] -> [Word8]
+ push !len !header !rest =
+ let (chunk, rest') = splitAt len rest
+ in header ++ chunk ++ go rest'
+{-# INLINABLE strip_codeseparators #-}
+
-- legacy sighash -------------------------------------------------------------
-- | Compute legacy sighash for P2PKH/P2SH inputs.
--
--- Modifies a copy of the transaction based on sighash flags, appends
--- the sighash type as 4-byte little-endian, and double SHA256s.
+-- Modifies a copy of the transaction based on hashType flags, appends
+-- the 4-byte little-endian hashType, and double SHA256s. The
+-- @hashType@ is committed to the preimage verbatim; only its low byte
+-- determines behavior (see 'base_type', 'is_anyonecanpay').
--
-- @
-- -- sign input 0 with SIGHASH_ALL
--- let hash = sighash_legacy tx 0 scriptPubKey SIGHASH_ALL
--- -- use hash with ECDSA signing
+-- let hash = sighash_legacy tx 0 scriptPubKey (encode_sighash SIGHASH_ALL)
+-- -- non-canonical hashType (consensus-valid, committed raw)
+-- let hash = sighash_legacy tx 0 scriptPubKey 0x6f29291f
-- @
--
--- For SIGHASH_SINGLE with input index >= output count, returns the
--- special \"sighash single bug\" value (0x01 followed by 31 zero bytes).
+-- For base SIGHASH_SINGLE with input index >= output count, returns
+-- the special \"sighash single bug\" value (0x01 followed by 31 zero
+-- bytes).
+--
+-- The input index is /not/ validated against the input count; an
+-- out-of-range @idx@ produces a deterministic but
+-- consensus-undefined hash. Matches Bitcoin Core, which @assert@s on
+-- the same precondition. Contrast 'sighash_segwit', which validates
+-- and returns 'Nothing'.
sighash_legacy
:: Tx
-> Int -- ^ input index
-> BS.ByteString -- ^ scriptPubKey being spent
- -> SighashType
+ -> Word32 -- ^ hashType
-> BS.ByteString -- ^ 32-byte hash
-sighash_legacy !tx !idx !script_pubkey !sighash_type
+sighash_legacy !tx !idx !script_pubkey !ht
-- SIGHASH_SINGLE edge case: index >= number of outputs
- | base == SIGHASH_SINGLE && idx >= NE.length (tx_outputs tx) =
+ | base == BaseSingle && idx >= NE.length (tx_outputs tx) =
sighash_single_bug
| otherwise =
- let !serialized = serialize_legacy_sighash tx idx script_pubkey sighash_type
+ let !serialized = serialize_legacy_sighash tx idx script_pubkey ht
in hash256 serialized
where
- !base = base_type sighash_type
+ !base = base_type ht
-- | Serialize transaction for legacy sighash computation.
-- Handles all sighash flags directly without constructing intermediate Tx.
@@ -131,11 +207,12 @@ serialize_legacy_sighash
:: Tx
-> Int
-> BS.ByteString
- -> SighashType
+ -> Word32
-> BS.ByteString
-serialize_legacy_sighash Tx{..} !idx !script_pubkey !sighash_type =
- let !base = base_type sighash_type
- !anyonecanpay = is_anyonecanpay sighash_type
+serialize_legacy_sighash Tx{..} !idx !script_pubkey !ht =
+ let !script' = strip_codeseparators script_pubkey
+ !base = base_type ht
+ !anyonecanpay = is_anyonecanpay ht
!inputs_list = NE.toList tx_inputs
!outputs_list = NE.toList tx_outputs
@@ -143,7 +220,7 @@ serialize_legacy_sighash Tx{..} !idx !script_pubkey !sighash_type =
clear_scripts :: Int -> [TxIn] -> [TxIn]
clear_scripts !_ [] = []
clear_scripts !i (inp : rest)
- | i == idx = inp { txin_script_sig = script_pubkey } : clear_rest
+ | i == idx = inp { txin_script_sig = script' } : clear_rest
| otherwise = inp { txin_script_sig = BS.empty } : clear_rest
where
!clear_rest = clear_scripts (i + 1) rest
@@ -160,9 +237,9 @@ serialize_legacy_sighash Tx{..} !idx !script_pubkey !sighash_type =
!inputs_cleared = clear_scripts 0 inputs_list
!inputs_processed = case base of
- SIGHASH_NONE -> zero_other_sequences 0 inputs_cleared
- SIGHASH_SINGLE -> zero_other_sequences 0 inputs_cleared
- _ -> inputs_cleared
+ BaseNone -> zero_other_sequences 0 inputs_cleared
+ BaseSingle -> zero_other_sequences 0 inputs_cleared
+ _ -> inputs_cleared
-- ANYONECANPAY: keep only signing input
!final_inputs
@@ -173,9 +250,9 @@ serialize_legacy_sighash Tx{..} !idx !script_pubkey !sighash_type =
-- Process outputs based on sighash type
!final_outputs = case base of
- SIGHASH_NONE -> []
- SIGHASH_SINGLE -> build_single_outputs outputs_list idx
- _ -> outputs_list
+ BaseNone -> []
+ BaseSingle -> build_single_outputs outputs_list idx
+ _ -> outputs_list
in to_strict $
put_word32_le tx_version
@@ -184,7 +261,7 @@ serialize_legacy_sighash Tx{..} !idx !script_pubkey !sighash_type =
<> put_compact (fromIntegral (length final_outputs))
<> foldMap put_txout final_outputs
<> put_word32_le tx_locktime
- <> put_word32_le (fromIntegral (sighash_byte sighash_type))
+ <> put_word32_le ht
-- | Build outputs for SIGHASH_SINGLE: keep only output at idx,
-- replace earlier outputs with empty/zero outputs.
@@ -226,14 +303,16 @@ put_txin_legacy TxIn{..} =
--
-- Required for signing segwit inputs (P2WPKH, P2WSH). Unlike legacy
-- sighash, this commits to the value being spent, preventing fee
--- manipulation attacks.
+-- manipulation attacks. The @hashType@ is committed to the preimage
+-- verbatim; only its low byte determines behavior.
--
-- Returns 'Nothing' if the input index is out of range.
--
-- @
-- -- sign P2WPKH input 0
-- let scriptCode = ... -- P2WPKH scriptCode
--- let hash = sighash_segwit tx 0 scriptCode inputValue SIGHASH_ALL
+-- let hash = sighash_segwit tx 0 scriptCode inputValue
+-- (encode_sighash SIGHASH_ALL)
-- -- use hash with ECDSA signing (after checking Just)
-- @
sighash_segwit
@@ -241,10 +320,10 @@ sighash_segwit
-> Int -- ^ input index
-> BS.ByteString -- ^ scriptCode
-> Word64 -- ^ value being spent (satoshis)
- -> SighashType
+ -> Word32 -- ^ hashType
-> Maybe BS.ByteString -- ^ 32-byte hash, or Nothing if index invalid
-sighash_segwit !tx !idx !script_code !value !sighash_type = do
- preimage <- build_bip143_preimage tx idx script_code value sighash_type
+sighash_segwit !tx !idx !script_code !value !ht = do
+ preimage <- build_bip143_preimage tx idx script_code value ht
pure $! hash256 preimage
-- | Build BIP143 preimage for signing.
@@ -254,16 +333,16 @@ build_bip143_preimage
-> Int
-> BS.ByteString
-> Word64
- -> SighashType
+ -> Word32
-> Maybe BS.ByteString
-build_bip143_preimage Tx{..} !idx !script_code !value !sighash_type = do
+build_bip143_preimage Tx{..} !idx !script_code !value !ht = do
-- Get the input being signed; fail if index out of range
let !inputs_list = NE.toList tx_inputs
!outputs_list = NE.toList tx_outputs
signing_input <- safe_index inputs_list idx
- let !base = base_type sighash_type
- !anyonecanpay = is_anyonecanpay sighash_type
+ let !base = base_type ht
+ !anyonecanpay = is_anyonecanpay ht
-- hashPrevouts: double SHA256 of all outpoints, or zero if ANYONECANPAY
!hash_prevouts
@@ -274,16 +353,16 @@ build_bip143_preimage Tx{..} !idx !script_code !value !sighash_type = do
-- hashSequence: double SHA256 of all sequences, or zero if
-- ANYONECANPAY or NONE or SINGLE
!hash_sequence
- | anyonecanpay = zero32
- | base == SIGHASH_SINGLE = zero32
- | base == SIGHASH_NONE = zero32
+ | anyonecanpay = zero32
+ | base == BaseSingle = zero32
+ | base == BaseNone = zero32
| otherwise = hash256 $ to_strict $
foldMap (put_word32_le . txin_sequence) tx_inputs
-- hashOutputs: depends on sighash type
!hash_outputs = case base of
- SIGHASH_NONE -> zero32
- SIGHASH_SINGLE ->
+ BaseNone -> zero32
+ BaseSingle ->
case safe_index outputs_list idx of
Nothing -> zero32 -- index out of range
Just out -> hash256 $ to_strict $ put_txout out
@@ -303,4 +382,4 @@ build_bip143_preimage Tx{..} !idx !script_code !value !sighash_type = do
<> put_word32_le sequence_n
<> BSB.byteString hash_outputs
<> put_word32_le tx_locktime
- <> put_word32_le (fromIntegral (sighash_byte sighash_type))
+ <> put_word32_le ht
diff --git a/test/Main.hs b/test/Main.hs
@@ -6,14 +6,15 @@ import Bitcoin.Prim.Tx
import Bitcoin.Prim.Tx.Sighash
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
+import Data.Int (Int32)
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NE
-import Data.Word (Word64)
+import Data.Word (Word32, Word64)
import Test.Tasty
import qualified Test.Tasty.HUnit as H
import Test.Tasty.QuickCheck as QC hiding (Witness)
import Test.QuickCheck
- ( Gen, Arbitrary(..), elements, oneof, chooseInt, forAll, (==>) )
+ ( Gen, Arbitrary(..), elements, oneof, chooseInt, forAll, resize, (==>) )
-- main ------------------------------------------------------------------------
@@ -30,9 +31,15 @@ main = defaultMain $
parse_satoshi_hal
, parse_first_segwit
]
+ , testGroup "compactSize" [
+ test_compact_non_minimal_fd
+ , test_compact_non_minimal_fe
+ , test_compact_non_minimal_ff
+ ]
]
, testGroup "txid" [
txid_satoshi_hal
+ , txid_first_segwit
]
, testGroup "edge cases" [
edge_empty_scriptsig
@@ -54,10 +61,35 @@ main = defaultMain $
, testGroup "sighash" [
testGroup "legacy" [
sighash_legacy_minimal
+ , testGroup "codeseparators" [
+ codesep_no_op
+ , codesep_strip_simple
+ , codesep_inside_push
+ , codesep_inside_pushdata1
+ , codesep_inside_pushdata2
+ , codesep_inside_pushdata4
+ , codesep_malformed_tail
+ ]
+ , testGroup "Bitcoin Core sighash.json" [
+ bc_sighash_1
+ , bc_sighash_2
+ , bc_sighash_4
+ , bc_sighash_9
+ , bc_sighash_14
+ , bc_sighash_20
+ ]
]
, testGroup "BIP143 segwit" [
bip143_native_p2wpkh
, bip143_p2sh_p2wpkh
+ , testGroup "P2SH-P2WSH multi-sighash" [
+ bip143_p2sh_p2wsh_all
+ , bip143_p2sh_p2wsh_none
+ , bip143_p2sh_p2wsh_single
+ , bip143_p2sh_p2wsh_all_acp
+ , bip143_p2sh_p2wsh_none_acp
+ , bip143_p2sh_p2wsh_single_acp
+ ]
]
]
, testGroup "properties" [
@@ -77,6 +109,12 @@ main = defaultMain $
prop_sighash_legacy_32_bytes
, prop_sighash_segwit_32_bytes
, prop_sighash_single_bug
+ , prop_sighash_segwit_oob
+ , prop_sighash_legacy_acp_invariant
+ , prop_sighash_legacy_none_invariant
+ , prop_sighash_legacy_none_acp_invariant
+ , prop_strip_codesep_idempotent
+ , prop_strip_codesep_no_0xab_unchanged
]
]
]
@@ -452,7 +490,7 @@ test_sighash_segwit_oob =
Just tx ->
H.assertEqual "should be Nothing"
Nothing
- (sighash_segwit tx 99 "script" 0 SIGHASH_ALL)
+ (sighash_segwit tx 99 "script" 0 (encode_sighash SIGHASH_ALL))
-- | A minimal legacy tx used by validation tests.
legacyTx1 :: Tx
@@ -507,7 +545,8 @@ sighash_legacy_minimal =
expected = hex
"049b7618cbda49a0190c5eea6f97320b\
\930aa32b64be6e71ed20041067685c45"
- result = sighash_legacy tx 0 script_pubkey SIGHASH_ALL
+ result = sighash_legacy tx 0 script_pubkey
+ (encode_sighash SIGHASH_ALL)
H.assertEqual "sighash mismatch" expected result
-- BIP143 sighash vectors -----------------------------------------------------
@@ -534,7 +573,8 @@ bip143_native_p2wpkh = H.testCase "native P2WPKH" $ do
value = 600000000 :: Word64
expected = hex
"c37af31116d1b27caf68aae9e3ac82f1477929014d5b917657d0eb49478cb670"
- case sighash_segwit tx inputIdx scriptCode value SIGHASH_ALL of
+ case sighash_segwit tx inputIdx scriptCode value
+ (encode_sighash SIGHASH_ALL) of
Nothing -> H.assertFailure "sighash_segwit returned Nothing"
Just result -> H.assertEqual "sighash mismatch" expected result
@@ -557,7 +597,8 @@ bip143_p2sh_p2wpkh = H.testCase "P2SH-P2WPKH" $ do
value = 1000000000 :: Word64
expected = hex
"64f3b0f4dd2bb3aa1ce8566d220cc74dda9df97d8490cc81d89d735c92e59fb6"
- case sighash_segwit tx inputIdx scriptCode value SIGHASH_ALL of
+ case sighash_segwit tx inputIdx scriptCode value
+ (encode_sighash SIGHASH_ALL) of
Nothing -> H.assertFailure "sighash_segwit returned Nothing"
Just result -> H.assertEqual "sighash mismatch" expected result
@@ -682,19 +723,21 @@ prop_sighash_legacy_32_bytes =
forAll genLegacyTx $ \tx ->
forAll arbitraryScript $ \spk ->
forAll arbitrary $ \st ->
- BS.length (sighash_legacy tx 0 spk st) === 32
+ BS.length (sighash_legacy tx 0 spk (encode_sighash st)) === 32
--- sighash_segwit returns Just 32 bytes for valid index
+-- sighash_segwit returns Just 32 bytes for any valid index
prop_sighash_segwit_32_bytes :: TestTree
prop_sighash_segwit_32_bytes =
QC.testProperty "sighash_segwit is 32 bytes for valid index" $
forAll genSegwitTx $ \tx ->
- forAll arbitraryScript $ \sc ->
- forAll (arbitrary :: Gen Word64) $ \val ->
- forAll arbitrary $ \st ->
- case sighash_segwit tx 0 sc val st of
- Nothing -> False -- should succeed for index 0
- Just bs -> BS.length bs == 32
+ let nIns = NE.length (tx_inputs tx)
+ in forAll (chooseInt (0, nIns - 1)) $ \idx ->
+ forAll arbitraryScript $ \sc ->
+ forAll (arbitrary :: Gen Word64) $ \val ->
+ forAll arbitrary $ \st ->
+ case sighash_segwit tx idx sc val (encode_sighash st) of
+ Nothing -> False -- should succeed for valid index
+ Just bs -> BS.length bs == 32
-- SIGHASH_SINGLE bug: returns 0x01 ++ 0x00*31 when index >= outputs
prop_sighash_single_bug :: TestTree
@@ -704,4 +747,383 @@ prop_sighash_single_bug =
let numOutputs = NE.length (tx_outputs tx)
bugValue = BS.cons 0x01 (BS.replicate 31 0x00)
in forAll arbitraryScript $ \spk ->
- sighash_legacy tx numOutputs spk SIGHASH_SINGLE === bugValue
+ sighash_legacy tx numOutputs spk
+ (encode_sighash SIGHASH_SINGLE) === bugValue
+
+-- sighash_segwit: out-of-range index always returns Nothing
+prop_sighash_segwit_oob :: TestTree
+prop_sighash_segwit_oob =
+ QC.testProperty "sighash_segwit returns Nothing for oob index" $
+ forAll genSegwitTx $ \tx ->
+ let nIns = NE.length (tx_inputs tx)
+ in forAll (chooseInt (nIns, nIns + 10)) $ \idx ->
+ forAll arbitraryScript $ \sc ->
+ forAll (arbitrary :: Gen Word64) $ \val ->
+ forAll arbitrary $ \st ->
+ sighash_segwit tx idx sc val (encode_sighash st)
+ === Nothing
+
+-- ANYONECANPAY commits to only the signing input. Appending extra
+-- inputs to the tx (without displacing index 0) must not change the
+-- hash.
+prop_sighash_legacy_acp_invariant :: TestTree
+prop_sighash_legacy_acp_invariant =
+ QC.testProperty "SIGHASH_ALL|ANYONECANPAY ignores appended inputs" $
+ forAll genLegacyTx $ \tx ->
+ forAll (QC.listOf1 (arbitrary :: Gen TxIn)) $ \extras ->
+ forAll arbitraryScript $ \spk ->
+ let tx' = tx { tx_inputs = appendInputs (tx_inputs tx) extras }
+ ht = encode_sighash SIGHASH_ALL_ANYONECANPAY
+ h1 = sighash_legacy tx 0 spk ht
+ h2 = sighash_legacy tx' 0 spk ht
+ in h1 === h2
+
+-- SIGHASH_NONE strips outputs from the preimage. Appending extra
+-- outputs must not change the hash.
+prop_sighash_legacy_none_invariant :: TestTree
+prop_sighash_legacy_none_invariant =
+ QC.testProperty "SIGHASH_NONE ignores appended outputs" $
+ forAll genLegacyTx $ \tx ->
+ forAll (QC.listOf1 (arbitrary :: Gen TxOut)) $ \extras ->
+ forAll arbitraryScript $ \spk ->
+ let tx' = tx { tx_outputs = appendOutputs (tx_outputs tx) extras }
+ ht = encode_sighash SIGHASH_NONE
+ h1 = sighash_legacy tx 0 spk ht
+ h2 = sighash_legacy tx' 0 spk ht
+ in h1 === h2
+
+-- SIGHASH_NONE|ANYONECANPAY ignores both other inputs and all outputs.
+prop_sighash_legacy_none_acp_invariant :: TestTree
+prop_sighash_legacy_none_acp_invariant =
+ QC.testProperty
+ "SIGHASH_NONE|ANYONECANPAY ignores appended inputs and outputs" $
+ forAll genLegacyTx $ \tx ->
+ forAll (QC.listOf1 (arbitrary :: Gen TxIn)) $ \extraIns ->
+ forAll (QC.listOf1 (arbitrary :: Gen TxOut)) $ \extraOuts ->
+ forAll arbitraryScript $ \spk ->
+ let tx' = tx
+ { tx_inputs = appendInputs (tx_inputs tx) extraIns
+ , tx_outputs = appendOutputs (tx_outputs tx) extraOuts
+ }
+ ht = encode_sighash SIGHASH_NONE_ANYONECANPAY
+ h1 = sighash_legacy tx 0 spk ht
+ h2 = sighash_legacy tx' 0 spk ht
+ in h1 === h2
+
+-- | Append items to a NonEmpty list.
+appendInputs :: NonEmpty TxIn -> [TxIn] -> NonEmpty TxIn
+appendInputs (x :| xs) extras = x :| (xs ++ extras)
+
+appendOutputs :: NonEmpty TxOut -> [TxOut] -> NonEmpty TxOut
+appendOutputs (x :| xs) extras = x :| (xs ++ extras)
+
+-- compactSize non-minimal rejection -----------------------------------------
+
+-- Build a legacy tx whose input scriptSig length is encoded with a
+-- non-minimal compactSize tag. We construct the bytes directly.
+--
+-- Layout (legacy):
+-- version(4) | n_inputs(compact) | outpoint(36) | scriptSig_len(compact)
+-- | scriptSig | sequence(4) | n_outputs(compact) | outputs... | locktime(4)
+--
+-- We use a 0-byte scriptSig but encode its length with a non-minimal tag.
+nonMinimalLegacyTx :: BS.ByteString -> BS.ByteString
+nonMinimalLegacyTx badLen = BS.concat
+ [ BS.pack [0x01, 0x00, 0x00, 0x00] -- version 1
+ , BS.pack [0x01] -- 1 input
+ , BS.replicate 32 0x00 -- outpoint txid
+ , BS.pack [0x00, 0x00, 0x00, 0x00] -- outpoint vout
+ , badLen -- non-minimal compactSize
+ , BS.pack [0xff, 0xff, 0xff, 0xff] -- sequence
+ , BS.pack [0x01] -- 1 output
+ , BS.replicate 8 0x00 -- value
+ , BS.pack [0x00] -- empty scriptPubKey
+ , BS.pack [0x00, 0x00, 0x00, 0x00] -- locktime
+ ]
+
+test_compact_non_minimal_fd :: TestTree
+test_compact_non_minimal_fd =
+ H.testCase "rejects 0xfd encoding of value < 0xfd" $
+ H.assertEqual "should be Nothing"
+ Nothing
+ (from_bytes (nonMinimalLegacyTx (BS.pack [0xfd, 0x00, 0x00])))
+
+test_compact_non_minimal_fe :: TestTree
+test_compact_non_minimal_fe =
+ H.testCase "rejects 0xfe encoding of value <= 0xffff" $
+ H.assertEqual "should be Nothing"
+ Nothing
+ (from_bytes
+ (nonMinimalLegacyTx (BS.pack [0xfe, 0x00, 0x00, 0x00, 0x00])))
+
+test_compact_non_minimal_ff :: TestTree
+test_compact_non_minimal_ff =
+ H.testCase "rejects 0xff encoding of value <= 0xffffffff" $
+ H.assertEqual "should be Nothing"
+ Nothing
+ (from_bytes (nonMinimalLegacyTx
+ (BS.pack [0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00])))
+
+-- segwit txid known vector --------------------------------------------------
+
+-- Regression vector: txid of firstSegwitRaw, displayed big-endian.
+firstSegwitTxId :: BS.ByteString
+firstSegwitTxId =
+ "c586389e5e4b3acb9d6c8be1c19ae8ab2795397633176f5a6442a261bbdefc3a"
+
+txid_first_segwit :: TestTree
+txid_first_segwit = H.testCase "txid of first-segwit fixture" $
+ case from_base16 firstSegwitRaw of
+ Nothing -> H.assertFailure "failed to parse tx"
+ Just tx -> do
+ let TxId computed = txid tx
+ expected = BS.reverse (hex firstSegwitTxId)
+ H.assertEqual "txid mismatch" expected computed
+
+-- BIP143 P2SH-P2WSH multi-sighash vectors -----------------------------------
+
+-- Shared fixture: unsigned tx, scriptCode, input index, value.
+-- Source: https://github.com/bitcoin/bips/blob/master/bip-0143.mediawiki
+p2shP2wshTx :: Tx
+p2shP2wshTx =
+ let raw = mconcat
+ [ "010000000136641869ca081e70f394c6948e8af409e18b619df2ed74aa106c"
+ , "1ca29787b96e0100000000ffffffff0200e9a435000000001976a914389ffc"
+ , "e9cd9ae88dcc0631e88a821ffdbe9bfe2688acc0832f05000000001976a914"
+ , "7480a33f950689af511e6e84c138dbbd3c3ee41588ac00000000"
+ ]
+ in case from_base16 raw of
+ Just t -> t
+ Nothing -> error "BIP143 P2SH-P2WSH fixture failed to parse"
+
+p2shP2wshScriptCode :: BS.ByteString
+p2shP2wshScriptCode = hex $ mconcat
+ [ "56210307b8ae49ac90a048e9b53357a2354b3334e9c8bee813ecb98e99a7e07e8c"
+ , "3ba32103b28f0c28bfab54554ae8c658ac5c3e0ce6e79ad336331f78c428dd43ee"
+ , "a8449b21034b8113d703413d57761b8b9781957b8c0ac1dfe69f492580ca4195f5"
+ , "0376ba4a21033400f6afecb833092a9a21cfdf1ed1376e58c5d1f47de746831239"
+ , "87e967a8f42103a6d48b1131e94ba04d9737d61acdaa1322008af9602b3b14862c"
+ , "07a1789aac162102d8b661b0b3302ee2f162b09e07a55ad5dfbe673a9f01d9f0c1"
+ , "9617681024306b56ae"
+ ]
+
+p2shP2wshValue :: Word64
+p2shP2wshValue = 987654321 -- 9.87654321 BTC
+
+assertP2shP2wshSighash :: SighashType -> BS.ByteString -> H.Assertion
+assertP2shP2wshSighash st expectedHex =
+ case sighash_segwit p2shP2wshTx 0 p2shP2wshScriptCode p2shP2wshValue
+ (encode_sighash st) of
+ Nothing -> H.assertFailure "sighash_segwit returned Nothing"
+ Just res -> H.assertEqual "sighash mismatch" (hex expectedHex) res
+
+bip143_p2sh_p2wsh_all :: TestTree
+bip143_p2sh_p2wsh_all = H.testCase "SIGHASH_ALL" $
+ assertP2shP2wshSighash SIGHASH_ALL
+ "185c0be5263dce5b4bb50a047973c1b6272bfbd0103a89444597dc40b248ee7c"
+
+bip143_p2sh_p2wsh_none :: TestTree
+bip143_p2sh_p2wsh_none = H.testCase "SIGHASH_NONE" $
+ assertP2shP2wshSighash SIGHASH_NONE
+ "e9733bc60ea13c95c6527066bb975a2ff29a925e80aa14c213f686cbae5d2f36"
+
+bip143_p2sh_p2wsh_single :: TestTree
+bip143_p2sh_p2wsh_single = H.testCase "SIGHASH_SINGLE" $
+ assertP2shP2wshSighash SIGHASH_SINGLE
+ "1e1f1c303dc025bd664acb72e583e933fae4cff9148bf78c157d1e8f78530aea"
+
+bip143_p2sh_p2wsh_all_acp :: TestTree
+bip143_p2sh_p2wsh_all_acp = H.testCase "SIGHASH_ALL|ANYONECANPAY" $
+ assertP2shP2wshSighash SIGHASH_ALL_ANYONECANPAY
+ "2a67f03e63a6a422125878b40b82da593be8d4efaafe88ee528af6e5a9955c6e"
+
+bip143_p2sh_p2wsh_none_acp :: TestTree
+bip143_p2sh_p2wsh_none_acp = H.testCase "SIGHASH_NONE|ANYONECANPAY" $
+ assertP2shP2wshSighash SIGHASH_NONE_ANYONECANPAY
+ "781ba15f3779d5542ce8ecb5c18716733a5ee42a6f51488ec96154934e2c890a"
+
+bip143_p2sh_p2wsh_single_acp :: TestTree
+bip143_p2sh_p2wsh_single_acp = H.testCase "SIGHASH_SINGLE|ANYONECANPAY" $
+ assertP2shP2wshSighash SIGHASH_SINGLE_ANYONECANPAY
+ "511e8e52ed574121fc1b654970395502128263f62662e076dc6baf05c2e6a99b"
+
+-- Bitcoin Core sighash.json legacy vectors ----------------------------------
+
+-- These exercise the raw 32-bit hashType code path. Bitcoin Core's
+-- sighash.json uses non-canonical hashType values that commit the full
+-- 32 bits to the preimage; the SighashType ADT can't construct them.
+--
+-- Source: github.com/bitcoin/bitcoin src/test/data/sighash.json (first
+-- 20 entries). Expected hashes are stored big-endian (via
+-- uint256::GetHex) so we reverse before comparing.
+--
+-- Bitcoin Core's hashType field is int32_t (signed); we cast to Word32.
+bcHashType :: Int32 -> Word32
+bcHashType = fromIntegral
+
+-- | Run a Bitcoin-Core sighash.json legacy vector.
+bcSighashCase
+ :: TestName
+ -> BS.ByteString -- ^ raw tx hex
+ -> BS.ByteString -- ^ scriptCode hex
+ -> Int -- ^ input index
+ -> Int32 -- ^ signed hashType
+ -> BS.ByteString -- ^ expected hash hex (big-endian display)
+ -> TestTree
+bcSighashCase name rawHex scriptHex idx ht expectedHex =
+ H.testCase name $
+ case from_base16 rawHex of
+ Nothing -> H.assertFailure "failed to parse tx"
+ Just tx ->
+ let result = sighash_legacy tx idx (hex scriptHex) (bcHashType ht)
+ expected = BS.reverse (hex expectedHex)
+ in H.assertEqual "sighash mismatch" expected result
+
+bc_sighash_1 :: TestTree
+bc_sighash_1 = bcSighashCase
+ "entry 1: idx=2, hashType=0x6f29291f (ALL)"
+ (mconcat
+ [ "907c2bc503ade11cc3b04eb2918b6f547b0630ab569273824748c87ea14b0696"
+ , "526c66ba740200000004ab65ababfd1f9bdd4ef073c7afc4ae00da8a66f429c9"
+ , "17a0081ad1e1dabce28d373eab81d8628de802000000096aab5253ab52000052"
+ , "ad042b5f25efb33beec9f3364e8a9139e8439d9d7e26529c3c30b6c3fd89f868"
+ , "4cfd68ea0200000009ab53526500636a52ab599ac2fe02a526ed040000000008"
+ , "535300516352515164370e010000000003006300ab2ec229"
+ ])
+ ""
+ 2
+ 1864164639
+ "31af167a6cf3f9d5f6875caa4d31704ceb0eba078d132b78dab52c3b8997317e"
+
+-- NOTE: raw hex is on a single line to avoid manual-splitting errors.
+bc_sighash_2 :: TestTree
+bc_sighash_2 = bcSighashCase
+ "entry 2: idx=0, hashType=0xad118f9c (ALL|ACP)"
+ "a0aa3126041621a6dea5b800141aa696daf28408959dfb2df96095db9fa425ad3f427f2f6103000000015360290e9c6063fa26912c2e7fb6a0ad80f1c5fea1771d42f12976092e7a85a4229fdb6e890000000001abc109f6e47688ac0e4682988785744602b8c87228fcef0695085edf19088af1a9db126e93000000000665516aac536affffffff8fe53e0806e12dfd05d67ac68f4768fdbe23fc48ace22a5aa8ba04c96d58e2750300000009ac51abac63ab5153650524aa680455ce7b000000000000499e50030000000008636a00ac526563ac5051ee030000000003abacabd2b6fe000000000003516563910fb6b5"
+ "65"
+ 0
+ (-1391424484)
+ "48d6a1bd2cd9eec54eb866fc71209418a950402b5d7e52363bfb75c98e141175"
+
+bc_sighash_4 :: TestTree
+bc_sighash_4 = bcSighashCase
+ "entry 4: idx=1, hashType=0x46fb4ce9 (ALL|ACP)"
+ (mconcat
+ [ "73107cbd025c22ebc8c3e0a47b2a760739216a528de8d4dab5d45cbeb3051ceb"
+ , "ae73b01ca10200000007ab6353656a636affffffffe26816dffc670841e6a6c8"
+ , "c61c586da401df1261a330a6c6b3dd9f9a0789bc9e000000000800ac6552ac6a"
+ , "ac51ffffffff0174a8f0010000000004ac52515100000000"
+ ])
+ "5163ac63635151ac"
+ 1
+ 1190874345
+ "06e328de263a87b09beabe222a21627a6ea5c7f560030da31610c4611f4a46bc"
+
+bc_sighash_9 :: TestTree
+bc_sighash_9 = bcSighashCase
+ "entry 9: idx=0, hashType=0x8b07e3c3 (SINGLE|ACP)"
+ (mconcat
+ [ "d3b7421e011f4de0f1cea9ba7458bf3486bee722519efab711a963fa8c100970"
+ , "cf7488b7bb0200000003525352dcd61b300148be5d05000000000000000000"
+ ])
+ "535251536aac536a"
+ 0
+ (-1960128125)
+ "29aa6d2d752d3310eba20442770ad345b7f6a35f96161ede5f07b33e92053e2a"
+
+bc_sighash_14 :: TestTree
+bc_sighash_14 = bcSighashCase
+ "entry 14: idx=1, hashType=0x9604e295 (ALL|ACP, strips 2x 0xab)"
+ "f40a750702af06efff3ea68e5d56e42bc41cdb8b6065c98f1221fe04a325a898cb61f3d7ee030000000363acacffffffffb5788174aef79788716f96af779d7959147a0c2e0e5bfb6c2dba2df5b4b97894030000000965510065535163ac6affffffff0445e6fd0200000000096aac536365526a526aa6546b000000000008acab656a6552535141a0fd010000000000c897ea030000000008526500ab526a6a631b39dba3"
+ "00abab5163ac"
+ 1
+ (-1778064747)
+ "d76d0fc0abfa72d646df888bce08db957e627f72962647016eeae5a8412354cf"
+
+bc_sighash_20 :: TestTree
+bc_sighash_20 = bcSighashCase
+ "entry 20: idx=0, hashType=0xcab2f825 (ALL)"
+ (mconcat
+ [ "c2b0b99001acfecf7da736de0ffaef8134a9676811602a6299ba5a2563a23bb0"
+ , "9e8cbedf9300000000026300ffffffff042997c50300000000045252536a2724"
+ , "37030000000007655353ab6363ac663752030000000002ab6a6d5c9000000000"
+ , "00066a6a5265abab00000000"
+ ])
+ "52ac525163515251"
+ 0
+ (-894181723)
+ "8b300032a1915a4ac05cea2f7d44c26f2a08d109a71602636f15866563eaafdc"
+
+-- strip_codeseparators tests -------------------------------------------------
+
+-- A script containing 0x00, OP_1, OP_IF, OP_CHECKSIG and no 0xab. Strip
+-- should be a no-op.
+codesep_no_op :: TestTree
+codesep_no_op = H.testCase "no 0xab: unchanged" $
+ H.assertEqual "" (BS.pack [0x00, 0x51, 0x63, 0xac])
+ (strip_codeseparators (BS.pack [0x00, 0x51, 0x63, 0xac]))
+
+-- Two OP_CODESEPARATOR bytes in opcode position get stripped.
+codesep_strip_simple :: TestTree
+codesep_strip_simple = H.testCase "0xab at opcode position stripped" $
+ H.assertEqual "" (BS.pack [0x00, 0x51, 0x63, 0xac])
+ (strip_codeseparators (BS.pack [0x00, 0xab, 0xab, 0x51, 0x63, 0xac]))
+
+-- A direct push (opcode 0x02) of two 0xab bytes: data preserved.
+codesep_inside_push :: TestTree
+codesep_inside_push = H.testCase "0xab inside push data preserved" $
+ let s = BS.pack [0x02, 0xab, 0xab, 0x51] -- push 2 bytes, then OP_1
+ in H.assertEqual "" s (strip_codeseparators s)
+
+-- OP_PUSHDATA1 with 3 bytes of 0xab, followed by a lone 0xab opcode and
+-- OP_1. The data must be preserved; the trailing 0xab opcode stripped.
+codesep_inside_pushdata1 :: TestTree
+codesep_inside_pushdata1 =
+ H.testCase "OP_PUSHDATA1 data preserved, trailing 0xab stripped" $
+ let input = BS.pack [0x4c, 0x03, 0xab, 0xab, 0xab, 0xab, 0x51]
+ expected = BS.pack [0x4c, 0x03, 0xab, 0xab, 0xab, 0x51]
+ in H.assertEqual "" expected (strip_codeseparators input)
+
+-- OP_PUSHDATA2 with 2 bytes of 0xab data (LE length = 0x0002), then a
+-- lone 0xab opcode and OP_1. Exercises the n0 + n1 * 0x100 arithmetic.
+codesep_inside_pushdata2 :: TestTree
+codesep_inside_pushdata2 =
+ H.testCase "OP_PUSHDATA2 data preserved, trailing 0xab stripped" $
+ let input = BS.pack [0x4d, 0x02, 0x00, 0xab, 0xab, 0xab, 0x51]
+ expected = BS.pack [0x4d, 0x02, 0x00, 0xab, 0xab, 0x51]
+ in H.assertEqual "" expected (strip_codeseparators input)
+
+-- OP_PUSHDATA4 with 1 byte of 0xab data (LE length = 0x00000001), then
+-- a lone 0xab opcode. Exercises the 4-byte LE length decode.
+codesep_inside_pushdata4 :: TestTree
+codesep_inside_pushdata4 =
+ H.testCase "OP_PUSHDATA4 data preserved, trailing 0xab stripped" $
+ let input = BS.pack [0x4e, 0x01, 0x00, 0x00, 0x00, 0xab, 0xab, 0x51]
+ expected = BS.pack [0x4e, 0x01, 0x00, 0x00, 0x00, 0xab, 0x51]
+ in H.assertEqual "" expected (strip_codeseparators input)
+
+-- Malformed tail: OP_PUSHDATA2 with a truncated length header (only
+-- one byte available). Per docstring, copied verbatim.
+codesep_malformed_tail :: TestTree
+codesep_malformed_tail =
+ H.testCase "malformed tail copied verbatim" $
+ let input = BS.pack [0x4d, 0x00]
+ in H.assertEqual "" input (strip_codeseparators input)
+
+-- | Arbitrary ByteString generator (QuickCheck has no built-in instance).
+genByteString :: Gen BS.ByteString
+genByteString = BS.pack <$> arbitrary
+
+prop_strip_codesep_idempotent :: TestTree
+prop_strip_codesep_idempotent =
+ QC.testProperty "strip_codeseparators is idempotent" $
+ forAll genByteString $ \s ->
+ strip_codeseparators (strip_codeseparators s)
+ === strip_codeseparators s
+
+prop_strip_codesep_no_0xab_unchanged :: TestTree
+prop_strip_codesep_no_0xab_unchanged =
+ QC.testProperty "strip_codeseparators is no-op without 0xab bytes" $
+ forAll (resize 500 $ BS.pack . filter (/= 0xab) <$> arbitrary) $ \s ->
+ strip_codeseparators s === s
+
