commit 7f3e147b2f8144918c1efb16659f73f8c7566691
parent 25defad8bbaddc05c969872947968e2de35be3fe
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 10 Oct 2026 19:02:19 +0400
lib: abstract TxId, per-input witnesses, internal builders
- TxId is abstract: mk_txid (replacing mkTxId) validates the length,
un_txid unwraps it, and null_txid is the all-zero txid coinbase
inputs reference.
- Each TxIn carries its witness (txin_witness) in place of Tx's
tx_witnesses list, which could disagree with the number of inputs
and so serialise to bytes nothing could parse.
- The types and serialisation builders move to an internal module;
Bitcoin.Prim.Tx no longer exports put_compact, put_outpoint,
to_strict, etc. The sighash module drops its duplicate builders.
Diffstat:
4 files changed, 217 insertions(+), 172 deletions(-)
diff --git a/lib/Bitcoin/Prim/Tx.hs b/lib/Bitcoin/Prim/Tx.hs
@@ -1,6 +1,5 @@
{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
@@ -20,8 +19,10 @@ module Bitcoin.Prim.Tx (
, TxOut(..)
, OutPoint(..)
, Witness(..)
- , TxId(..)
- , mkTxId
+ , TxId
+ , mk_txid
+ , un_txid
+ , null_txid
-- * Serialisation
, to_bytes
@@ -32,92 +33,40 @@ module Bitcoin.Prim.Tx (
-- * TxId
, txid
-
- -- * Internal (for Sighash)
- , put_word32_le
- , put_word64_le
- , put_compact
- , put_outpoint
- , put_txout
- , to_strict
) where
-import Control.DeepSeq (NFData(..))
+import Bitcoin.Prim.Tx.Internal
import qualified Crypto.Hash.SHA256 as SHA256
import Data.Bits ((.|.), shiftL)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Builder as BSB
-import qualified Data.ByteString.Lazy as BL
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NE
import Data.Word (Word32, Word64)
-import GHC.Generics (Generic)
-
--- | Transaction ID (32 bytes, little-endian double-SHA256).
-newtype TxId = TxId BS.ByteString
- deriving (Eq, Ord, Show, Generic)
-
-instance NFData TxId
--- | Construct a TxId from a 32-byte ByteString (in internal byte
--- order, i.e. the reverse of the usual hex display).
+-- | Construct a 'TxId' from 32 bytes in internal byte order (the
+-- reverse of the usual hex display).
--
-- Returns 'Nothing' if the input is not exactly 32 bytes.
--
--- >>> fmap (\(TxId b) -> BS.length b) (mkTxId (BS.replicate 32 0x00))
+-- >>> fmap (BS.length . un_txid) (mk_txid (BS.replicate 32 0x00))
-- Just 32
--- >>> mkTxId (BS.replicate 31 0x00)
+-- >>> mk_txid (BS.replicate 31 0x00)
-- Nothing
-mkTxId :: BS.ByteString -> Maybe TxId
-mkTxId bs
+mk_txid :: BS.ByteString -> Maybe TxId
+mk_txid bs
| BS.length bs == 32 = Just (TxId bs)
| otherwise = Nothing
--- | Transaction outpoint (txid + output index).
-data OutPoint = OutPoint
- { op_txid :: {-# UNPACK #-} !TxId
- , op_vout :: {-# UNPACK #-} !Word32
- } deriving (Eq, Ord, Show, Generic)
-
-instance NFData OutPoint
-
--- | Transaction input.
-data TxIn = TxIn
- { txin_prevout :: {-# UNPACK #-} !OutPoint
- , txin_script_sig :: !BS.ByteString
- , txin_sequence :: {-# UNPACK #-} !Word32
- } deriving (Eq, Show, Generic)
+-- | The 32 bytes of a 'TxId', in internal byte order.
+un_txid :: TxId -> BS.ByteString
+un_txid (TxId bs) = bs
+{-# INLINE un_txid #-}
-instance NFData TxIn
-
--- | Transaction output.
-data TxOut = TxOut
- { txout_value :: {-# UNPACK #-} !Word64 -- ^ satoshis
- , txout_script_pubkey :: !BS.ByteString
- } deriving (Eq, Show, Generic)
-
-instance NFData TxOut
-
--- | Witness stack for a single input.
-newtype Witness = Witness [BS.ByteString]
- deriving (Eq, Show, Generic)
-
-instance NFData Witness
-
--- | Complete transaction.
---
--- Bitcoin requires at least one input and one output, enforced here
--- via 'NonEmpty' lists.
-data Tx = Tx
- { tx_version :: {-# UNPACK #-} !Word32
- , tx_inputs :: !(NonEmpty TxIn)
- , tx_outputs :: !(NonEmpty TxOut)
- , tx_witnesses :: ![Witness] -- ^ empty list for legacy tx
- , tx_locktime :: {-# UNPACK #-} !Word32
- } deriving (Eq, Show, Generic)
-
-instance NFData Tx
+-- | The all-zero 'TxId', referenced by coinbase inputs' outpoints.
+null_txid :: TxId
+null_txid = TxId (BS.replicate 32 0x00)
-- serialisation --------------------------------------------------------------
@@ -132,8 +81,8 @@ instance NFData Tx
-- @
to_bytes :: Tx -> BS.ByteString
to_bytes tx@Tx {..}
- | not (has_witness tx_witnesses) = to_bytes_legacy tx
- | otherwise = to_strict $
+ | not (any (has_witness . txin_witness) tx_inputs) = to_bytes_legacy tx
+ | otherwise = to_strict $
put_word32_le tx_version
<> BSB.word8 0x00 -- marker
<> BSB.word8 0x01 -- flag
@@ -141,12 +90,12 @@ to_bytes tx@Tx {..}
<> foldMap put_txin tx_inputs
<> put_compact (fromIntegral (NE.length tx_outputs))
<> foldMap put_txout tx_outputs
- <> foldMap put_witness tx_witnesses
+ <> foldMap (put_witness . txin_witness) tx_inputs
<> put_word32_le tx_locktime
--- whether any witness stack is non-empty
-has_witness :: [Witness] -> Bool
-has_witness = any (\(Witness items) -> not (null items))
+-- whether a witness stack is non-empty
+has_witness :: Witness -> Bool
+has_witness (Witness items) = not (null items)
{-# INLINE has_witness #-}
-- | Serialise a transaction to legacy format (no witness data).
@@ -154,11 +103,11 @@ has_witness = any (\(Witness items) -> not (null items))
-- Used for txid computation. Excludes witness data even if present.
--
-- @
--- -- for legacy tx (no witnesses), same as to_bytes
--- to_bytes_legacy legacyTx == to_bytes legacyTx
+-- -- for a legacy tx (no witnesses), the same as to_bytes
+-- to_bytes_legacy legacy_tx == to_bytes legacy_tx
--
--- -- for segwit tx, strips witnesses
--- BS.length (to_bytes_legacy segwitTx) < BS.length (to_bytes segwitTx)
+-- -- for a segwit tx, strips the witnesses
+-- BS.length (to_bytes_legacy segwit_tx) < BS.length (to_bytes segwit_tx)
-- @
to_bytes_legacy :: Tx -> BS.ByteString
to_bytes_legacy Tx {..} = to_strict $
@@ -188,74 +137,6 @@ from_base16 b16 = do
bs <- B16.decode b16
from_bytes bs
--- internal: builders ---------------------------------------------------------
-
--- | Convert a Builder to a strict ByteString.
-to_strict :: BSB.Builder -> BS.ByteString
-to_strict = BL.toStrict . BSB.toLazyByteString
-{-# INLINE to_strict #-}
-
--- | Encode a Word32 as little-endian bytes.
-put_word32_le :: Word32 -> BSB.Builder
-put_word32_le = BSB.word32LE
-{-# INLINE put_word32_le #-}
-
--- | Encode a Word64 as little-endian bytes.
-put_word64_le :: Word64 -> BSB.Builder
-put_word64_le = BSB.word64LE
-{-# INLINE put_word64_le #-}
-
--- | Encode a Word64 as Bitcoin compactSize (varint).
---
--- Encoding:
--- - 0x00-0xfc: 1 byte (value itself)
--- - 0xfd-0xffff: 0xfd ++ 2 bytes LE
--- - 0x10000-0xffffffff: 0xfe ++ 4 bytes LE
--- - larger: 0xff ++ 8 bytes LE
-put_compact :: Word64 -> BSB.Builder
-put_compact !n
- | n <= 0xfc = BSB.word8 (fromIntegral n)
- | n <= 0xffff = BSB.word8 0xfd <> BSB.word16LE (fromIntegral n)
- | n <= 0xffffffff = BSB.word8 0xfe <> BSB.word32LE (fromIntegral n)
- | otherwise = BSB.word8 0xff <> BSB.word64LE n
-{-# INLINE put_compact #-}
-
--- | Encode an OutPoint (txid + vout).
-put_outpoint :: OutPoint -> BSB.Builder
-put_outpoint OutPoint {..} =
- let !(TxId !txid_bs) = op_txid
- in BSB.byteString txid_bs <> put_word32_le op_vout
-{-# INLINE put_outpoint #-}
-
--- | Encode a TxIn.
-put_txin :: TxIn -> BSB.Builder
-put_txin TxIn {..} =
- put_outpoint txin_prevout
- <> put_compact (fromIntegral (BS.length txin_script_sig))
- <> BSB.byteString txin_script_sig
- <> put_word32_le txin_sequence
-{-# INLINE put_txin #-}
-
--- | Encode a TxOut.
-put_txout :: TxOut -> BSB.Builder
-put_txout TxOut {..} =
- put_word64_le txout_value
- <> put_compact (fromIntegral (BS.length txout_script_pubkey))
- <> BSB.byteString txout_script_pubkey
-{-# INLINE put_txout #-}
-
--- | Encode a Witness stack.
-put_witness :: Witness -> BSB.Builder
-put_witness (Witness items) =
- put_compact (fromIntegral (length items))
- <> foldMap put_witness_item items
- where
- put_witness_item :: BS.ByteString -> BSB.Builder
- put_witness_item !item =
- put_compact (fromIntegral (BS.length item))
- <> BSB.byteString item
-{-# INLINE put_witness #-}
-
-- decoding -------------------------------------------------------------------
-- | Parse a transaction from bytes.
@@ -301,7 +182,7 @@ parse_legacy !bs !version !off0 = do
!off5 = off4 + 4
-- should have consumed all bytes
guard (off5 == BS.length bs)
- pure $! Tx version inputs outputs [] locktime
+ pure $! Tx version inputs outputs locktime
-- Parse segwit transaction (with witness data)
parse_segwit :: BS.ByteString -> Word32 -> Int -> Maybe Tx
@@ -320,14 +201,23 @@ parse_segwit !bs !version !off0 = do
(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)
+ guard (any has_witness witnesses)
-- locktime (4 bytes)
guard (BS.length bs >= off5 + 4)
let !locktime = get_word32_le bs off5
!off6 = off5 + 4
-- should have consumed all bytes
guard (off6 == BS.length bs)
- pure $! Tx version inputs outputs witnesses locktime
+ pure $! Tx version (attach_witnesses inputs witnesses) outputs locktime
+
+-- Pair each input with its witness (get_many returns exactly one per
+-- input).
+attach_witnesses :: NonEmpty TxIn -> [Witness] -> NonEmpty TxIn
+attach_witnesses (i :| is) ws = case ws of
+ (w : rest) -> set i w :| zipWith set is rest
+ [] -> i :| is
+ where
+ set x w = x { txin_witness = w }
-- internal helpers -----------------------------------------------------------
@@ -439,7 +329,7 @@ get_txin !bs !off0 = do
guard (BS.length bs >= off3 + 4)
let !seqn = get_word32_le bs off3
!off4 = off3 + 4
- pure (TxIn outpoint script_sig seqn, off4)
+ pure (TxIn outpoint script_sig seqn (Witness []), off4)
-- | Decode a transaction output.
-- Returns (TxOut, new_offset).
@@ -500,8 +390,7 @@ get_many getter !bs !off0 !count
--
-- @
-- -- Satoshi->Hal tx (block 170)
--- let TxId t = txid satoshi_hal_tx
--- B16.encode (BS.reverse t)
+-- B16.encode (BS.reverse (un_txid (txid satoshi_hal_tx)))
-- == "f4184fc596403b9d638783cf57adfe4c75c605f6356fbc91338530e9831e9e16"
-- @
txid :: Tx -> TxId
diff --git a/lib/Bitcoin/Prim/Tx/Internal.hs b/lib/Bitcoin/Prim/Tx/Internal.hs
@@ -0,0 +1,168 @@
+{-# OPTIONS_HADDOCK hide #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE RecordWildCards #-}
+
+-- |
+-- Module: Bitcoin.Prim.Tx.Internal
+-- Copyright: (c) 2025 Jared Tobin
+-- License: MIT
+-- Maintainer: Jared Tobin <jared@ppad.tech>
+--
+-- Transaction types and serialisation builders, shared by the public
+-- modules.
+
+module Bitcoin.Prim.Tx.Internal (
+ -- * Transaction types
+ TxId(..)
+ , OutPoint(..)
+ , TxIn(..)
+ , TxOut(..)
+ , Witness(..)
+ , Tx(..)
+
+ -- * Builders
+ , to_strict
+ , put_word32_le
+ , put_word64_le
+ , put_compact
+ , put_bytes
+ , put_outpoint
+ , put_txin
+ , put_txout
+ , put_witness
+ ) where
+
+import Control.DeepSeq (NFData(..))
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Builder as BSB
+import qualified Data.ByteString.Lazy as BL
+import Data.List.NonEmpty (NonEmpty(..))
+import Data.Word (Word32, Word64)
+import GHC.Generics (Generic)
+
+-- types ----------------------------------------------------------------------
+
+-- | Transaction ID: 32 bytes, the double-SHA256 of the transaction's
+-- legacy serialisation, in internal byte order (the reverse of the
+-- usual hex display).
+newtype TxId = TxId BS.ByteString
+ deriving (Eq, Ord, Show, Generic)
+
+instance NFData TxId
+
+-- | Transaction outpoint (txid + output index).
+data OutPoint = OutPoint
+ { op_txid :: {-# UNPACK #-} !TxId
+ , op_vout :: {-# UNPACK #-} !Word32
+ } deriving (Eq, Ord, Show, Generic)
+
+instance NFData OutPoint
+
+-- | Witness stack for a single input (empty for a non-witness input).
+newtype Witness = Witness [BS.ByteString]
+ deriving (Eq, Show, Generic)
+
+instance NFData Witness
+
+-- | Transaction input.
+data TxIn = TxIn
+ { txin_prevout :: {-# UNPACK #-} !OutPoint
+ , txin_script_sig :: !BS.ByteString
+ , txin_sequence :: {-# UNPACK #-} !Word32
+ , txin_witness :: !Witness
+ } deriving (Eq, Show, Generic)
+
+instance NFData TxIn
+
+-- | Transaction output.
+data TxOut = TxOut
+ { txout_value :: {-# UNPACK #-} !Word64 -- ^ satoshis
+ , txout_script_pubkey :: !BS.ByteString
+ } deriving (Eq, Show, Generic)
+
+instance NFData TxOut
+
+-- | Complete transaction.
+--
+-- Bitcoin requires at least one input and one output, enforced here
+-- via 'NonEmpty' lists. Each input carries its own witness, so a
+-- transaction is serialised in the segwit format exactly when some
+-- input's witness is non-empty.
+data Tx = Tx
+ { tx_version :: {-# UNPACK #-} !Word32
+ , tx_inputs :: !(NonEmpty TxIn)
+ , tx_outputs :: !(NonEmpty TxOut)
+ , tx_locktime :: {-# UNPACK #-} !Word32
+ } deriving (Eq, Show, Generic)
+
+instance NFData Tx
+
+-- builders -------------------------------------------------------------------
+
+-- | Convert a Builder to a strict ByteString.
+to_strict :: BSB.Builder -> BS.ByteString
+to_strict = BL.toStrict . BSB.toLazyByteString
+{-# INLINE to_strict #-}
+
+-- | Encode a Word32 as little-endian bytes.
+put_word32_le :: Word32 -> BSB.Builder
+put_word32_le = BSB.word32LE
+{-# INLINE put_word32_le #-}
+
+-- | Encode a Word64 as little-endian bytes.
+put_word64_le :: Word64 -> BSB.Builder
+put_word64_le = BSB.word64LE
+{-# INLINE put_word64_le #-}
+
+-- | Encode a Word64 as Bitcoin compactSize (varint).
+--
+-- Encoding:
+-- - 0x00-0xfc: 1 byte (value itself)
+-- - 0xfd-0xffff: 0xfd ++ 2 bytes LE
+-- - 0x10000-0xffffffff: 0xfe ++ 4 bytes LE
+-- - larger: 0xff ++ 8 bytes LE
+put_compact :: Word64 -> BSB.Builder
+put_compact !n
+ | n <= 0xfc = BSB.word8 (fromIntegral n)
+ | n <= 0xffff = BSB.word8 0xfd <> BSB.word16LE (fromIntegral n)
+ | n <= 0xffffffff = BSB.word8 0xfe <> BSB.word32LE (fromIntegral n)
+ | otherwise = BSB.word8 0xff <> BSB.word64LE n
+{-# INLINE put_compact #-}
+
+-- | Encode compactSize-length-prefixed bytes (Bitcoin @ser_string@).
+put_bytes :: BS.ByteString -> BSB.Builder
+put_bytes !bs =
+ put_compact (fromIntegral (BS.length bs))
+ <> BSB.byteString bs
+{-# INLINE put_bytes #-}
+
+-- | Encode an OutPoint (txid + vout).
+put_outpoint :: OutPoint -> BSB.Builder
+put_outpoint OutPoint {..} =
+ let !(TxId !txid_bs) = op_txid
+ in BSB.byteString txid_bs <> put_word32_le op_vout
+{-# INLINE put_outpoint #-}
+
+-- | Encode a TxIn (without its witness, which is serialised
+-- separately).
+put_txin :: TxIn -> BSB.Builder
+put_txin TxIn {..} =
+ put_outpoint txin_prevout
+ <> put_bytes txin_script_sig
+ <> put_word32_le txin_sequence
+{-# INLINE put_txin #-}
+
+-- | Encode a TxOut.
+put_txout :: TxOut -> BSB.Builder
+put_txout TxOut {..} =
+ put_word64_le txout_value
+ <> put_bytes txout_script_pubkey
+{-# INLINE put_txout #-}
+
+-- | Encode a Witness stack.
+put_witness :: Witness -> BSB.Builder
+put_witness (Witness items) =
+ put_compact (fromIntegral (length items))
+ <> foldMap put_bytes items
+{-# INLINE put_witness #-}
diff --git a/lib/Bitcoin/Prim/Tx/Sighash.hs b/lib/Bitcoin/Prim/Tx/Sighash.hs
@@ -28,18 +28,20 @@ module Bitcoin.Prim.Tx.Sighash (
, sighash_taproot_keypath
, sighash_taproot_scriptpath
- -- * Internal
+ -- * Script code
, strip_codeseparators
) where
-import Bitcoin.Prim.Tx
+import Bitcoin.Prim.Tx.Internal
( Tx(..)
, TxIn(..)
, TxOut(..)
, put_word32_le
, put_word64_le
, put_compact
+ , put_bytes
, put_outpoint
+ , put_txin
, put_txout
, to_strict
)
@@ -267,7 +269,7 @@ serialize_legacy_sighash Tx{..} !idx !script_pubkey !ht =
in to_strict $
put_word32_le tx_version
<> put_compact (fromIntegral (length final_inputs))
- <> foldMap put_txin_legacy final_inputs
+ <> foldMap put_txin final_inputs
<> put_compact (fromIntegral (length final_outputs))
<> foldMap put_txout final_outputs
<> put_word32_le tx_locktime
@@ -298,15 +300,6 @@ safe_index (x : xs) !n
| otherwise = safe_index xs (n - 1)
{-# INLINE safe_index #-}
--- | Encode TxIn for legacy sighash (same as normal encoding).
-put_txin_legacy :: TxIn -> BSB.Builder
-put_txin_legacy TxIn{..} =
- put_outpoint txin_prevout
- <> put_compact (fromIntegral (BS.length txin_script_sig))
- <> BSB.byteString txin_script_sig
- <> put_word32_le txin_sequence
-{-# INLINE put_txin_legacy #-}
-
-- BIP143 segwit sighash ------------------------------------------------------
-- | Compute BIP143 segwit sighash.
@@ -413,13 +406,6 @@ sha :: BSB.Builder -> BS.ByteString
sha = SHA256.hash . to_strict
{-# INLINE sha #-}
--- | Compact-size length-prefixed bytes (Bitcoin @ser_string@).
-put_bytes :: BS.ByteString -> BSB.Builder
-put_bytes !bs =
- put_compact (fromIntegral (BS.length bs))
- <> BSB.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.
diff --git a/ppad-tx.cabal b/ppad-tx.cabal
@@ -34,6 +34,8 @@ library
exposed-modules:
Bitcoin.Prim.Tx
Bitcoin.Prim.Tx.Sighash
+ other-modules:
+ Bitcoin.Prim.Tx.Internal
build-depends:
base >= 4.9 && < 5
, bytestring >= 0.9 && < 0.13
