tx

Minimal transaction primitives (docs.ppad.tech/tx).
git clone git://git.ppad.tech/tx.git
Log | Files | Refs | README | LICENSE

Sighash.hs (21313B)


      1 {-# OPTIONS_HADDOCK prune #-}
      2 {-# LANGUAGE BangPatterns #-}
      3 {-# LANGUAGE DeriveGeneric #-}
      4 {-# LANGUAGE OverloadedStrings #-}
      5 {-# LANGUAGE RecordWildCards #-}
      6 
      7 -- |
      8 -- Module: Bitcoin.Prim.Tx.Sighash
      9 -- Copyright: (c) 2025 Jared Tobin
     10 -- License: MIT
     11 -- Maintainer: Jared Tobin <jared@ppad.tech>
     12 --
     13 -- Sighash computation for legacy, BIP143 segwit, and BIP341 taproot
     14 -- transactions.
     15 
     16 module Bitcoin.Prim.Tx.Sighash (
     17     -- * Sighash Types
     18     SighashType(..)
     19   , encode_sighash
     20 
     21     -- * Legacy Sighash
     22   , sighash_legacy
     23 
     24     -- * BIP143 Segwit Sighash
     25   , sighash_segwit
     26 
     27     -- * BIP341 Taproot Sighash
     28   , sighash_taproot_keypath
     29   , sighash_taproot_scriptpath
     30 
     31     -- * Internal
     32   , strip_codeseparators
     33   ) where
     34 
     35 import Bitcoin.Prim.Tx
     36     ( Tx(..)
     37     , TxIn(..)
     38     , TxOut(..)
     39     , put_word32_le
     40     , put_word64_le
     41     , put_compact
     42     , put_outpoint
     43     , put_txout
     44     , to_strict
     45     )
     46 import Control.Monad (guard)
     47 import qualified Crypto.Hash.SHA256 as SHA256
     48 import Data.Bits ((.&.))
     49 import qualified Data.ByteString as BS
     50 import qualified Data.ByteString.Builder as BSB
     51 import qualified Data.List.NonEmpty as NE
     52 import Data.Word (Word8, Word32, Word64)
     53 import GHC.Generics (Generic)
     54 
     55 -- | Canonical sighash type flags.
     56 --
     57 --   The Bitcoin consensus rules commit the full 32-bit @hashType@ to
     58 --   the signature preimage and only use its low byte for behavioral
     59 --   dispatch (low 5 bits select base type; bit 0x80 selects
     60 --   ANYONECANPAY). 'SighashType' enumerates the six canonical
     61 --   single-byte hashTypes; pass arbitrary 32-bit values directly when
     62 --   reproducing non-canonical hashes.
     63 data SighashType
     64   = SIGHASH_ALL
     65   | SIGHASH_NONE
     66   | SIGHASH_SINGLE
     67   | SIGHASH_ALL_ANYONECANPAY
     68   | SIGHASH_NONE_ANYONECANPAY
     69   | SIGHASH_SINGLE_ANYONECANPAY
     70   deriving (Eq, Show, Generic)
     71 
     72 -- | Encode a canonical 'SighashType' to its 32-bit hashType value.
     73 --
     74 --   @
     75 --   encode_sighash SIGHASH_ALL                 == 0x01
     76 --   encode_sighash SIGHASH_SINGLE_ANYONECANPAY == 0x83
     77 --   @
     78 encode_sighash :: SighashType -> Word32
     79 encode_sighash !st = case st of
     80   SIGHASH_ALL                 -> 0x01
     81   SIGHASH_NONE                -> 0x02
     82   SIGHASH_SINGLE              -> 0x03
     83   SIGHASH_ALL_ANYONECANPAY    -> 0x81
     84   SIGHASH_NONE_ANYONECANPAY   -> 0x82
     85   SIGHASH_SINGLE_ANYONECANPAY -> 0x83
     86 {-# INLINE encode_sighash #-}
     87 
     88 -- | Internal base sighash classification derived from a 32-bit hashType.
     89 data BaseType = BaseAll | BaseNone | BaseSingle
     90   deriving Eq
     91 
     92 -- | Behavioral base type: @hashType & 0x1f@. 2 → NONE, 3 → SINGLE,
     93 --   anything else → ALL.
     94 base_type :: Word32 -> BaseType
     95 base_type !ht = case ht .&. 0x1f of
     96   2 -> BaseNone
     97   3 -> BaseSingle
     98   _ -> BaseAll
     99 {-# INLINE base_type #-}
    100 
    101 -- | Check ANYONECANPAY flag: @hashType & 0x80@.
    102 is_anyonecanpay :: Word32 -> Bool
    103 is_anyonecanpay !ht = (ht .&. 0x80) /= 0
    104 {-# INLINE is_anyonecanpay #-}
    105 
    106 -- | 32 zero bytes.
    107 zero32 :: BS.ByteString
    108 zero32 = BS.replicate 32 0x00
    109 {-# NOINLINE zero32 #-}
    110 
    111 -- | Hash of 0x01 followed by 31 zero bytes (SIGHASH_SINGLE edge case).
    112 sighash_single_bug :: BS.ByteString
    113 sighash_single_bug = BS.cons 0x01 (BS.replicate 31 0x00)
    114 {-# NOINLINE sighash_single_bug #-}
    115 
    116 -- | Double SHA256.
    117 hash256 :: BS.ByteString -> BS.ByteString
    118 hash256 = SHA256.hash . SHA256.hash
    119 {-# INLINE hash256 #-}
    120 
    121 -- | Strip @OP_CODESEPARATOR@ (0xab) opcodes from a script, skipping
    122 --   push-data sections so that data bytes equal to 0xab are preserved.
    123 --
    124 --   This is consensus-required preprocessing for the legacy sighash
    125 --   scriptCode (see Bitcoin Core's @CTransactionSignatureSerializer@).
    126 --   BIP143 segwit sighash does /not/ perform this stripping; for
    127 --   segwit, the caller is responsible for trimming the scriptCode to
    128 --   the portion after the last executed @OP_CODESEPARATOR@.
    129 --
    130 --   On a malformed script (truncated push data), the malformed tail is
    131 --   copied verbatim without further codeseparator processing.
    132 strip_codeseparators :: BS.ByteString -> BS.ByteString
    133 strip_codeseparators !script
    134   | not (0xab `BS.elem` script) = script  -- fast path: nothing to strip
    135   | otherwise = BS.pack (go (BS.unpack script))
    136   where
    137     go :: [Word8] -> [Word8]
    138     go [] = []
    139     go (b : rest)
    140       | b == 0xab              = go rest
    141       | b >= 0x01 && b <= 0x4b = push (fromIntegral b) [b] rest
    142       | b == 0x4c              = case rest of
    143           (n : rest') -> push (fromIntegral n) [b, n] rest'
    144           []          -> [b]
    145       | b == 0x4d              = case rest of
    146           (n0 : n1 : rest') ->
    147             let !len = fromIntegral n0
    148                      + fromIntegral n1 * 0x100
    149             in  push len [b, n0, n1] rest'
    150           _ -> b : rest
    151       | b == 0x4e              = case rest of
    152           (n0 : n1 : n2 : n3 : rest') ->
    153             let !len = fromIntegral n0
    154                      + fromIntegral n1 * 0x100
    155                      + fromIntegral n2 * 0x10000
    156                      + fromIntegral n3 * 0x1000000
    157             in  push len [b, n0, n1, n2, n3] rest'
    158           _ -> b : rest
    159       | otherwise              = b : go rest
    160 
    161     -- | Copy a push header and N data bytes verbatim. On truncation,
    162     --   @splitAt@ yields @(available, [])@ so @go []@ closes the
    163     --   recursion naturally; the malformed tail is preserved.
    164     push :: Int -> [Word8] -> [Word8] -> [Word8]
    165     push !len !header !rest =
    166       let (chunk, rest') = splitAt len rest
    167       in  header ++ chunk ++ go rest'
    168 {-# INLINABLE strip_codeseparators #-}
    169 
    170 -- legacy sighash -------------------------------------------------------------
    171 
    172 -- | Compute legacy sighash for P2PKH/P2SH inputs.
    173 --
    174 --   Modifies a copy of the transaction based on hashType flags, appends
    175 --   the 4-byte little-endian hashType, and double SHA256s. The
    176 --   @hashType@ is committed to the preimage verbatim; only its low byte
    177 --   determines behavior (see 'base_type', 'is_anyonecanpay').
    178 --
    179 --   @
    180 --   -- sign input 0 with SIGHASH_ALL
    181 --   let hash = sighash_legacy tx 0 scriptPubKey (encode_sighash SIGHASH_ALL)
    182 --   -- non-canonical hashType (consensus-valid, committed raw)
    183 --   let hash = sighash_legacy tx 0 scriptPubKey 0x6f29291f
    184 --   @
    185 --
    186 --   For base SIGHASH_SINGLE with input index >= output count, returns
    187 --   the special \"sighash single bug\" value (0x01 followed by 31 zero
    188 --   bytes).
    189 --
    190 --   The input index is /not/ validated against the input count; an
    191 --   out-of-range @idx@ produces a deterministic but
    192 --   consensus-undefined hash. Matches Bitcoin Core, which @assert@s on
    193 --   the same precondition. Contrast 'sighash_segwit', which validates
    194 --   and returns 'Nothing'.
    195 sighash_legacy
    196   :: Tx
    197   -> Int              -- ^ input index
    198   -> BS.ByteString    -- ^ scriptPubKey being spent
    199   -> Word32           -- ^ hashType
    200   -> BS.ByteString    -- ^ 32-byte hash
    201 sighash_legacy !tx !idx !script_pubkey !ht
    202   -- SIGHASH_SINGLE edge case: index >= number of outputs
    203   | base == BaseSingle && idx >= NE.length (tx_outputs tx) =
    204       sighash_single_bug
    205   | otherwise =
    206       let !serialized = serialize_legacy_sighash tx idx script_pubkey ht
    207       in  hash256 serialized
    208   where
    209     !base = base_type ht
    210 
    211 -- | Serialize transaction for legacy sighash computation.
    212 --   Handles all sighash flags directly without constructing intermediate Tx.
    213 serialize_legacy_sighash
    214   :: Tx
    215   -> Int
    216   -> BS.ByteString
    217   -> Word32
    218   -> BS.ByteString
    219 serialize_legacy_sighash Tx{..} !idx !script_pubkey !ht =
    220   let !script' = strip_codeseparators script_pubkey
    221       !base = base_type ht
    222       !anyonecanpay = is_anyonecanpay ht
    223       !inputs_list = NE.toList tx_inputs
    224       !outputs_list = NE.toList tx_outputs
    225 
    226       -- Clear all scriptSigs, set signing input's script to scriptPubKey
    227       clear_scripts :: Int -> [TxIn] -> [TxIn]
    228       clear_scripts !_ [] = []
    229       clear_scripts !i (inp : rest)
    230         | i == idx  = inp { txin_script_sig = script' } : clear_rest
    231         | otherwise = inp { txin_script_sig = BS.empty } : clear_rest
    232         where
    233           !clear_rest = clear_scripts (i + 1) rest
    234 
    235       -- For NONE/SINGLE: zero out sequence numbers for other inputs
    236       zero_other_sequences :: Int -> [TxIn] -> [TxIn]
    237       zero_other_sequences !_ [] = []
    238       zero_other_sequences !i (inp : rest)
    239         | i == idx  = inp : zero_other_sequences (i + 1) rest
    240         | otherwise =
    241             inp { txin_sequence = 0 } : zero_other_sequences (i + 1) rest
    242 
    243       -- Process inputs based on sighash type
    244       !inputs_cleared = clear_scripts 0 inputs_list
    245 
    246       !inputs_processed = case base of
    247         BaseNone   -> zero_other_sequences 0 inputs_cleared
    248         BaseSingle -> zero_other_sequences 0 inputs_cleared
    249         _          -> inputs_cleared
    250 
    251       -- ANYONECANPAY: keep only signing input
    252       !final_inputs
    253         | anyonecanpay = case safe_index inputs_processed idx of
    254             Just inp -> [inp]
    255             Nothing  -> []  -- shouldn't happen if idx is valid
    256         | otherwise = inputs_processed
    257 
    258       -- Process outputs based on sighash type
    259       !final_outputs = case base of
    260         BaseNone   -> []
    261         BaseSingle -> build_single_outputs outputs_list idx
    262         _          -> outputs_list
    263 
    264   in  to_strict $
    265          put_word32_le tx_version
    266       <> put_compact (fromIntegral (length final_inputs))
    267       <> foldMap put_txin_legacy final_inputs
    268       <> put_compact (fromIntegral (length final_outputs))
    269       <> foldMap put_txout final_outputs
    270       <> put_word32_le tx_locktime
    271       <> put_word32_le ht
    272 
    273 -- | Build outputs for SIGHASH_SINGLE: keep only output at idx,
    274 --   replace earlier outputs with empty/zero outputs.
    275 build_single_outputs :: [TxOut] -> Int -> [TxOut]
    276 build_single_outputs !outs !target_idx = go 0 outs
    277   where
    278     go :: Int -> [TxOut] -> [TxOut]
    279     go !_ [] = []
    280     go !i (o : rest)
    281       | i == target_idx = [o]  -- keep this one and stop
    282       | i < target_idx  = empty_output : go (i + 1) rest
    283       | otherwise       = []   -- shouldn't reach here
    284 
    285     -- Empty output: -1 (0xffffffffffffffff) value, empty script
    286     empty_output :: TxOut
    287     empty_output = TxOut 0xffffffffffffffff BS.empty
    288 
    289 -- | Safe list indexing.
    290 safe_index :: [a] -> Int -> Maybe a
    291 safe_index [] _ = Nothing
    292 safe_index (x : xs) !n
    293   | n < 0     = Nothing
    294   | n == 0    = Just x
    295   | otherwise = safe_index xs (n - 1)
    296 {-# INLINE safe_index #-}
    297 
    298 -- | Encode TxIn for legacy sighash (same as normal encoding).
    299 put_txin_legacy :: TxIn -> BSB.Builder
    300 put_txin_legacy TxIn{..} =
    301        put_outpoint txin_prevout
    302     <> put_compact (fromIntegral (BS.length txin_script_sig))
    303     <> BSB.byteString txin_script_sig
    304     <> put_word32_le txin_sequence
    305 {-# INLINE put_txin_legacy #-}
    306 
    307 -- BIP143 segwit sighash -------------------------------------------------------
    308 
    309 -- | Compute BIP143 segwit sighash.
    310 --
    311 --   Required for signing segwit inputs (P2WPKH, P2WSH). Unlike legacy
    312 --   sighash, this commits to the value being spent, preventing fee
    313 --   manipulation attacks. The @hashType@ is committed to the preimage
    314 --   verbatim; only its low byte determines behavior.
    315 --
    316 --   Returns 'Nothing' if the input index is out of range.
    317 --
    318 --   @
    319 --   -- sign P2WPKH input 0
    320 --   let scriptCode = ...  -- P2WPKH scriptCode
    321 --   let hash = sighash_segwit tx 0 scriptCode inputValue
    322 --                  (encode_sighash SIGHASH_ALL)
    323 --   -- use hash with ECDSA signing (after checking Just)
    324 --   @
    325 sighash_segwit
    326   :: Tx
    327   -> Int              -- ^ input index
    328   -> BS.ByteString    -- ^ scriptCode
    329   -> Word64           -- ^ value being spent (satoshis)
    330   -> Word32           -- ^ hashType
    331   -> Maybe BS.ByteString    -- ^ 32-byte hash, or Nothing if index invalid
    332 sighash_segwit !tx !idx !script_code !value !ht = do
    333   preimage <- build_bip143_preimage tx idx script_code value ht
    334   pure $! hash256 preimage
    335 
    336 -- | Build BIP143 preimage for signing.
    337 --   Returns Nothing if the input index is out of range.
    338 build_bip143_preimage
    339   :: Tx
    340   -> Int
    341   -> BS.ByteString
    342   -> Word64
    343   -> Word32
    344   -> Maybe BS.ByteString
    345 build_bip143_preimage Tx{..} !idx !script_code !value !ht = do
    346   -- Get the input being signed; fail if index out of range
    347   let !inputs_list = NE.toList tx_inputs
    348       !outputs_list = NE.toList tx_outputs
    349   signing_input <- safe_index inputs_list idx
    350 
    351   let !base = base_type ht
    352       !anyonecanpay = is_anyonecanpay ht
    353 
    354       -- hashPrevouts: double SHA256 of all outpoints, or zero if ANYONECANPAY
    355       !hash_prevouts
    356         | anyonecanpay = zero32
    357         | otherwise    = hash256 $ to_strict $
    358             foldMap (put_outpoint . txin_prevout) tx_inputs
    359 
    360       -- hashSequence: double SHA256 of all sequences, or zero if
    361       -- ANYONECANPAY or NONE or SINGLE
    362       !hash_sequence
    363         | anyonecanpay        = zero32
    364         | base == BaseSingle  = zero32
    365         | base == BaseNone    = zero32
    366         | otherwise = hash256 $ to_strict $
    367             foldMap (put_word32_le . txin_sequence) tx_inputs
    368 
    369       -- hashOutputs: depends on sighash type
    370       !hash_outputs = case base of
    371         BaseNone   -> zero32
    372         BaseSingle ->
    373           case safe_index outputs_list idx of
    374             Nothing  -> zero32  -- index out of range
    375             Just out -> hash256 $ to_strict $ put_txout out
    376         _ -> hash256 $ to_strict $ foldMap put_txout tx_outputs
    377 
    378       !outpoint = txin_prevout signing_input
    379       !sequence_n = txin_sequence signing_input
    380 
    381   pure $! to_strict $
    382        put_word32_le tx_version
    383     <> BSB.byteString hash_prevouts
    384     <> BSB.byteString hash_sequence
    385     <> put_outpoint outpoint
    386     <> put_compact (fromIntegral (BS.length script_code))
    387     <> BSB.byteString script_code
    388     <> put_word64_le value
    389     <> put_word32_le sequence_n
    390     <> BSB.byteString hash_outputs
    391     <> put_word32_le tx_locktime
    392     <> put_word32_le ht
    393 
    394 -- BIP341 taproot sighash ----------------------------------------------------
    395 
    396 -- | Precomputed BIP340 tagged-hash key for @\"TapSighash\"@.
    397 tap_sighash_tag :: BS.ByteString
    398 tap_sighash_tag = SHA256.hash "TapSighash"
    399 {-# NOINLINE tap_sighash_tag #-}
    400 
    401 -- | BIP340 tagged hash with the @\"TapSighash\"@ tag:
    402 --   @SHA256(tag_hash || tag_hash || msg)@.
    403 tap_sighash :: BS.ByteString -> BS.ByteString
    404 tap_sighash !msg =
    405   SHA256.hash (tap_sighash_tag <> tap_sighash_tag <> msg)
    406 {-# INLINE tap_sighash #-}
    407 
    408 -- | Single SHA256 of a Builder's output.
    409 sha :: BSB.Builder -> BS.ByteString
    410 sha = SHA256.hash . to_strict
    411 {-# INLINE sha #-}
    412 
    413 -- | Compact-size length-prefixed bytes (Bitcoin @ser_string@).
    414 put_bytes :: BS.ByteString -> BSB.Builder
    415 put_bytes !bs =
    416      put_compact (fromIntegral (BS.length bs))
    417   <> BSB.byteString bs
    418 {-# INLINE put_bytes #-}
    419 
    420 -- | Valid taproot hash types per BIP341: 0x00 (DEFAULT), 0x01..0x03,
    421 --   0x81..0x83. Non-canonical values are signalled as invalid in
    422 --   contrast with legacy\/segwit, which commit arbitrary 32-bit values.
    423 is_valid_taproot_ht :: Word8 -> Bool
    424 is_valid_taproot_ht !ht =
    425      ht == 0x00 || ht == 0x01 || ht == 0x02 || ht == 0x03
    426   || ht == 0x81 || ht == 0x82 || ht == 0x83
    427 {-# INLINE is_valid_taproot_ht #-}
    428 
    429 -- | Compute BIP341 taproot sighash for a /key-path/ spend.
    430 --
    431 --   The caller must supply, in input order, the amount and
    432 --   scriptPubKey of every previous output being spent (the entire
    433 --   set is committed to the preimage when not using
    434 --   @SIGHASH_ANYONECANPAY@).
    435 --
    436 --   The annex, if present, must include the mandatory 0x50 prefix
    437 --   byte (as it appears in the witness).
    438 --
    439 --   Returns 'Nothing' if any of the following holds:
    440 --
    441 --     * @hash_type@ is not a canonical taproot value
    442 --     * the input index is out of range
    443 --     * @amounts@ or @scriptPubKeys@ does not match the input count
    444 --     * an annex is supplied without the 0x50 prefix or is empty
    445 --     * @hash_type@ is @SIGHASH_SINGLE@ (or its ACP variant) and the
    446 --       input index has no corresponding output (such a signature
    447 --       would be consensus-invalid per BIP341)
    448 --
    449 --   @
    450 --   sighash_taproot_keypath tx 0 amounts scriptPubKeys Nothing 0x00
    451 --   @
    452 sighash_taproot_keypath
    453   :: Tx
    454   -> Int                  -- ^ input index
    455   -> [Word64]             -- ^ amounts for all inputs (in order)
    456   -> [BS.ByteString]      -- ^ scriptPubKeys for all inputs (in order)
    457   -> Maybe BS.ByteString  -- ^ optional annex (including 0x50 prefix)
    458   -> Word8                -- ^ hash type
    459   -> Maybe BS.ByteString  -- ^ 32-byte hash, or Nothing on invalid input
    460 sighash_taproot_keypath !tx !idx !amts !spks !annex !ht =
    461   taproot_sighash tx idx amts spks annex Nothing ht
    462 
    463 -- | Compute BIP341 taproot sighash for a /script-path/ (tapscript)
    464 --   spend.
    465 --
    466 --   In addition to the key-path inputs, takes:
    467 --
    468 --     * the 32-byte tap leaf hash (BIP342: tagged hash of @leaf_ver ||
    469 --       ser_string(script)@), computed by the caller
    470 --     * the codeseparator position (0xffffffff if none was executed)
    471 --
    472 --   Returns 'Nothing' under the same conditions as
    473 --   'sighash_taproot_keypath', plus when @tap_leaf_hash@ is not
    474 --   exactly 32 bytes.
    475 sighash_taproot_scriptpath
    476   :: Tx
    477   -> Int                  -- ^ input index
    478   -> [Word64]             -- ^ amounts for all inputs (in order)
    479   -> [BS.ByteString]      -- ^ scriptPubKeys for all inputs (in order)
    480   -> Maybe BS.ByteString  -- ^ optional annex (including 0x50 prefix)
    481   -> BS.ByteString        -- ^ tap leaf hash (32 bytes)
    482   -> Word32               -- ^ codeseparator position
    483   -> Word8                -- ^ hash type
    484   -> Maybe BS.ByteString
    485 sighash_taproot_scriptpath !tx !idx !amts !spks !annex !leaf !csep !ht =
    486   taproot_sighash tx idx amts spks annex (Just (leaf, csep)) ht
    487 
    488 -- | Internal worker shared by 'sighash_taproot_keypath' and
    489 --   'sighash_taproot_scriptpath'. @Nothing@ for the extension argument
    490 --   selects the key-path; @Just (leaf_hash, codesep_pos)@ selects the
    491 --   script-path.
    492 taproot_sighash
    493   :: Tx
    494   -> Int
    495   -> [Word64]
    496   -> [BS.ByteString]
    497   -> Maybe BS.ByteString
    498   -> Maybe (BS.ByteString, Word32)
    499   -> Word8
    500   -> Maybe BS.ByteString
    501 taproot_sighash Tx{..} !idx !amts !spks !annex !sp_ext !ht = do
    502   guard (is_valid_taproot_ht ht)
    503   case annex of
    504     Just a  -> guard (not (BS.null a) && BS.index a 0 == 0x50)
    505     Nothing -> pure ()
    506   case sp_ext of
    507     Just (lh, _) -> guard (BS.length lh == 32)
    508     Nothing      -> pure ()
    509 
    510   let !inputs_list  = NE.toList tx_inputs
    511       !outputs_list = NE.toList tx_outputs
    512       !n_inputs     = length inputs_list
    513       !n_outputs    = length outputs_list
    514 
    515   guard (idx >= 0 && idx < n_inputs)
    516   guard (length amts == n_inputs)
    517   guard (length spks == n_inputs)
    518   -- BIP341: SIGHASH_SINGLE without a corresponding output is invalid;
    519   -- reject rather than return a digest no consensus-valid signature
    520   -- could match.
    521   guard (ht .&. 0x03 /= 0x03 || idx < n_outputs)
    522 
    523   signing_input  <- safe_index inputs_list idx
    524   signing_amount <- safe_index amts         idx
    525   signing_spk    <- safe_index spks         idx
    526 
    527   let -- BIP341 maps DEFAULT (0x00) to ALL for output handling.
    528       out_type | ht == 0x00 = 0x01 :: Word8
    529                | otherwise  = ht .&. 0x03
    530       acp           = (ht .&. 0x80) /= 0
    531       annex_present = case annex  of Just _ -> True; Nothing -> False
    532       ext_flag      = case sp_ext of Just _ -> 1;    Nothing -> 0 :: Word8
    533       spend_type    = ext_flag * 2 + (if annex_present then 1 else 0)
    534 
    535       -- Lazily bound: ACP omits these four; NONE/SINGLE omit sha_outputs.
    536       sha_prevouts =
    537         sha (foldMap (put_outpoint . txin_prevout) inputs_list)
    538       sha_amounts       = sha (foldMap put_word64_le amts)
    539       sha_scriptpubkeys = sha (foldMap put_bytes spks)
    540       sha_sequences     =
    541         sha (foldMap (put_word32_le . txin_sequence) inputs_list)
    542       sha_outputs_all   = sha (foldMap put_txout outputs_list)
    543 
    544       sha_annex_bs = case annex of
    545         Just a  -> sha (put_bytes a)
    546         Nothing -> BS.empty
    547 
    548       -- safe_index always succeeds for SINGLE post-guard above; the
    549       -- fallback is defensive and unreachable in practice.
    550       sha_single_output_bs = case safe_index outputs_list idx of
    551         Just o  -> sha (put_txout o)
    552         Nothing -> BS.empty
    553 
    554       msg = to_strict $
    555            BSB.word8 0x00              -- epoch
    556         <> BSB.word8 ht                -- hash_type
    557         <> put_word32_le tx_version
    558         <> put_word32_le tx_locktime
    559         <> (if acp
    560               then mempty
    561               else BSB.byteString sha_prevouts
    562                 <> BSB.byteString sha_amounts
    563                 <> BSB.byteString sha_scriptpubkeys
    564                 <> BSB.byteString sha_sequences)
    565         <> (if out_type == 0x01
    566               then BSB.byteString sha_outputs_all
    567               else mempty)
    568         <> BSB.word8 spend_type
    569         <> (if acp
    570               then put_outpoint   (txin_prevout signing_input)
    571                 <> put_word64_le  signing_amount
    572                 <> put_bytes      signing_spk
    573                 <> put_word32_le  (txin_sequence signing_input)
    574               else put_word32_le (fromIntegral idx))
    575         <> (if annex_present
    576               then BSB.byteString sha_annex_bs
    577               else mempty)
    578         <> (if out_type == 0x03
    579               then BSB.byteString sha_single_output_bs
    580               else mempty)
    581         <> (case sp_ext of
    582               Just (leaf, csep) ->
    583                    BSB.byteString leaf
    584                 <> BSB.word8 0x00       -- key_version
    585                 <> put_word32_le csep
    586               Nothing -> mempty)
    587 
    588   pure $! tap_sighash msg