{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- |
-- Module: Bitcoin.Prim.Tx.Sighash
-- Copyright: (c) 2025 Jared Tobin
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
-- Sighash computation for legacy, BIP143 segwit, and BIP341 taproot
-- transactions.

module Bitcoin.Prim.Tx.Sighash (
    -- * Sighash Types
    SighashType(..)
  , encode_sighash

    -- * Legacy Sighash
  , sighash_legacy

    -- * BIP143 Segwit Sighash
  , sighash_segwit

    -- * BIP341 Taproot Sighash
  , sighash_taproot_keypath
  , sighash_taproot_scriptpath

    -- * Internal
  , strip_codeseparators
  ) where

import Bitcoin.Prim.Tx
    ( Tx(..)
    , TxIn(..)
    , TxOut(..)
    , put_word32_le
    , put_word64_le
    , put_compact
    , put_outpoint
    , put_txout
    , to_strict
    )
import Control.Monad (guard)
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, Word32, Word64)
import GHC.Generics (Generic)

-- | 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
  | SIGHASH_SINGLE
  | SIGHASH_ALL_ANYONECANPAY
  | SIGHASH_NONE_ANYONECANPAY
  | SIGHASH_SINGLE_ANYONECANPAY
  deriving (SighashType -> SighashType -> Bool
(SighashType -> SighashType -> Bool)
-> (SighashType -> SighashType -> Bool) -> Eq SighashType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SighashType -> SighashType -> Bool
== :: SighashType -> SighashType -> Bool
$c/= :: SighashType -> SighashType -> Bool
/= :: SighashType -> SighashType -> Bool
Eq, Int -> SighashType -> ShowS
[SighashType] -> ShowS
SighashType -> String
(Int -> SighashType -> ShowS)
-> (SighashType -> String)
-> ([SighashType] -> ShowS)
-> Show SighashType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SighashType -> ShowS
showsPrec :: Int -> SighashType -> ShowS
$cshow :: SighashType -> String
show :: SighashType -> String
$cshowList :: [SighashType] -> ShowS
showList :: [SighashType] -> ShowS
Show, (forall x. SighashType -> Rep SighashType x)
-> (forall x. Rep SighashType x -> SighashType)
-> Generic SighashType
forall x. Rep SighashType x -> SighashType
forall x. SighashType -> Rep SighashType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SighashType -> Rep SighashType x
from :: forall x. SighashType -> Rep SighashType x
$cto :: forall x. Rep SighashType x -> SighashType
to :: forall x. Rep SighashType x -> SighashType
Generic)

-- | 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 :: SighashType -> Word32
encode_sighash !SighashType
st = case SighashType
st of
  SighashType
SIGHASH_ALL                 -> Word32
0x01
  SighashType
SIGHASH_NONE                -> Word32
0x02
  SighashType
SIGHASH_SINGLE              -> Word32
0x03
  SighashType
SIGHASH_ALL_ANYONECANPAY    -> Word32
0x81
  SighashType
SIGHASH_NONE_ANYONECANPAY   -> Word32
0x82
  SighashType
