commit 19203c8efb4a8def5d781fb95ec5788b8023aa00
parent 65a561493940b59c5415b4b1409b4e32dae5c08f
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 10 Oct 2026 18:41:00 +0400
lib: harden from_bytes; serialise empty witnesses as legacy
- A compactSize length of 2^63 or more wrapped to a negative Int,
passed the bounds check and crashed from_bytes with a negative
index. Compare lengths in Word64 (get_bytes), and reject any count
exceeding the remaining input (get_many), which also stops a huge
witness item count parsing as zero items.
- Reject a segwit marker and flag with no witness data, and serialise
a transaction whose witnesses are all empty in the legacy format, as
Bitcoin Core does.
- Derive Ord for TxId and OutPoint (downstream keys maps on them), and
add an NFData instance for SighashType.
- Correct the mkTxId and txid Haddock examples.
Diffstat:
2 files changed, 61 insertions(+), 49 deletions(-)
diff --git a/lib/Bitcoin/Prim/Tx.hs b/lib/Bitcoin/Prim/Tx.hs
@@ -56,18 +56,19 @@ import GHC.Generics (Generic)
-- | Transaction ID (32 bytes, little-endian double-SHA256).
newtype TxId = TxId BS.ByteString
- deriving (Eq, Show, Generic)
+ deriving (Eq, Ord, Show, Generic)
instance NFData TxId
--- | Construct a TxId from a 32-byte ByteString.
+-- | Construct a TxId from a 32-byte ByteString (in internal byte
+-- order, i.e. the reverse of the usual hex display).
--
-- Returns 'Nothing' if the input is not exactly 32 bytes.
--
--- @
--- mkTxId (BS.replicate 32 0x00) == Just (TxId ...)
--- mkTxId (BS.replicate 31 0x00) == Nothing
--- @
+-- >>> fmap (\(TxId b) -> BS.length b) (mkTxId (BS.replicate 32 0x00))
+-- Just 32
+-- >>> mkTxId (BS.replicate 31 0x00)
+-- Nothing
mkTxId :: BS.ByteString -> Maybe TxId
mkTxId bs
| BS.length bs == 32 = Just (TxId bs)
@@ -77,7 +78,7 @@ mkTxId bs
data OutPoint = OutPoint
{ op_txid :: {-# UNPACK #-} !TxId
, op_vout :: {-# UNPACK #-} !Word32
- } deriving (Eq, Show, Generic)
+ } deriving (Eq, Ord, Show, Generic)
instance NFData OutPoint
@@ -118,11 +119,12 @@ data Tx = Tx
instance NFData Tx
--- serialisation ---------------------------------------------------------------
+-- serialisation --------------------------------------------------------------
-- | Serialise a transaction to bytes.
--
--- Uses segwit format if witnesses are present, legacy otherwise.
+-- Uses the segwit format if any input has a non-empty witness, and
+-- the legacy format otherwise (as Bitcoin Core does).
--
-- @
-- -- round-trip
@@ -130,7 +132,7 @@ instance NFData Tx
-- @
to_bytes :: Tx -> BS.ByteString
to_bytes tx@Tx {..}
- | null tx_witnesses = to_bytes_legacy tx
+ | not (has_witness tx_witnesses) = to_bytes_legacy tx
| otherwise = to_strict $
put_word32_le tx_version
<> BSB.word8 0x00 -- marker
@@ -142,6 +144,11 @@ to_bytes tx@Tx {..}
<> foldMap put_witness tx_witnesses
<> put_word32_le tx_locktime
+-- whether any witness stack is non-empty
+has_witness :: [Witness] -> Bool
+has_witness = any (\(Witness items) -> not (null items))
+{-# INLINE has_witness #-}
+
-- | Serialise a transaction to legacy format (no witness data).
--
-- Used for txid computation. Excludes witness data even if present.
@@ -181,7 +188,7 @@ from_base16 b16 = do
bs <- B16.decode b16
from_bytes bs
--- internal: builders ----------------------------------------------------------
+-- internal: builders ---------------------------------------------------------
-- | Convert a Builder to a strict ByteString.
to_strict :: BSB.Builder -> BS.ByteString
@@ -249,7 +256,7 @@ put_witness (Witness items) =
<> BSB.byteString item
{-# INLINE put_witness #-}
--- decoding --------------------------------------------------------------------
+-- decoding -------------------------------------------------------------------
-- | Parse a transaction from bytes.
--
@@ -281,12 +288,12 @@ parse_legacy !bs !version !off0 = do
-- input count
(input_count, off1) <- get_compact bs off0
-- inputs (must have at least one)
- (inputs_list, off2) <- get_many get_txin bs off1 (fromIntegral input_count)
+ (inputs_list, off2) <- get_many get_txin bs off1 input_count
inputs <- NE.nonEmpty inputs_list
-- output count
(output_count, off3) <- get_compact bs off2
-- outputs (must have at least one)
- (outputs_list, off4) <- get_many get_txout bs off3 (fromIntegral output_count)
+ (outputs_list, off4) <- get_many get_txout bs off3 output_count
outputs <- NE.nonEmpty outputs_list
-- locktime (4 bytes)
guard (BS.length bs >= off4 + 4)
@@ -302,15 +309,18 @@ parse_segwit !bs !version !off0 = do
-- input count
(input_count, off1) <- get_compact bs off0
-- inputs (must have at least one)
- (inputs_list, off2) <- get_many get_txin bs off1 (fromIntegral input_count)
+ (inputs_list, off2) <- get_many get_txin bs off1 input_count
inputs <- NE.nonEmpty inputs_list
-- output count
(output_count, off3) <- get_compact bs off2
-- outputs (must have at least one)
- (outputs_list, off4) <- get_many get_txout bs off3 (fromIntegral output_count)
+ (outputs_list, off4) <- get_many get_txout bs off3 output_count
outputs <- NE.nonEmpty outputs_list
-- witnesses (one per input)
- (witnesses, off5) <- get_many get_witness bs off4 (fromIntegral input_count)
+ (witnesses, off5) <- get_many get_witness bs off4 input_count
+ -- a marker and flag with no witness data is invalid (Bitcoin Core:
+ -- "superfluous witness record")
+ guard (has_witness witnesses)
-- locktime (4 bytes)
guard (BS.length bs >= off5 + 4)
let !locktime = get_word32_le bs off5
@@ -319,7 +329,7 @@ parse_segwit !bs !version !off0 = do
guard (off6 == BS.length bs)
pure $! Tx version inputs outputs witnesses locktime
--- internal helpers ------------------------------------------------------------
+-- internal helpers -----------------------------------------------------------
-- | Guard for Maybe monad.
guard :: Bool -> Maybe ()
@@ -423,12 +433,8 @@ get_txin :: BS.ByteString -> Int -> Maybe (TxIn, Int)
get_txin !bs !off0 = do
-- outpoint: 36 bytes
(outpoint, off1) <- get_outpoint bs off0
- -- scriptSig length + bytes
- (script_len, off2) <- get_compact bs off1
- let !slen = fromIntegral script_len
- guard (BS.length bs >= off2 + slen)
- let !script_sig = BS.take slen (BS.drop off2 bs)
- !off3 = off2 + slen
+ -- scriptSig
+ (script_sig, off3) <- get_bytes bs off1
-- sequence: 4 bytes
guard (BS.length bs >= off3 + 4)
let !seqn = get_word32_le bs off3
@@ -443,13 +449,9 @@ get_txout !bs !off0 = do
guard (BS.length bs >= off0 + 8)
let !value = get_word64_le bs off0
!off1 = off0 + 8
- -- scriptPubKey length + bytes
- (script_len, off2) <- get_compact bs off1
- let !slen = fromIntegral script_len
- guard (BS.length bs >= off2 + slen)
- let !script_pk = BS.take slen (BS.drop off2 bs)
- !off3 = off2 + slen
- pure (TxOut value script_pk, off3)
+ -- scriptPubKey
+ (script_pk, off2) <- get_bytes bs off1
+ pure (TxOut value script_pk, off2)
-- | Decode a witness stack for one input.
-- Returns (Witness, new_offset).
@@ -458,23 +460,28 @@ get_witness !bs !off0 = do
-- stack item count
(item_count, off1) <- get_compact bs off0
-- each item: length + bytes
- (items, off2) <- get_many get_witness_item bs off1 (fromIntegral item_count)
+ (items, off2) <- get_many get_bytes bs off1 item_count
pure (Witness items, off2)
--- | Decode a single witness stack item (length-prefixed bytes).
-get_witness_item :: BS.ByteString -> Int -> Maybe (BS.ByteString, Int)
-get_witness_item !bs !off0 = do
- (item_len, off1) <- get_compact bs off0
- let !ilen = fromIntegral item_len
- guard (BS.length bs >= off1 + ilen)
- let !item = BS.take ilen (BS.drop off1 bs)
- pure (item, off1 + ilen)
-
--- | Decode multiple items using a decoder function.
+-- | Decode compactSize-length-prefixed bytes.
+-- Returns (bytes, new_offset).
+get_bytes :: BS.ByteString -> Int -> Maybe (BS.ByteString, Int)
+get_bytes !bs !off0 = do
+ (len, off1) <- get_compact bs off0
+ -- compare in Word64, so that huge lengths can't wrap negative
+ guard (len <= fromIntegral (BS.length bs - off1))
+ let !n = fromIntegral len
+ pure (BS.take n (BS.drop off1 bs), off1 + n)
+
+-- | Decode a counted sequence of items using a decoder function.
-- Returns (list of items, new_offset).
get_many :: (BS.ByteString -> Int -> Maybe (a, Int))
- -> BS.ByteString -> Int -> Int -> Maybe ([a], Int)
-get_many getter !bs = go []
+ -> BS.ByteString -> Int -> Word64 -> Maybe ([a], Int)
+get_many getter !bs !off0 !count
+ -- every item occupies at least one byte, so a larger count is
+ -- malformed (and might not fit in an Int)
+ | count > fromIntegral (BS.length bs - off0) = Nothing
+ | otherwise = go [] off0 (fromIntegral count :: Int)
where
go !acc !off !n
| n <= 0 = Just (reverse acc, off)
@@ -483,17 +490,19 @@ get_many getter !bs = go []
go (item : acc) off' (n - 1)
{-# INLINE get_many #-}
--- txid ------------------------------------------------------------------------
+-- txid -----------------------------------------------------------------------
-- | Compute the transaction ID (double SHA256 of legacy serialisation).
--
-- The txid is computed from the legacy serialisation, so segwit
--- transactions have the same txid regardless of witness data.
+-- transactions have the same txid regardless of witness data. It is
+-- in internal byte order; reverse it for the usual hex display.
--
-- @
-- -- Satoshi->Hal tx (block 170)
--- txid satoshiHalTx ==
--- TxId "f4184fc596403b9d638783cf57adfe4c75c605f6356fbc91338530e9831e9e16"
+-- let TxId t = txid satoshi_hal_tx
+-- B16.encode (BS.reverse t)
+-- == "f4184fc596403b9d638783cf57adfe4c75c605f6356fbc91338530e9831e9e16"
-- @
txid :: Tx -> TxId
txid tx = TxId (SHA256.hash (SHA256.hash (to_bytes_legacy tx)))
diff --git a/lib/Bitcoin/Prim/Tx/Sighash.hs b/lib/Bitcoin/Prim/Tx/Sighash.hs
@@ -43,6 +43,7 @@ import Bitcoin.Prim.Tx
, put_txout
, to_strict
)
+import Control.DeepSeq (NFData)
import Control.Monad (guard)
import qualified Crypto.Hash.SHA256 as SHA256
import Data.Bits ((.&.))
@@ -69,6 +70,8 @@ data SighashType
| SIGHASH_SINGLE_ANYONECANPAY
deriving (Eq, Show, Generic)
+instance NFData SighashType
+
-- | Encode a canonical 'SighashType' to its 32-bit hashType value.
--
-- @
@@ -304,7 +307,7 @@ put_txin_legacy TxIn{..} =
<> put_word32_le txin_sequence
{-# INLINE put_txin_legacy #-}
--- BIP143 segwit sighash -------------------------------------------------------
+-- BIP143 segwit sighash ------------------------------------------------------
-- | Compute BIP143 segwit sighash.
--
