Sighash.hs (10256B)
1 {-# OPTIONS_HADDOCK prune #-} 2 {-# LANGUAGE BangPatterns #-} 3 {-# LANGUAGE DeriveGeneric #-} 4 {-# LANGUAGE RecordWildCards #-} 5 6 -- | 7 -- Module: Bitcoin.Prim.Tx.Sighash 8 -- Copyright: (c) 2025 Jared Tobin 9 -- License: MIT 10 -- Maintainer: Jared Tobin <jared@ppad.tech> 11 -- 12 -- Sighash computation for legacy and BIP143 segwit transactions. 13 14 module Bitcoin.Prim.Tx.Sighash ( 15 -- * Sighash Types 16 SighashType(..) 17 18 -- * Legacy Sighash 19 , sighash_legacy 20 21 -- * BIP143 Segwit Sighash 22 , sighash_segwit 23 ) where 24 25 import Bitcoin.Prim.Tx 26 ( Tx(..) 27 , TxIn(..) 28 , TxOut(..) 29 , put_word32_le 30 , put_word64_le 31 , put_compact 32 , put_outpoint 33 , put_txout 34 , to_strict 35 ) 36 import qualified Crypto.Hash.SHA256 as SHA256 37 import qualified Data.ByteString as BS 38 import qualified Data.ByteString.Builder as BSB 39 import qualified Data.List.NonEmpty as NE 40 import Data.Word (Word8, Word64) 41 import GHC.Generics (Generic) 42 43 -- | Sighash type flags. 44 data SighashType 45 = SIGHASH_ALL 46 | SIGHASH_NONE 47 | SIGHASH_SINGLE 48 | SIGHASH_ALL_ANYONECANPAY 49 | SIGHASH_NONE_ANYONECANPAY 50 | SIGHASH_SINGLE_ANYONECANPAY 51 deriving (Eq, Show, Generic) 52 53 -- | Encode sighash type to byte value. 54 sighash_byte :: SighashType -> Word8 55 sighash_byte !st = case st of 56 SIGHASH_ALL -> 0x01 57 SIGHASH_NONE -> 0x02 58 SIGHASH_SINGLE -> 0x03 59 SIGHASH_ALL_ANYONECANPAY -> 0x81 60 SIGHASH_NONE_ANYONECANPAY -> 0x82 61 SIGHASH_SINGLE_ANYONECANPAY -> 0x83 62 {-# INLINE sighash_byte #-} 63 64 -- | Check if ANYONECANPAY flag is set. 65 is_anyonecanpay :: SighashType -> Bool 66 is_anyonecanpay !st = case st of 67 SIGHASH_ALL_ANYONECANPAY -> True 68 SIGHASH_NONE_ANYONECANPAY -> True 69 SIGHASH_SINGLE_ANYONECANPAY -> True 70 _ -> False 71 {-# INLINE is_anyonecanpay #-} 72 73 -- | Get base sighash type (without ANYONECANPAY). 74 base_type :: SighashType -> SighashType 75 base_type !st = case st of 76 SIGHASH_ALL_ANYONECANPAY -> SIGHASH_ALL 77 SIGHASH_NONE_ANYONECANPAY -> SIGHASH_NONE 78 SIGHASH_SINGLE_ANYONECANPAY -> SIGHASH_SINGLE 79 other -> other 80 {-# INLINE base_type #-} 81 82 -- | 32 zero bytes. 83 zero32 :: BS.ByteString 84 zero32 = BS.replicate 32 0x00 85 {-# NOINLINE zero32 #-} 86 87 -- | Hash of 0x01 followed by 31 zero bytes (SIGHASH_SINGLE edge case). 88 sighash_single_bug :: BS.ByteString 89 sighash_single_bug = BS.cons 0x01 (BS.replicate 31 0x00) 90 {-# NOINLINE sighash_single_bug #-} 91 92 -- | Double SHA256. 93 hash256 :: BS.ByteString -> BS.ByteString 94 hash256 = SHA256.hash . SHA256.hash 95 {-# INLINE hash256 #-} 96 97 -- legacy sighash ------------------------------------------------------------- 98 99 -- | Compute legacy sighash for P2PKH/P2SH inputs. 100 -- 101 -- Modifies a copy of the transaction based on sighash flags, appends 102 -- the sighash type as 4-byte little-endian, and double SHA256s. 103 -- 104 -- @ 105 -- -- sign input 0 with SIGHASH_ALL 106 -- let hash = sighash_legacy tx 0 scriptPubKey SIGHASH_ALL 107 -- -- use hash with ECDSA signing 108 -- @ 109 -- 110 -- For SIGHASH_SINGLE with input index >= output count, returns the 111 -- special \"sighash single bug\" value (0x01 followed by 31 zero bytes). 112 sighash_legacy 113 :: Tx 114 -> Int -- ^ input index 115 -> BS.ByteString -- ^ scriptPubKey being spent 116 -> SighashType 117 -> BS.ByteString -- ^ 32-byte hash 118 sighash_legacy !tx !idx !script_pubkey !sighash_type 119 -- SIGHASH_SINGLE edge case: index >= number of outputs 120 | base == SIGHASH_SINGLE && idx >= NE.length (tx_outputs tx) = 121 sighash_single_bug 122 | otherwise = 123 let !serialized = serialize_legacy_sighash tx idx script_pubkey sighash_type 124 in hash256 serialized 125 where 126 !base = base_type sighash_type 127 128 -- | Serialize transaction for legacy sighash computation. 129 -- Handles all sighash flags directly without constructing intermediate Tx. 130 serialize_legacy_sighash 131 :: Tx 132 -> Int 133 -> BS.ByteString 134 -> SighashType 135 -> BS.ByteString 136 serialize_legacy_sighash Tx{..} !idx !script_pubkey !sighash_type = 137 let !base = base_type sighash_type 138 !anyonecanpay = is_anyonecanpay sighash_type 139 !inputs_list = NE.toList tx_inputs 140 !outputs_list = NE.toList tx_outputs 141 142 -- Clear all scriptSigs, set signing input's script to scriptPubKey 143 clear_scripts :: Int -> [TxIn] -> [TxIn] 144 clear_scripts !_ [] = [] 145 clear_scripts !i (inp : rest) 146 | i == idx = inp { txin_script_sig = script_pubkey } : clear_rest 147 | otherwise = inp { txin_script_sig = BS.empty } : clear_rest 148 where 149 !clear_rest = clear_scripts (i + 1) rest 150 151 -- For NONE/SINGLE: zero out sequence numbers for other inputs 152 zero_other_sequences :: Int -> [TxIn] -> [TxIn] 153 zero_other_sequences !_ [] = [] 154 zero_other_sequences !i (inp : rest) 155 | i == idx = inp : zero_other_sequences (i + 1) rest 156 | otherwise = 157 inp { txin_sequence = 0 } : zero_other_sequences (i + 1) rest 158 159 -- Process inputs based on sighash type 160 !inputs_cleared = clear_scripts 0 inputs_list 161 162 !inputs_processed = case base of 163 SIGHASH_NONE -> zero_other_sequences 0 inputs_cleared 164 SIGHASH_SINGLE -> zero_other_sequences 0 inputs_cleared 165 _ -> inputs_cleared 166 167 -- ANYONECANPAY: keep only signing input 168 !final_inputs 169 | anyonecanpay = case safe_index inputs_processed idx of 170 Just inp -> [inp] 171 Nothing -> [] -- shouldn't happen if idx is valid 172 | otherwise = inputs_processed 173 174 -- Process outputs based on sighash type 175 !final_outputs = case base of 176 SIGHASH_NONE -> [] 177 SIGHASH_SINGLE -> build_single_outputs outputs_list idx 178 _ -> outputs_list 179 180 in to_strict $ 181 put_word32_le tx_version 182 <> put_compact (fromIntegral (length final_inputs)) 183 <> foldMap put_txin_legacy final_inputs 184 <> put_compact (fromIntegral (length final_outputs)) 185 <> foldMap put_txout final_outputs 186 <> put_word32_le tx_locktime 187 <> put_word32_le (fromIntegral (sighash_byte sighash_type)) 188 189 -- | Build outputs for SIGHASH_SINGLE: keep only output at idx, 190 -- replace earlier outputs with empty/zero outputs. 191 build_single_outputs :: [TxOut] -> Int -> [TxOut] 192 build_single_outputs !outs !target_idx = go 0 outs 193 where 194 go :: Int -> [TxOut] -> [TxOut] 195 go !_ [] = [] 196 go !i (o : rest) 197 | i == target_idx = [o] -- keep this one and stop 198 | i < target_idx = empty_output : go (i + 1) rest 199 | otherwise = [] -- shouldn't reach here 200 201 -- Empty output: -1 (0xffffffffffffffff) value, empty script 202 empty_output :: TxOut 203 empty_output = TxOut 0xffffffffffffffff BS.empty 204 205 -- | Safe list indexing. 206 safe_index :: [a] -> Int -> Maybe a 207 safe_index [] _ = Nothing 208 safe_index (x : xs) !n 209 | n < 0 = Nothing 210 | n == 0 = Just x 211 | otherwise = safe_index xs (n - 1) 212 {-# INLINE safe_index #-} 213 214 -- | Encode TxIn for legacy sighash (same as normal encoding). 215 put_txin_legacy :: TxIn -> BSB.Builder 216 put_txin_legacy TxIn{..} = 217 put_outpoint txin_prevout 218 <> put_compact (fromIntegral (BS.length txin_script_sig)) 219 <> BSB.byteString txin_script_sig 220 <> put_word32_le txin_sequence 221 {-# INLINE put_txin_legacy #-} 222 223 -- BIP143 segwit sighash ------------------------------------------------------- 224 225 -- | Compute BIP143 segwit sighash. 226 -- 227 -- Required for signing segwit inputs (P2WPKH, P2WSH). Unlike legacy 228 -- sighash, this commits to the value being spent, preventing fee 229 -- manipulation attacks. 230 -- 231 -- Returns 'Nothing' if the input index is out of range. 232 -- 233 -- @ 234 -- -- sign P2WPKH input 0 235 -- let scriptCode = ... -- P2WPKH scriptCode 236 -- let hash = sighash_segwit tx 0 scriptCode inputValue SIGHASH_ALL 237 -- -- use hash with ECDSA signing (after checking Just) 238 -- @ 239 sighash_segwit 240 :: Tx 241 -> Int -- ^ input index 242 -> BS.ByteString -- ^ scriptCode 243 -> Word64 -- ^ value being spent (satoshis) 244 -> SighashType 245 -> Maybe BS.ByteString -- ^ 32-byte hash, or Nothing if index invalid 246 sighash_segwit !tx !idx !script_code !value !sighash_type = do 247 preimage <- build_bip143_preimage tx idx script_code value sighash_type 248 pure $! hash256 preimage 249 250 -- | Build BIP143 preimage for signing. 251 -- Returns Nothing if the input index is out of range. 252 build_bip143_preimage 253 :: Tx 254 -> Int 255 -> BS.ByteString 256 -> Word64 257 -> SighashType 258 -> Maybe BS.ByteString 259 build_bip143_preimage Tx{..} !idx !script_code !value !sighash_type = do 260 -- Get the input being signed; fail if index out of range 261 let !inputs_list = NE.toList tx_inputs 262 !outputs_list = NE.toList tx_outputs 263 signing_input <- safe_index inputs_list idx 264 265 let !base = base_type sighash_type 266 !anyonecanpay = is_anyonecanpay sighash_type 267 268 -- hashPrevouts: double SHA256 of all outpoints, or zero if ANYONECANPAY 269 !hash_prevouts 270 | anyonecanpay = zero32 271 | otherwise = hash256 $ to_strict $ 272 foldMap (put_outpoint . txin_prevout) tx_inputs 273 274 -- hashSequence: double SHA256 of all sequences, or zero if 275 -- ANYONECANPAY or NONE or SINGLE 276 !hash_sequence 277 | anyonecanpay = zero32 278 | base == SIGHASH_SINGLE = zero32 279 | base == SIGHASH_NONE = zero32 280 | otherwise = hash256 $ to_strict $ 281 foldMap (put_word32_le . txin_sequence) tx_inputs 282 283 -- hashOutputs: depends on sighash type 284 !hash_outputs = case base of 285 SIGHASH_NONE -> zero32 286 SIGHASH_SINGLE -> 287 case safe_index outputs_list idx of 288 Nothing -> zero32 -- index out of range 289 Just out -> hash256 $ to_strict $ put_txout out 290 _ -> hash256 $ to_strict $ foldMap put_txout tx_outputs 291 292 !outpoint = txin_prevout signing_input 293 !sequence_n = txin_sequence signing_input 294 295 pure $! to_strict $ 296 put_word32_le tx_version 297 <> BSB.byteString hash_prevouts 298 <> BSB.byteString hash_sequence 299 <> put_outpoint outpoint 300 <> put_compact (fromIntegral (BS.length script_code)) 301 <> BSB.byteString script_code 302 <> put_word64_le value 303 <> put_word32_le sequence_n 304 <> BSB.byteString hash_outputs 305 <> put_word32_le tx_locktime 306 <> put_word32_le (fromIntegral (sighash_byte sighash_type))