SIGHASH_SINGLE_ANYONECANPAY -> Word32
0x83
{-# INLINE encode_sighash #-}

-- | Internal base sighash classification derived from a 32-bit hashType.
data BaseType = BaseAll | BaseNone | BaseSingle
  deriving BaseType -> BaseType -> Bool
(BaseType -> BaseType -> Bool)
-> (BaseType -> BaseType -> Bool) -> Eq BaseType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BaseType -> BaseType -> Bool
== :: BaseType -> BaseType -> Bool
$c/= :: BaseType -> BaseType -> Bool
/= :: BaseType -> BaseType -> Bool
Eq

-- | Behavioral base type: @hashType & 0x1f@. 2 → NONE, 3 → SINGLE,
--   anything else → ALL.
base_type :: Word32 -> BaseType
base_type :: Word32 -> BaseType
base_type !Word32
ht = case Word32
ht Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x1f of
  Word32
2 -> BaseType
BaseNone
  Word32
3 -> BaseType
BaseSingle
  Word32
_ -> BaseType
BaseAll
{-# INLINE base_type #-}

-- | Check ANYONECANPAY flag: @hashType & 0x80@.
is_anyonecanpay :: Word32 -> Bool
is_anyonecanpay :: Word32 -> Bool
is_anyonecanpay !Word32
ht = (Word32
ht Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x80) Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0
{-# INLINE is_anyonecanpay #-}

-- | 32 zero bytes.
zero32 :: BS.ByteString
zero32 :: ByteString
zero32 = Int -> Word8 -> ByteString
BS.replicate Int
32 Word8
0x00
{-# NOINLINE zero32 #-}

-- | Hash of 0x01 followed by 31 zero bytes (SIGHASH_SINGLE edge case).
sighash_single_bug :: BS.ByteString
sighash_single_bug :: ByteString
sighash_single_bug = Word8 -> ByteString -> ByteString
BS.cons Word8
0x01 (Int -> Word8 -> ByteString
BS.replicate Int
31 Word8
0x00)
{-# NOINLINE sighash_single_bug #-}

-- | Double SHA256.
hash256 :: BS.ByteString -> BS.ByteString
hash256 :: ByteString -> ByteString
hash256 = ByteString -> ByteString
SHA256.hash (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
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 :: ByteString -> ByteString
strip_codeseparators !ByteString
script
  | Bool -> Bool
not (Word8
0xab Word8 -> ByteString -> Bool
`BS.elem` ByteString
script) = ByteString
script  -- fast path: nothing to strip
  | Bool
otherwise = [Word8] -> ByteString
BS.pack ([Word8] -> [Word8]
go (ByteString -> [Word8]
BS.unpack ByteString
script))
  where
    go :: [Word8] -> [Word8]
    go :: [Word8] -> [Word8]
go [] = []
    go (Word8
b : [Word8]
rest)
      | Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xab              = [Word8] -> [Word8]
go [Word8]
rest
      | Word8
b Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x01 Bool -> Bool -> Bool
&& Word8
b Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x4b = Int -> [Word8] -> [Word8] -> [Word8]
push (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) [Word8
b] [Word8]
rest
      | Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x4c              = case [Word8]
rest of
          (Word8
n : [Word8]
rest') -> Int -> [Word8] -> [Word8] -> [Word8]
push (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n) [Word8
b, Word8
n] [Word8]
rest'
          []          -> [Word8
b]
      | Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x4d              = case [Word8]
rest of
          (Word8
n0 : Word8
n1 : [Word8]
rest') ->
            let !len :: Int
len = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n0
                     Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
0x100
            in  Int -> [Word8] -> [Word8] -> [Word8]
push Int
len [Word8
b, Word8
n0, Word8
n1] [Word8]
rest'
          [Word8]
_ -> Word8
b Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8]
rest
      | Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x4e              = case [Word8]
rest of
          (Word8
n0 : Word8
n1 : Word8
n2 : Word8
n3 : [Word8]
rest') ->
            let !len :: Int
len = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n0
                     Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
0x100
                     Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
0x10000
                     Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
0x1000000
            in  Int -> [Word8] -> [Word8] -> [Word8]
push Int
len [Word8
b, Word8
n0, Word8
n1, Word8
n2, Word8
n3] [Word8]
rest'
          [Word8]
_ -> Word8
b Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8]
rest
      | Bool
otherwise              = Word8
b Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8] -> [Word8]
go [Word8]
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 :: Int -> [Word8] -> [Word8] -> [Word8]
push !Int
len ![Word8]
header ![Word8]
rest =
      let ([Word8]
chunk, [Word8]
rest') = Int -> [Word8] -> ([Word8], [Word8])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
len [Word8]
rest
      in  [Word8]
header [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ [Word8]
chunk [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ [Word8] -> [Word8]
go [Word8]
rest'
{-# INLINABLE strip_codeseparators #-}

-- legacy sighash -------------------------------------------------------------

-- | Compute legacy sighash for P2PKH/P2SH inputs.
--
--   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 (encode_sighash SIGHASH_ALL)
--   -- non-canonical hashType (consensus-valid, committed raw)
--   let hash = sighash_legacy tx 0 scriptPubKey 0x6f29291f
--   @
--
--   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
  -> Word32           -- ^ hashType
  -> BS.ByteString    -- ^ 32-byte hash
sighash_legacy :: Tx -> Int -> ByteString -> Word32 -> ByteString
sighash_legacy !Tx
tx !Int
idx !ByteString
script_pubkey !Word32
ht
  -- SIGHASH_SINGLE edge case: index >= number of outputs
  | BaseType
base BaseType -> BaseType -> Bool
forall a. Eq a => a -> a -> Bool
== BaseType
BaseSingle Bool -> Bool -> Bool
&& Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= NonEmpty TxOut -> Int
forall a. NonEmpty a -> Int
NE.length (Tx -> NonEmpty TxOut
tx_outputs Tx
tx) =
      ByteString
sighash_single_bug
  | Bool
otherwise =
      let !serialized :: ByteString
serialized = Tx -> Int -> ByteString -> Word32 -> ByteString
serialize_legacy_sighash Tx
tx Int
idx ByteString
script_pubkey Word32
ht
      in  ByteString -> ByteString
hash256 ByteString
serialized
  where
    !base :: BaseType
base = Word32 -> BaseType
base_type Word32
ht

-- | Serialize transaction for legacy sighash computation.
--   Handles all sighash flags directly without constructing intermediate Tx.
serialize_legacy_sighash
  :: Tx
  -> Int
  -> BS.ByteString
  -> Word32
  -> BS.ByteString
serialize_legacy_sighash :: Tx -> Int -> ByteString -> Word32 -> ByteString
serialize_legacy_sighash Tx{[Witness]
Word32
NonEmpty TxOut
NonEmpty TxIn
tx_outputs :: Tx -> NonEmpty TxOut
tx_version :: Word32
tx_inputs :: NonEmpty TxIn
tx_outputs :: NonEmpty TxOut
tx_witnesses :: [Witness]
tx_locktime :: Word32
tx_locktime :: Tx -> Word32
tx_witnesses :: Tx -> [Witness]
tx_inputs :: Tx -> NonEmpty TxIn
tx_version :: Tx -> Word32
..} !Int
idx !ByteString
script_pubkey !Word32
ht =
  let !script' :: ByteString
script' = ByteString -> ByteString
strip_codeseparators ByteString
script_pubkey
      !base :: BaseType
base = Word32 -> BaseType
base_type Word32
ht
      !anyonecanpay :: Bool
anyonecanpay = Word32 -> Bool
is_anyonecanpay Word32
ht
      !inputs_list :: [TxIn]
inputs_list = NonEmpty TxIn -> [TxIn]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty TxIn
tx_inputs
      !outputs_list :: [TxOut]
outputs_list = NonEmpty TxOut -> [TxOut]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty TxOut
tx_outputs

      -- Clear all scriptSigs, set signing input's script to scriptPubKey
      clear_scripts :: Int -> [TxIn] -> [TxIn]
      clear_scripts :: Int -> [TxIn] -> [TxIn]
clear_scripts !Int
_ [] = []
      clear_scripts !Int
i (TxIn
inp : [TxIn]
rest)
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
idx  = TxIn
inp { txin_script_sig = script' } TxIn -> [TxIn] -> [TxIn]
forall a. a -> [a] -> [a]
: [TxIn]
clear_rest
        | Bool
otherwise = TxIn
inp { txin_script_sig = BS.empty } TxIn -> [TxIn] -> [TxIn]
forall a. a -> [a] -> [a]
: [TxIn]
clear_rest
        where
          !clear_rest :: [TxIn]
clear_rest = Int -> [TxIn] -> [TxIn]
clear_scripts (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [TxIn]
rest

      -- For NONE/SINGLE: zero out sequence numbers for other inputs
      zero_other_sequences :: Int -> [TxIn] -> [TxIn]
      zero_other_sequences :: Int -> [TxIn] -> [TxIn]
zero_other_sequences !Int
_ [] = []
      zero_other_sequences !Int
i (TxIn
inp : [TxIn]
rest)
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
idx  = TxIn
inp TxIn -> [TxIn] -> [TxIn]
forall a. a -> [a] -> [a]
: Int -> [TxIn] -> [TxIn]
zero_other_sequences (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [TxIn]
rest
        | Bool
otherwise =
            TxIn
inp { txin_sequence = 0 } TxIn -> [TxIn] -> [TxIn]
forall a. a -> [a] -> [a]
: Int -> [TxIn] -> [TxIn]
zero_other_sequences (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [TxIn]
rest

      -- Process inputs based on sighash type
      !inputs_cleared :: [TxIn]
inputs_cleared = Int -> [TxIn] -> [TxIn]
clear_scripts Int
0 [TxIn]
inputs_list

      !inputs_processed :: [TxIn]
inputs_processed = case BaseType
base of
        BaseType
BaseNone   -> Int -> [TxIn] -> [TxIn]
zero_other_sequences Int
0 [TxIn]
inputs_cleared
        BaseType
BaseSingle -> Int -> [TxIn] -> [TxIn]
zero_other_sequences Int
0 [TxIn]
inputs_cleared
        BaseType
_          -> [TxIn]
inputs_cleared

      -- ANYONECANPAY: keep only signing input
      !final_inputs :: [TxIn]
final_inputs
        | Bool
anyonecanpay = case [TxIn] -> Int -> Maybe TxIn
forall a. [a] -> Int -> Maybe a
safe_index [TxIn]
inputs_processed Int
idx of
            Just TxIn
inp -> [TxIn
inp]
            Maybe TxIn
Nothing  -> []  -- shouldn't happen if idx is valid
        | Bool
otherwise = [TxIn]
inputs_processed

      -- Process outputs based on sighash type
      !final_outputs :: [TxOut]
final_outputs = case BaseType
base of
        BaseType
BaseNone   -> []
        BaseType
BaseSingle -> [TxOut] -> Int -> [TxOut]
build_single_outputs [TxOut]
outputs_list Int
idx
        BaseType
_          -> [TxOut]
outputs_list

  in  Builder -> ByteString
to_strict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
         Word32 -> Builder
put_word32_le Word32
tx_version
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
put_compact (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([TxIn] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxIn]
final_inputs))
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (TxIn -> Builder) -> [TxIn] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TxIn -> Builder
put_txin_legacy [TxIn]
final_inputs
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
put_compact (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([TxOut] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxOut]
final_outputs))
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (TxOut -> Builder) -> [TxOut] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TxOut -> Builder
put_txout [TxOut]
final_outputs
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
put_word32_le Word32
tx_locktime
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
put_word32_le Word32
ht

-- | Build outputs for SIGHASH_SINGLE: keep only output at idx,
--   replace earlier outputs with empty/zero outputs.
build_single_outputs :: [TxOut] -> Int -> [TxOut]
build_single_outputs :: [TxOut] -> Int -> [TxOut]
build_single_outputs ![TxOut]
outs !Int
target_idx = Int -> [TxOut] -> [TxOut]
go Int
0 [TxOut]
outs
  where
    go :: Int -> [TxOut] -> [TxOut]
    go :: Int -> [TxOut] -> [TxOut]
go !Int
_ [] = []
    go !Int
i (TxOut
o : [TxOut]
rest)
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
target_idx = [TxOut
o]  -- keep this one and stop
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
target_idx  = TxOut
empty_output TxOut -> [TxOut] -> [TxOut]
forall a. a -> [a] -> [a]
: Int -> [TxOut] -> [TxOut]
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [TxOut]
rest
      | Bool
otherwise       = []   -- shouldn't reach here

    -- Empty output: -1 (0xffffffffffffffff) value, empty script
    empty_output :: TxOut
    empty_output :: TxOut
empty_output = Word64 -> ByteString -> TxOut
TxOut Word64
0xffffffffffffffff ByteString
BS.empty

-- | Safe list indexing.
safe_index :: [a] -> Int -> Maybe a
safe_index :: forall a. [a] -> Int -> Maybe a
safe_index [] Int
_ = Maybe a
forall a. Maybe a
Nothing
safe_index (a
x : [a]
xs) !Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = Maybe a
forall a. Maybe a
Nothing
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = a -> Maybe a
forall a. a -> Maybe a
Just a
x
  | Bool
otherwise = [a] -> Int -> Maybe a
forall a. [a] -> Int -> Maybe a
safe_index [a]
xs (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
{-# INLINE safe_index #-}

-- | Encode TxIn for legacy sighash (same as normal encoding).
put_txin_legacy :: TxIn -> BSB.Builder
put_txin_legacy :: TxIn -> Builder
put_txin_legacy TxIn{Word32
ByteString
OutPoint
txin_script_sig :: TxIn -> ByteString
txin_sequence :: TxIn -> Word32
txin_prevout :: OutPoint
txin_script_sig :: ByteString
txin_sequence :: Word32
txin_prevout :: TxIn -> OutPoint
..} =
       OutPoint -> Builder
put_outpoint OutPoint
txin_prevout
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
put_compact (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
txin_script_sig))
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BSB.byteString ByteString
txin_script_sig
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
put_word32_le Word32
txin_sequence
{-# INLINE put_txin_legacy #-}

-- BIP143 segwit sighash -------------------------------------------------------

-- | Compute BIP143 segwit sighash.
--
--   Required for signing segwit inputs (P2WPKH, P2WSH). Unlike legacy
--   sighash, this commits to the value being spent, preventing fee
--   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
--                  (encode_sighash SIGHASH_ALL)
--   -- use hash with ECDSA signing (after checking Just)
--   @
sighash_segwit
  :: Tx
  -> Int              -- ^ input index
  -> BS.ByteString    -- ^ scriptCode
  -> Word64           -- ^ value being spent (satoshis)
  -> Word32           -- ^ hashType
  -> Maybe BS.ByteString    -- ^ 32-byte hash, or Nothing if index invalid
sighash_segwit :: Tx -> Int -> ByteString -> Word64 -> Word32 -> Maybe ByteString
sighash_segwit !Tx
tx !Int
idx !ByteString
script_code !Word64
value !Word32
ht = do
  preimage <- Tx -> Int -> ByteString -> Word64 -> Word32 -> Maybe ByteString
build_bip143_preimage Tx
tx Int
idx ByteString
script_code Word64
value Word32
ht
  pure $! hash256 preimage

-- | Build BIP143 preimage for signing.
--   Returns Nothing if the input index is out of range.
build_bip143_preimage
  :: Tx
  -> Int
  -> BS.ByteString
  -> Word64
  -> Word32
  -> Maybe BS.ByteString
build_bip143_preimage :: Tx -> Int -> ByteString -> Word64 -> Word32 -> Maybe ByteString
build_bip143_preimage Tx{[Witness]
Word32
NonEmpty TxOut
NonEmpty TxIn
tx_outputs :: Tx -> NonEmpty TxOut
tx_locktime :: Tx -> Word32
tx_witnesses :: Tx -> [Witness]
tx_inputs :: Tx -> NonEmpty TxIn
tx_version :: Tx -> Word32
tx_version :: Word32
tx_inputs :: NonEmpty TxIn
tx_outputs :: NonEmpty TxOut
tx_witnesses :: [Witness]
tx_locktime :: Word32
..} !Int
idx !ByteString
script_code !Word64
value !Word32
ht = do
  -- Get the input being signed; fail if index out of range
  let !inputs_list :: [TxIn]
inputs_list = NonEmpty TxIn -> [TxIn]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty TxIn
tx_inputs
      !outputs_list :: [TxOut]
outputs_list = NonEmpty TxOut -> [TxOut]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty TxOut
tx_outputs
  signing_input <- [TxIn] -> Int -> Maybe TxIn
forall a. [a] -> Int -> Maybe a
safe_index [TxIn]
inputs_list Int
idx

  let !base = Word32 -> BaseType
base_type Word32
ht
      !anyonecanpay = Word32 -> Bool
is_anyonecanpay Word32
ht

      -- hashPrevouts: double SHA256 of all outpoints, or zero if ANYONECANPAY
      !hash_prevouts
        | Bool
anyonecanpay = ByteString
zero32
        | Bool
otherwise    = ByteString -> ByteString
hash256 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
to_strict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
            (TxIn -> Builder) -> NonEmpty TxIn -> Builder
forall m a. Monoid m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (OutPoint -> Builder
put_outpoint (OutPoint -> Builder) -> (TxIn -> OutPoint) -> TxIn -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn -> OutPoint
txin_prevout) NonEmpty TxIn
tx_inputs

      -- hashSequence: double SHA256 of all sequences, or zero if
      -- ANYONECANPAY or NONE or SINGLE
      !hash_sequence
        | Bool
anyonecanpay        = ByteString
zero32
        | BaseType
base BaseType -> BaseType -> Bool
forall a. Eq a => a -> a -> Bool
== BaseType
BaseSingle  = ByteString
zero32
        | BaseType
base BaseType -> BaseType -> Bool
forall a. Eq a => a -> a -> Bool
== BaseType
BaseNone    = ByteString
zero32
        | Bool
otherwise = ByteString -> ByteString
hash256 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
to_strict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
            (TxIn -> Builder) -> NonEmpty TxIn -> Builder
forall m a. Monoid m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Word32 -> Builder
put_word32_le (Word32 -> Builder) -> (TxIn -> Word32) -> TxIn -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn -> Word32
txin_sequence) NonEmpty TxIn
tx_inputs

      -- hashOutputs: depends on sighash type
      !hash_outputs = case BaseType
base of
        BaseType
BaseNone   -> ByteString
zero32
        BaseType
BaseSingle ->
          case [TxOut] -> Int -> Maybe TxOut
forall a. [a] -> Int -> Maybe a
safe_index [TxOut]
outputs_list Int
idx of
            Maybe TxOut
Nothing  -> ByteString
zero32  -- index out of range
            Just TxOut
out -> ByteString -> ByteString
hash256 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
to_strict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ TxOut -> Builder
put_txout TxOut
out
        BaseType
_ -> ByteString -> ByteString
hash256 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
to_strict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ (TxOut -> Builder) -> NonEmpty TxOut -> Builder
forall m a. Monoid m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TxOut -> Builder
put_txout NonEmpty TxOut
tx_outputs

      !outpoint = TxIn -> OutPoint
txin_prevout TxIn
signing_input
      !sequence_n = TxIn -> Word32
txin_sequence TxIn
signing_input

  pure $! to_strict $
       put_word32_le tx_version
    <> BSB.byteString hash_prevouts
    <> BSB.byteString hash_sequence
    <> put_outpoint outpoint
    <> put_compact (fromIntegral (BS.length script_code))
    <> BSB.byteString script_code
    <> put_word64_le value
    <> put_word32_le sequence_n
    <> BSB.byteString hash_outputs
    <> put_word32_le tx_locktime
    <> put_word32_le ht

-- BIP341 taproot sighash ----------------------------------------------------

-- | Precomputed BIP340 tagged-hash key for @\"TapSighash\"@.
tap_sighash_tag :: BS.ByteString
tap_sighash_tag :: ByteString
tap_sighash_tag = ByteString -> ByteString
SHA256.hash ByteString
"TapSighash"
{-# NOINLINE tap_sighash_tag #-}

-- | BIP340 tagged hash with the @\"TapSighash\"@ tag:
--   @SHA256(tag_hash || tag_hash || msg)@.
tap_sighash :: BS.ByteString -> BS.ByteString
tap_sighash :: ByteString -> ByteString
tap_sighash !ByteString
msg =
  ByteString -> ByteString
SHA256.hash (ByteString
tap_sighash_tag ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
tap_sighash_tag ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
msg)
{-# INLINE tap_sighash #-}

-- | Single SHA256 of a Builder's output.
sha :: BSB.Builder -> BS.ByteString
sha :: Builder -> ByteString
sha = ByteString -> ByteString
SHA256.hash (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
to_strict
{-# INLINE sha #-}

-- | Compact-size length-prefixed bytes (Bitcoin @ser_string@).
put_bytes :: BS.ByteString -> BSB.Builder
put_bytes :: ByteString -> Builder
put_bytes !ByteString
bs =
     Word64 -> Builder
put_compact (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
bs))
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BSB.byteString ByteString
bs
{-# INLINE put_bytes #-}

-- | Valid taproot hash types per BIP341: 0x00 (DEFAULT), 0x01..0x03,
--   0x81..0x83. Non-canonical values are signalled as invalid in
--   contrast with legacy\/segwit, which commit arbitrary 32-bit values.
is_valid_taproot_ht :: Word8 -> Bool
is_valid_taproot_ht :: Word8 -> Bool
is_valid_taproot_ht !Word8
ht =
     Word8
ht Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x00 Bool -> Bool -> Bool
|| Word8
ht Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x01 Bool -> Bool -> Bool
|| Word8
ht Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x02 Bool -> Bool -> Bool
|| Word8
ht Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x03
  Bool -> Bool -> Bool
|| Word8
ht Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x81 Bool -> Bool -> Bool
|| Word8
ht Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x82 Bool -> Bool -> Bool
|| Word8
ht Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x83
{-# INLINE is_valid_taproot_ht #-}

-- | Compute BIP341 taproot sighash for a /key-path/ spend.
--
--   The caller must supply, in input order, the amount and
--   scriptPubKey of every previous output being spent (the entire
--   set is committed to the preimage when not using
--   @SIGHASH_ANYONECANPAY@).
--
--   The annex, if present, must include the mandatory 0x50 prefix
--   byte (as it appears in the witness).
--
--   Returns 'Nothing' if any of the following holds:
--
--     * @hash_type@ is not a canonical taproot value
--     * the input index is out of range
--     * @amounts@ or @scriptPubKeys@ does not match the input count
--     * an annex is supplied without the 0x50 prefix or is empty
--     * @hash_type@ is @SIGHASH_SINGLE@ (or its ACP variant) and the
--       input index has no corresponding output (such a signature
--       would be consensus-invalid per BIP341)
--
--   @
--   sighash_taproot_keypath tx 0 amounts scriptPubKeys Nothing 0x00
--   @
sighash_taproot_keypath
  :: Tx
  -> Int                  -- ^ input index
  -> [Word64]             -- ^ amounts for all inputs (in order)
  -> [BS.ByteString]      -- ^ scriptPubKeys for all inputs (in order)
  -> Maybe BS.ByteString  -- ^ optional annex (including 0x50 prefix)
  -> Word8                -- ^ hash type
  -> Maybe BS.ByteString  -- ^ 32-byte hash, or Nothing on invalid input
sighash_taproot_keypath :: Tx
-> Int
-> [Word64]
-> [ByteString]
-> Maybe ByteString
-> Word8
-> Maybe ByteString
sighash_taproot_keypath !Tx
tx !Int
idx ![Word64]
amts ![ByteString]
spks !Maybe ByteString
annex !Word8
ht =
  Tx
-> Int
-> [Word64]
-> [ByteString]
-> Maybe ByteString
-> Maybe (ByteString, Word32)
-> Word8
-> Maybe ByteString
taproot_sighash Tx
tx Int
idx [Word64]
amts [ByteString]
spks Maybe ByteString
annex Maybe (ByteString, Word32)
forall a. Maybe a
Nothing Word8
ht

-- | Compute BIP341 taproot sighash for a /script-path/ (tapscript)
--   spend.
--
--   In addition to the key-path inputs, takes:
--
--     * the 32-byte tap leaf hash (BIP342: tagged hash of @leaf_ver ||
--       ser_string(script)@), computed by the caller
--     * the codeseparator position (0xffffffff if none was executed)
--
--   Returns 'Nothing' under the same conditions as
--   'sighash_taproot_keypath', plus when @tap_leaf_hash@ is not
--   exactly 32 bytes.
sighash_taproot_scriptpath
  :: Tx
  -> Int                  -- ^ input index
  -> [Word64]             -- ^ amounts for all inputs (in order)
  -> [BS.ByteString]      -- ^ scriptPubKeys for all inputs (in order)
  -> Maybe BS.ByteString  -- ^ optional annex (including 0x50 prefix)
  -> BS.ByteString        -- ^ tap leaf hash (32 bytes)
  -> Word32               -- ^ codeseparator position
  -> Word8                -- ^ hash type
  -> Maybe BS.ByteString
sighash_taproot_scriptpath :: Tx
-> Int
-> [Word64]
-> [ByteString]
-> Maybe ByteString
-> ByteString
-> Word32
-> Word8
-> Maybe ByteString
sighash_taproot_scriptpath !Tx
tx !Int
idx ![Word64]
amts ![ByteString]
spks !Maybe ByteString
annex !ByteString
leaf !Word32
csep !Word8
ht =
  Tx
-> Int
-> [Word64]
-> [ByteString]
-> Maybe ByteString
-> Maybe (ByteString, Word32)
-> Word8
-> Maybe ByteString
taproot_sighash Tx
tx Int
idx [Word64]
amts [ByteString]
spks Maybe ByteString
annex ((ByteString, Word32) -> Maybe (ByteString, Word32)
forall a. a -> Maybe a
Just (ByteString
leaf, Word32
csep)) Word8
ht

-- | Internal worker shared by 'sighash_taproot_keypath' and
--   'sighash_taproot_scriptpath'. @Nothing@ for the extension argument
--   selects the key-path; @Just (leaf_hash, codesep_pos)@ selects the
--   script-path.
taproot_sighash
  :: Tx
  -> Int
  -> [Word64]
  -> [BS.ByteString]
  -> Maybe BS.ByteString
  -> Maybe (BS.ByteString, Word32)
  -> Word8
  -> Maybe BS.ByteString
taproot_sighash :: Tx
-> Int
-> [Word64]
-> [ByteString]
-> Maybe ByteString
-> Maybe (ByteString, Word32)
-> Word8
-> Maybe ByteString
taproot_sighash Tx{[Witness]
Word32
NonEmpty TxOut
NonEmpty TxIn
tx_outputs :: Tx -> NonEmpty TxOut
tx_locktime :: Tx -> Word32
tx_witnesses :: Tx -> [Witness]
tx_inputs :: Tx -> NonEmpty TxIn
tx_version :: Tx -> Word32
tx_version :: Word32
tx_inputs :: NonEmpty TxIn
tx_outputs :: NonEmpty TxOut
tx_witnesses :: [Witness]
tx_locktime :: Word32
..} !Int
idx ![Word64]
amts ![ByteString]
spks !Maybe ByteString
annex !Maybe (ByteString, Word32)
sp_ext !Word8
ht = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word8 -> Bool
is_valid_taproot_ht Word8
ht)
  case Maybe ByteString
annex of
    Just ByteString
a  -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (ByteString -> Bool
BS.null ByteString
a) Bool -> Bool -> Bool
&& HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
a Int
0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x50)
    Maybe ByteString
Nothing -> () -> Maybe ()
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  case Maybe (ByteString, Word32)
sp_ext of
    Just (ByteString
lh, Word32
_) -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Int
BS.length ByteString
lh Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32)
    Maybe (ByteString, Word32)
Nothing      -> () -> Maybe ()
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  let !inputs_list :: [TxIn]
inputs_list  = NonEmpty TxIn -> [TxIn]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty TxIn
tx_inputs
      !outputs_list :: [TxOut]
outputs_list = NonEmpty TxOut -> [TxOut]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty TxOut
tx_outputs
      !n_inputs :: Int
n_inputs     = [TxIn] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxIn]
inputs_list
      !n_outputs :: Int
n_outputs    = [TxOut] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxOut]
outputs_list

  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n_inputs)
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([Word64] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word64]
amts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n_inputs)
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
spks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n_inputs)
  -- BIP341: SIGHASH_SINGLE without a corresponding output is invalid;
  -- reject rather than return a digest no consensus-valid signature
  -- could match.
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word8
ht Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x03 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x03 Bool -> Bool -> Bool
|| Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n_outputs)

  signing_input  <- [TxIn] -> Int -> Maybe TxIn
forall a. [a] -> Int -> Maybe a
safe_index [TxIn]
inputs_list Int
idx
  signing_amount <- safe_index amts         idx
  signing_spk    <- safe_index spks         idx

  let -- BIP341 maps DEFAULT (0x00) to ALL for output handling.
      out_type | Word8
ht Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x00 = Word8
0x01 :: Word8
               | Bool
otherwise  = Word8
ht Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x03
      acp           = (Word8
ht Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x80) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0
      annex_present = case Maybe ByteString
annex  of Just ByteString
_ -> Bool
True; Maybe ByteString
Nothing -> Bool
False
      ext_flag      = case Maybe (ByteString, Word32)
sp_ext of Just (ByteString, Word32)
_ -> Word8
1;    Maybe (ByteString, Word32)
Nothing -> Word8
0 :: Word8
      spend_type    = Word8
ext_flag Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
* Word8
2 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ (if Bool
annex_present then Word8
1 else Word8
0)

      -- Lazily bound: ACP omits these four; NONE/SINGLE omit sha_outputs.
      sha_prevouts =
        Builder -> ByteString
sha ((TxIn -> Builder) -> [TxIn] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (OutPoint -> Builder
put_outpoint (OutPoint -> Builder) -> (TxIn -> OutPoint) -> TxIn -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn -> OutPoint
txin_prevout) [TxIn]
inputs_list)
      sha_amounts       = Builder -> ByteString
sha ((Word64 -> Builder) -> [Word64] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Word64 -> Builder
put_word64_le [Word64]
amts)
      sha_scriptpubkeys = Builder -> ByteString
sha ((ByteString -> Builder) -> [ByteString] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ByteString -> Builder
put_bytes [ByteString]
spks)
      sha_sequences     =
        Builder -> ByteString
sha ((TxIn -> Builder) -> [TxIn] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Word32 -> Builder
put_word32_le (Word32 -> Builder) -> (TxIn -> Word32) -> TxIn -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn -> Word32
txin_sequence) [TxIn]
inputs_list)
      sha_outputs_all   = Builder -> ByteString
sha ((TxOut -> Builder) -> [TxOut] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TxOut -> Builder
put_txout [TxOut]
outputs_list)

      sha_annex_bs = case Maybe ByteString
annex of
        Just ByteString
a  -> Builder -> ByteString
sha (ByteString -> Builder
put_bytes ByteString
a)
        Maybe ByteString
Nothing -> ByteString
BS.empty

      -- safe_index always succeeds for SINGLE post-guard above; the
      -- fallback is defensive and unreachable in practice.
      sha_single_output_bs = case [TxOut] -> Int -> Maybe TxOut
forall a. [a] -> Int -> Maybe a
safe_index [TxOut]
outputs_list Int
idx of
        Just TxOut
o  -> Builder -> ByteString
sha (TxOut -> Builder
put_txout TxOut
o)
        Maybe TxOut
Nothing -> ByteString
BS.empty

      msg = Builder -> ByteString
to_strict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
           Word8 -> Builder
BSB.word8 Word8
0x00              -- epoch
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
ht                -- hash_type
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
put_word32_le Word32
tx_version
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
put_word32_le Word32
tx_locktime
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (if Bool
acp
              then Builder
forall a. Monoid a => a
mempty
              else ByteString -> Builder
BSB.byteString ByteString
sha_prevouts
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BSB.byteString ByteString
sha_amounts
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BSB.byteString ByteString
sha_scriptpubkeys
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BSB.byteString ByteString
sha_sequences)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (if Word8
out_type Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x01
              then ByteString -> Builder
BSB.byteString ByteString
sha_outputs_all
              else Builder
forall a. Monoid a => a
mempty)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
spend_type
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (if Bool
acp
              then OutPoint -> Builder
put_outpoint   (TxIn -> OutPoint
txin_prevout TxIn
signing_input)
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
put_word64_le  Word64
signing_amount
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
put_bytes      ByteString
signing_spk
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
put_word32_le  (TxIn -> Word32
txin_sequence TxIn
signing_input)
              else Word32 -> Builder
put_word32_le (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx))
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (if Bool
annex_present
              then ByteString -> Builder
BSB.byteString ByteString
sha_annex_bs
              else Builder
forall a. Monoid a => a
mempty)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (if Word8
out_type Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x03
              then ByteString -> Builder
BSB.byteString ByteString
sha_single_output_bs
              else Builder
forall a. Monoid a => a
mempty)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (case Maybe (ByteString, Word32)
sp_ext of
              Just (ByteString
leaf, Word32
csep) ->
                   ByteString -> Builder
BSB.byteString ByteString
leaf
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
0x00       -- key_version
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
put_word32_le Word32
csep
              Maybe (ByteString, Word32)
Nothing -> Builder
forall a. Monoid a => a
mempty)

  pure $! tap_sighash msg