Tx.hs (13441B)
1 {-# OPTIONS_HADDOCK prune #-} 2 {-# LANGUAGE BangPatterns #-} 3 {-# LANGUAGE OverloadedStrings #-} 4 {-# LANGUAGE RecordWildCards #-} 5 6 -- | 7 -- Module: Bitcoin.Prim.Tx 8 -- Copyright: (c) 2025 Jared Tobin 9 -- License: MIT 10 -- Maintainer: Jared Tobin <jared@ppad.tech> 11 -- 12 -- Minimal Bitcoin transaction primitives, including raw transaction 13 -- types, serialisation to/from bytes, and txid computation. 14 15 module Bitcoin.Prim.Tx ( 16 -- * Transaction Types 17 Tx(..) 18 , TxIn(..) 19 , TxOut(..) 20 , OutPoint(..) 21 , Witness(..) 22 , TxId 23 , mk_txid 24 , un_txid 25 , null_txid 26 27 -- * Serialisation 28 , to_bytes 29 , from_bytes 30 , to_bytes_legacy 31 , to_base16 32 , from_base16 33 34 -- * TxId 35 , txid 36 ) where 37 38 import Bitcoin.Prim.Tx.Internal 39 import qualified Crypto.Hash.SHA256 as SHA256 40 import Data.Bits ((.|.), shiftL) 41 import qualified Data.ByteString as BS 42 import qualified Data.ByteString.Base16 as B16 43 import qualified Data.ByteString.Builder as BSB 44 import Data.List.NonEmpty (NonEmpty(..)) 45 import qualified Data.List.NonEmpty as NE 46 import Data.Word (Word32, Word64) 47 48 -- | Construct a 'TxId' from 32 bytes in internal byte order (the 49 -- reverse of the usual hex display). 50 -- 51 -- Returns 'Nothing' if the input is not exactly 32 bytes. 52 -- 53 -- >>> fmap (BS.length . un_txid) (mk_txid (BS.replicate 32 0x00)) 54 -- Just 32 55 -- >>> mk_txid (BS.replicate 31 0x00) 56 -- Nothing 57 mk_txid :: BS.ByteString -> Maybe TxId 58 mk_txid bs 59 | BS.length bs == 32 = Just (TxId bs) 60 | otherwise = Nothing 61 62 -- | The 32 bytes of a 'TxId', in internal byte order. 63 un_txid :: TxId -> BS.ByteString 64 un_txid (TxId bs) = bs 65 {-# INLINE un_txid #-} 66 67 -- | The all-zero 'TxId', referenced by coinbase inputs' outpoints. 68 null_txid :: TxId 69 null_txid = TxId (BS.replicate 32 0x00) 70 71 -- serialisation -------------------------------------------------------------- 72 73 -- | Serialise a transaction to bytes. 74 -- 75 -- Uses the segwit format if any input has a non-empty witness, and 76 -- the legacy format otherwise (as Bitcoin Core does). 77 -- 78 -- @ 79 -- -- round-trip 80 -- from_bytes (to_bytes tx) == Just tx 81 -- @ 82 to_bytes :: Tx -> BS.ByteString 83 to_bytes tx@Tx {..} 84 | not (any (has_witness . txin_witness) tx_inputs) = to_bytes_legacy tx 85 | otherwise = to_strict $ 86 put_word32_le tx_version 87 <> BSB.word8 0x00 -- marker 88 <> BSB.word8 0x01 -- flag 89 <> put_compact (fromIntegral (NE.length tx_inputs)) 90 <> foldMap put_txin tx_inputs 91 <> put_compact (fromIntegral (NE.length tx_outputs)) 92 <> foldMap put_txout tx_outputs 93 <> foldMap (put_witness . txin_witness) tx_inputs 94 <> put_word32_le tx_locktime 95 96 -- whether a witness stack is non-empty 97 has_witness :: Witness -> Bool 98 has_witness (Witness items) = not (null items) 99 {-# INLINE has_witness #-} 100 101 -- | Serialise a transaction to legacy format (no witness data). 102 -- 103 -- Used for txid computation. Excludes witness data even if present. 104 -- 105 -- @ 106 -- -- for a legacy tx (no witnesses), the same as to_bytes 107 -- to_bytes_legacy legacy_tx == to_bytes legacy_tx 108 -- 109 -- -- for a segwit tx, strips the witnesses 110 -- BS.length (to_bytes_legacy segwit_tx) < BS.length (to_bytes segwit_tx) 111 -- @ 112 to_bytes_legacy :: Tx -> BS.ByteString 113 to_bytes_legacy Tx {..} = to_strict $ 114 put_word32_le tx_version 115 <> put_compact (fromIntegral (NE.length tx_inputs)) 116 <> foldMap put_txin tx_inputs 117 <> put_compact (fromIntegral (NE.length tx_outputs)) 118 <> foldMap put_txout tx_outputs 119 <> put_word32_le tx_locktime 120 121 -- | Serialise a transaction to base16 (hex). 122 -- 123 -- @ 124 -- to_base16 tx = B16.encode (to_bytes tx) 125 -- @ 126 to_base16 :: Tx -> BS.ByteString 127 to_base16 tx = B16.encode (to_bytes tx) 128 129 -- | Parse a transaction from base16 (hex). 130 -- 131 -- @ 132 -- -- round-trip 133 -- from_base16 (to_base16 tx) == Just tx 134 -- @ 135 from_base16 :: BS.ByteString -> Maybe Tx 136 from_base16 b16 = do 137 bs <- B16.decode b16 138 from_bytes bs 139 140 -- decoding ------------------------------------------------------------------- 141 142 -- | Parse a transaction from bytes. 143 -- 144 -- Automatically detects segwit vs legacy format by checking for 145 -- marker byte 0x00 followed by flag 0x01 after the version field. 146 -- 147 -- Returns 'Nothing' on invalid or truncated input. 148 -- 149 -- @ 150 -- -- round-trip 151 -- from_bytes (to_bytes tx) == Just tx 152 -- @ 153 from_bytes :: BS.ByteString -> Maybe Tx 154 from_bytes !bs = do 155 -- need at least 4 bytes for version 156 guard (BS.length bs >= 4) 157 let !version = get_word32_le bs 0 158 !off0 = 4 159 -- check for segwit marker (0x00) and flag (0x01) 160 if BS.length bs > off0 + 1 161 && BS.index bs off0 == 0x00 162 && BS.index bs (off0 + 1) == 0x01 163 then parse_segwit bs version (off0 + 2) 164 else parse_legacy bs version off0 165 166 -- Parse legacy transaction (no witness data) 167 parse_legacy :: BS.ByteString -> Word32 -> Int -> Maybe Tx 168 parse_legacy !bs !version !off0 = do 169 -- input count 170 (input_count, off1) <- get_compact bs off0 171 -- inputs (must have at least one) 172 (inputs_list, off2) <- get_many get_txin bs off1 input_count 173 inputs <- NE.nonEmpty inputs_list 174 -- output count 175 (output_count, off3) <- get_compact bs off2 176 -- outputs (must have at least one) 177 (outputs_list, off4) <- get_many get_txout bs off3 output_count 178 outputs <- NE.nonEmpty outputs_list 179 -- locktime (4 bytes) 180 guard (BS.length bs >= off4 + 4) 181 let !locktime = get_word32_le bs off4 182 !off5 = off4 + 4 183 -- should have consumed all bytes 184 guard (off5 == BS.length bs) 185 pure $! Tx version inputs outputs locktime 186 187 -- Parse segwit transaction (with witness data) 188 parse_segwit :: BS.ByteString -> Word32 -> Int -> Maybe Tx 189 parse_segwit !bs !version !off0 = do 190 -- input count 191 (input_count, off1) <- get_compact bs off0 192 -- inputs (must have at least one) 193 (inputs_list, off2) <- get_many get_txin bs off1 input_count 194 inputs <- NE.nonEmpty inputs_list 195 -- output count 196 (output_count, off3) <- get_compact bs off2 197 -- outputs (must have at least one) 198 (outputs_list, off4) <- get_many get_txout bs off3 output_count 199 outputs <- NE.nonEmpty outputs_list 200 -- witnesses (one per input) 201 (witnesses, off5) <- get_many get_witness bs off4 input_count 202 -- a marker and flag with no witness data is invalid (Bitcoin Core: 203 -- "superfluous witness record") 204 guard (any has_witness witnesses) 205 -- locktime (4 bytes) 206 guard (BS.length bs >= off5 + 4) 207 let !locktime = get_word32_le bs off5 208 !off6 = off5 + 4 209 -- should have consumed all bytes 210 guard (off6 == BS.length bs) 211 pure $! Tx version (attach_witnesses inputs witnesses) outputs locktime 212 213 -- Pair each input with its witness (get_many returns exactly one per 214 -- input). 215 attach_witnesses :: NonEmpty TxIn -> [Witness] -> NonEmpty TxIn 216 attach_witnesses (i :| is) ws = case ws of 217 (w : rest) -> set i w :| zipWith set is rest 218 [] -> i :| is 219 where 220 set x w = x { txin_witness = w } 221 222 -- internal helpers ----------------------------------------------------------- 223 224 -- | Guard for Maybe monad. 225 guard :: Bool -> Maybe () 226 guard True = Just () 227 guard False = Nothing 228 {-# INLINE guard #-} 229 230 -- | Decode a 32-bit little-endian word at the given offset. 231 -- Does not bounds-check; caller must ensure sufficient bytes. 232 get_word32_le :: BS.ByteString -> Int -> Word32 233 get_word32_le !bs !off = 234 let !b0 = fromIntegral (BS.index bs off) :: Word32 235 !b1 = fromIntegral (BS.index bs (off + 1)) :: Word32 236 !b2 = fromIntegral (BS.index bs (off + 2)) :: Word32 237 !b3 = fromIntegral (BS.index bs (off + 3)) :: Word32 238 in b0 .|. (b1 `shiftL` 8) .|. (b2 `shiftL` 16) .|. (b3 `shiftL` 24) 239 {-# INLINE get_word32_le #-} 240 241 -- | Decode a 64-bit little-endian word at the given offset. 242 -- Does not bounds-check; caller must ensure sufficient bytes. 243 get_word64_le :: BS.ByteString -> Int -> Word64 244 get_word64_le !bs !off = 245 let !b0 = fromIntegral (BS.index bs off) :: Word64 246 !b1 = fromIntegral (BS.index bs (off + 1)) :: Word64 247 !b2 = fromIntegral (BS.index bs (off + 2)) :: Word64 248 !b3 = fromIntegral (BS.index bs (off + 3)) :: Word64 249 !b4 = fromIntegral (BS.index bs (off + 4)) :: Word64 250 !b5 = fromIntegral (BS.index bs (off + 5)) :: Word64 251 !b6 = fromIntegral (BS.index bs (off + 6)) :: Word64 252 !b7 = fromIntegral (BS.index bs (off + 7)) :: Word64 253 in b0 .|. (b1 `shiftL` 8) .|. (b2 `shiftL` 16) .|. (b3 `shiftL` 24) 254 .|. (b4 `shiftL` 32) .|. (b5 `shiftL` 40) 255 .|. (b6 `shiftL` 48) .|. (b7 `shiftL` 56) 256 {-# INLINE get_word64_le #-} 257 258 -- | Decode a 16-bit little-endian word at the given offset. 259 -- Does not bounds-check; caller must ensure sufficient bytes. 260 get_word16_le :: BS.ByteString -> Int -> Word64 261 get_word16_le !bs !off = 262 let !b0 = fromIntegral (BS.index bs off) :: Word64 263 !b1 = fromIntegral (BS.index bs (off + 1)) :: Word64 264 in b0 .|. (b1 `shiftL` 8) 265 {-# INLINE get_word16_le #-} 266 267 -- | Decode compactSize (Bitcoin's variable-length integer). 268 -- Returns (value, new_offset). 269 -- Enforces minimal encoding: rejects non-minimal representations. 270 get_compact :: BS.ByteString -> Int -> Maybe (Word64, Int) 271 get_compact !bs !off 272 | off >= BS.length bs = Nothing 273 | otherwise = case BS.index bs off of 274 tag | tag <= 0xfc -> 275 -- Single byte: value is the tag itself 276 Just (fromIntegral tag, off + 1) 277 278 0xfd -> 279 -- 2-byte value follows 280 if BS.length bs < off + 3 281 then Nothing 282 else 283 let !val = get_word16_le bs (off + 1) 284 in if val < 0xfd 285 then Nothing -- non-minimal encoding 286 else Just (val, off + 3) 287 288 0xfe -> 289 -- 4-byte value follows 290 if BS.length bs < off + 5 291 then Nothing 292 else 293 let !val = fromIntegral (get_word32_le bs (off + 1)) :: Word64 294 in if val <= 0xffff 295 then Nothing -- non-minimal encoding 296 else Just (val, off + 5) 297 298 _ -> -- 0xff 299 -- 8-byte value follows 300 if BS.length bs < off + 9 301 then Nothing 302 else 303 let !val = get_word64_le bs (off + 1) 304 in if val <= 0xffffffff 305 then Nothing -- non-minimal encoding 306 else Just (val, off + 9) 307 {-# INLINE get_compact #-} 308 309 -- | Decode an outpoint (txid + vout). 310 -- Returns (OutPoint, new_offset). 311 get_outpoint :: BS.ByteString -> Int -> Maybe (OutPoint, Int) 312 get_outpoint !bs !off 313 | BS.length bs < off + 36 = Nothing 314 | otherwise = 315 let !txid_bytes = BS.take 32 (BS.drop off bs) 316 !vout = get_word32_le bs (off + 32) 317 in Just (OutPoint (TxId txid_bytes) vout, off + 36) 318 {-# INLINE get_outpoint #-} 319 320 -- | Decode a transaction input. 321 -- Returns (TxIn, new_offset). 322 get_txin :: BS.ByteString -> Int -> Maybe (TxIn, Int) 323 get_txin !bs !off0 = do 324 -- outpoint: 36 bytes 325 (outpoint, off1) <- get_outpoint bs off0 326 -- scriptSig 327 (script_sig, off3) <- get_bytes bs off1 328 -- sequence: 4 bytes 329 guard (BS.length bs >= off3 + 4) 330 let !seqn = get_word32_le bs off3 331 !off4 = off3 + 4 332 pure (TxIn outpoint script_sig seqn (Witness []), off4) 333 334 -- | Decode a transaction output. 335 -- Returns (TxOut, new_offset). 336 get_txout :: BS.ByteString -> Int -> Maybe (TxOut, Int) 337 get_txout !bs !off0 = do 338 -- value: 8 bytes 339 guard (BS.length bs >= off0 + 8) 340 let !value = get_word64_le bs off0 341 !off1 = off0 + 8 342 -- scriptPubKey 343 (script_pk, off2) <- get_bytes bs off1 344 pure (TxOut value script_pk, off2) 345 346 -- | Decode a witness stack for one input. 347 -- Returns (Witness, new_offset). 348 get_witness :: BS.ByteString -> Int -> Maybe (Witness, Int) 349 get_witness !bs !off0 = do 350 -- stack item count 351 (item_count, off1) <- get_compact bs off0 352 -- each item: length + bytes 353 (items, off2) <- get_many get_bytes bs off1 item_count 354 pure (Witness items, off2) 355 356 -- | Decode compactSize-length-prefixed bytes. 357 -- Returns (bytes, new_offset). 358 get_bytes :: BS.ByteString -> Int -> Maybe (BS.ByteString, Int) 359 get_bytes !bs !off0 = do 360 (len, off1) <- get_compact bs off0 361 -- compare in Word64, so that huge lengths can't wrap negative 362 guard (len <= fromIntegral (BS.length bs - off1)) 363 let !n = fromIntegral len 364 pure (BS.take n (BS.drop off1 bs), off1 + n) 365 366 -- | Decode a counted sequence of items using a decoder function. 367 -- Returns (list of items, new_offset). 368 get_many :: (BS.ByteString -> Int -> Maybe (a, Int)) 369 -> BS.ByteString -> Int -> Word64 -> Maybe ([a], Int) 370 get_many getter !bs !off0 !count 371 -- every item occupies at least one byte, so a larger count is 372 -- malformed (and might not fit in an Int) 373 | count > fromIntegral (BS.length bs - off0) = Nothing 374 | otherwise = go [] off0 (fromIntegral count :: Int) 375 where 376 go !acc !off !n 377 | n <= 0 = Just (reverse acc, off) 378 | otherwise = do 379 (item, off') <- getter bs off 380 go (item : acc) off' (n - 1) 381 {-# INLINE get_many #-} 382 383 -- txid ----------------------------------------------------------------------- 384 385 -- | Compute the transaction ID (double SHA256 of legacy serialisation). 386 -- 387 -- The txid is computed from the legacy serialisation, so segwit 388 -- transactions have the same txid regardless of witness data. It is 389 -- in internal byte order; reverse it for the usual hex display. 390 -- 391 -- @ 392 -- -- Satoshi->Hal tx (block 170) 393 -- B16.encode (BS.reverse (un_txid (txid satoshi_hal_tx))) 394 -- == "f4184fc596403b9d638783cf57adfe4c75c605f6356fbc91338530e9831e9e16" 395 -- @ 396 txid :: Tx -> TxId 397 txid tx = TxId (SHA256.hash (SHA256.hash (to_bytes_legacy tx)))