commit 7be7bbb7e4903df525c62baa2bc5ece23701f337
parent 23c984f83e3c629f3b8a7c1b123a7b298c394352
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 18 Apr 2026 21:46:22 +0800
replace vestigial tx encoding/decoding with ppad-tx
Add commitment_to_tx, htlc_to_tx, closing_to_tx conversion
functions in Tx.hs that convert bolt3 domain types to ppad-tx's
generic Tx type.
Replace Encode.hs: encode_tx, encode_htlc_tx, encode_closing_tx,
and encode_tx_for_signing now delegate to ppad-tx's to_bytes and
to_bytes_legacy via the conversion functions. encode_witness is
reimplemented locally. All primitive encoders removed.
Replace Decode.hs: decode_tx is now a thin wrapper around
ppad-tx's from_bytes. RawTx, RawInput, RawOutput, DecodeError
types and all primitive decoders removed.
Update BOLT3.hs: remove vestigial encode/decode primitive exports,
add conversion functions and re-export ppad-tx's Tx, TxIn, TxOut,
and from_bytes.
Update benchmarks: remove NFData instances for deleted types,
adapt encode/decode benchmarks for new Maybe return types.
Net effect: -506 lines, eliminating all duplicated tx
serialisation code.
Diffstat:
6 files changed, 180 insertions(+), 686 deletions(-)
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -97,17 +97,6 @@ instance NFData ToSelfDelay where
instance NFData CommitmentNumber where
rnf (CommitmentNumber x) = rnf x
--- Parsing types
-instance NFData RawTx where
- rnf (RawTx v i o w l) =
- rnf v `seq` rnf i `seq` rnf o `seq` rnf w `seq` rnf l
-
-instance NFData RawInput where
- rnf (RawInput o scr sq) = rnf o `seq` rnf scr `seq` rnf sq
-
-instance NFData RawOutput where
- rnf (RawOutput v s) = rnf v `seq` rnf s
-
-- Context types
instance NFData CommitmentContext where
rnf ctx = rnf (cc_funding_outpoint ctx) `seq`
@@ -183,14 +172,6 @@ instance NFData ValidationError where
rnf NoOutputs = ()
rnf (TooManyOutputs a) = rnf a
--- Decode errors
-instance NFData DecodeError where
- rnf (InsufficientBytes a b) = rnf a `seq` rnf b
- rnf (InvalidMarker a) = rnf a
- rnf (InvalidFlag a) = rnf a
- rnf InvalidVarint = ()
- rnf EmptyInput = ()
-
main :: IO ()
main = defaultMain [
bgroup "key derivation" [
@@ -282,14 +263,11 @@ main = defaultMain [
whnf encode_closing_tx (build_closing_tx sampleClosingContext)
]
, bgroup "parsing" [
- env (pure $ encode_tx $ build_commitment_tx $
- mkCommitmentContext htlcs0 noAnchors)
+ env (pure $ encodeTx0 htlcs0 noAnchors)
$ \bs -> bench "decode_tx (0 htlcs)" $ whnf decode_tx bs
- , env (pure $ encode_tx $ build_commitment_tx $
- mkCommitmentContext htlcs10 noAnchors)
+ , env (pure $ encodeTx0 htlcs10 noAnchors)
$ \bs -> bench "decode_tx (10 htlcs)" $ whnf decode_tx bs
- , env (pure $ encode_tx $ build_commitment_tx $
- mkCommitmentContext htlcs100 noAnchors)
+ , env (pure $ encodeTx0 htlcs100 noAnchors)
$ \bs -> bench "decode_tx (100 htlcs)" $ whnf decode_tx bs
]
, bgroup "validation" [
@@ -381,6 +359,14 @@ main = defaultMain [
0x5e, 0xaf, 0x46, 0x7a, 0x4a, 0x1c, 0x2a, 0x45, 0xce, 0x14, 0x86]
samplePubkey3 = samplePubkey1
+ -- Helper to encode a commitment tx for decode benchmarks
+ encodeTx0 :: [HTLC] -> ChannelFeatures -> BS.ByteString
+ encodeTx0 htlcs features =
+ case encode_tx (build_commitment_tx
+ (mkCommitmentContext htlcs features)) of
+ Nothing -> BS.empty
+ Just bs -> bs
+
-- Funding outpoint
sampleFundingOutpoint :: OutPoint
sampleFundingOutpoint = OutPoint (TxId $ BS.replicate 32 0x01) 0
diff --git a/bench/Weight.hs b/bench/Weight.hs
@@ -134,17 +134,6 @@ instance NFData ToSelfDelay where
instance NFData CommitmentNumber where
rnf (CommitmentNumber x) = rnf x
--- Parsing types
-instance NFData RawTx where
- rnf (RawTx v i o w l) =
- rnf v `seq` rnf i `seq` rnf o `seq` rnf w `seq` rnf l
-
-instance NFData RawInput where
- rnf (RawInput o scr sq) = rnf o `seq` rnf scr `seq` rnf sq
-
-instance NFData RawOutput where
- rnf (RawOutput v s) = rnf v `seq` rnf s
-
-- Context types
instance NFData CommitmentContext where
rnf ctx = rnf (cc_funding_outpoint ctx) `seq`
@@ -167,14 +156,6 @@ instance NFData ClosingContext where
rnf (clc_local_amount ctx) `seq`
rnf (clc_remote_amount ctx)
--- Error types
-instance NFData DecodeError where
- rnf (InsufficientBytes e a) = rnf e `seq` rnf a
- rnf (InvalidMarker w) = rnf w
- rnf (InvalidFlag w) = rnf w
- rnf InvalidVarint = ()
- rnf EmptyInput = ()
-
instance NFData ValidationError where
rnf (InvalidVersion e a) = rnf e `seq` rnf a
rnf (InvalidLocktime lt) = rnf lt
@@ -266,11 +247,14 @@ main = mainWith $ do
-- Serialization allocations
func "encode_tx (0 htlcs)"
- encode_tx (build_commitment_tx $ mkCommitmentContext htlcs0 noAnchors)
+ encode_tx (build_commitment_tx $
+ mkCommitmentContext htlcs0 noAnchors)
func "encode_tx (10 htlcs)"
- encode_tx (build_commitment_tx $ mkCommitmentContext htlcs10 noAnchors)
+ encode_tx (build_commitment_tx $
+ mkCommitmentContext htlcs10 noAnchors)
func "encode_tx (100 htlcs)"
- encode_tx (build_commitment_tx $ mkCommitmentContext htlcs100 noAnchors)
+ encode_tx (build_commitment_tx $
+ mkCommitmentContext htlcs100 noAnchors)
func "encode_htlc_tx"
encode_htlc_tx (build_htlc_timeout_tx sampleHtlcContext)
func "encode_closing_tx"
@@ -278,14 +262,11 @@ main = mainWith $ do
-- Parsing allocations
func "decode_tx (0 htlcs)"
- decode_tx (encode_tx $ build_commitment_tx $
- mkCommitmentContext htlcs0 noAnchors)
+ decode_tx (encodeTx0 htlcs0 noAnchors)
func "decode_tx (10 htlcs)"
- decode_tx (encode_tx $ build_commitment_tx $
- mkCommitmentContext htlcs10 noAnchors)
+ decode_tx (encodeTx0 htlcs10 noAnchors)
func "decode_tx (100 htlcs)"
- decode_tx (encode_tx $ build_commitment_tx $
- mkCommitmentContext htlcs100 noAnchors)
+ decode_tx (encodeTx0 htlcs100 noAnchors)
-- Validation allocations
func "validate_commitment_tx (valid)"
@@ -372,6 +353,14 @@ main = mainWith $ do
0x5e, 0xaf, 0x46, 0x7a, 0x4a, 0x1c, 0x2a, 0x45, 0xce, 0x14, 0x86]
samplePubkey3 = samplePubkey1
+ -- Helper to encode a commitment tx for decode benchmarks
+ encodeTx0 :: [HTLC] -> ChannelFeatures -> BS.ByteString
+ encodeTx0 htlcs features =
+ case encode_tx (build_commitment_tx
+ (mkCommitmentContext htlcs features)) of
+ Nothing -> BS.empty
+ Just bs -> bs
+
-- Funding outpoint
sampleFundingOutpoint :: OutPoint
sampleFundingOutpoint = OutPoint (TxId $ BS.replicate 32 0x01) 0
diff --git a/lib/Lightning/Protocol/BOLT3.hs b/lib/Lightning/Protocol/BOLT3.hs
@@ -235,31 +235,25 @@ module Lightning.Protocol.BOLT3 (
-- ** Output ordering
, sort_outputs
+ -- * Conversion to ppad-tx
+ , commitment_to_tx
+ , htlc_to_tx
+ , closing_to_tx
+
-- * Serialization
, encode_tx
, encode_htlc_tx
, encode_closing_tx
, encode_tx_for_signing
- , encode_varint
- , encode_le32
- , encode_le64
- , encode_outpoint
- , encode_output
, encode_witness
, encode_funding_witness
-- * Parsing
- , DecodeError(..)
- , RawTx(..)
- , RawInput(..)
- , RawOutput(..)
+ , BT.Tx(..)
+ , BT.TxIn(..)
+ , BT.TxOut(BT.TxOut)
+ , BT.from_bytes
, decode_tx
- , decode_varint
- , decode_le32
- , decode_le64
- , decode_outpoint
- , decode_output
- , decode_witness
-- * Validation
, ValidationError(..)
@@ -278,6 +272,7 @@ module Lightning.Protocol.BOLT3 (
, validate_htlc_fee
) where
+import qualified Bitcoin.Prim.Tx as BT
import Lightning.Protocol.BOLT3.Types
import Lightning.Protocol.BOLT3.Keys
import Lightning.Protocol.BOLT3.Scripts
diff --git a/lib/Lightning/Protocol/BOLT3/Decode.hs b/lib/Lightning/Protocol/BOLT3/Decode.hs
@@ -1,6 +1,4 @@
{-# OPTIONS_HADDOCK prune #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveGeneric #-}
-- |
-- Module: Lightning.Protocol.BOLT3.Decode
@@ -8,382 +6,22 @@
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
--- Parsing for BOLT #3 transactions and scripts.
+-- Parsing for BOLT #3 transactions.
--
--- Decodes SegWit Bitcoin transactions from raw bytes.
+-- Delegates to ppad-tx for transaction decoding.
module Lightning.Protocol.BOLT3.Decode (
- -- * Error types
- DecodeError(..)
-
- -- * Raw transaction type
- , RawTx(..)
- , RawInput(..)
- , RawOutput(..)
-
- -- * Transaction parsing
- , decode_tx
-
- -- * Witness parsing
- , decode_witness
-
- -- * Primitive decoding
- , decode_varint
- , decode_le32
- , decode_le64
- , decode_outpoint
- , decode_output
+ decode_tx
) where
-import Data.Bits ((.|.), shiftL)
-import Data.Word (Word8, Word32, Word64)
+import qualified Bitcoin.Prim.Tx as BT
import qualified Data.ByteString as BS
-import GHC.Generics (Generic)
-import Lightning.Protocol.BOLT3.Types
-
--- error types -----------------------------------------------------------------
-
--- | Errors that can occur during transaction decoding.
-data DecodeError
- = InsufficientBytes !Int !Int
- -- ^ Expected bytes, actual bytes available
- | InvalidMarker !Word8
- -- ^ Invalid SegWit marker byte (expected 0x00)
- | InvalidFlag !Word8
- -- ^ Invalid SegWit flag byte (expected 0x01)
- | InvalidVarint
- -- ^ Malformed varint encoding
- | EmptyInput
- -- ^ No bytes to decode
- deriving (Eq, Show, Generic)
-
--- raw transaction types -------------------------------------------------------
-
--- | A raw transaction input as parsed from bytes.
-data RawInput = RawInput
- { ri_outpoint :: !OutPoint
- , ri_script_sig :: !BS.ByteString
- , ri_sequence :: !Sequence
- } deriving (Eq, Show, Generic)
-
--- | A raw transaction output as parsed from bytes.
-data RawOutput = RawOutput
- { ro_value :: !Satoshi
- , ro_script :: !Script
- } deriving (Eq, Show, Generic)
-
--- | A raw transaction as parsed from bytes.
---
--- Supports both legacy and SegWit transaction formats.
-data RawTx = RawTx
- { rtx_version :: {-# UNPACK #-} !Word32
- , rtx_inputs :: ![RawInput]
- , rtx_outputs :: ![RawOutput]
- , rtx_witness :: ![[BS.ByteString]]
- -- ^ Witness stack for each input (empty list for legacy tx)
- , rtx_locktime :: !Locktime
- } deriving (Eq, Show, Generic)
-
--- primitive decoding ----------------------------------------------------------
-
--- | Decode a little-endian 32-bit integer.
---
--- >>> decode_le32 (BS.pack [0x01, 0x00, 0x00, 0x00])
--- Right (1, "")
-decode_le32 :: BS.ByteString -> Either DecodeError (Word32, BS.ByteString)
-decode_le32 !bs
- | BS.length bs < 4 = Left (InsufficientBytes 4 (BS.length bs))
- | otherwise =
- let !b0 = fromIntegral (BS.index bs 0)
- !b1 = fromIntegral (BS.index bs 1)
- !b2 = fromIntegral (BS.index bs 2)
- !b3 = fromIntegral (BS.index bs 3)
- !val = b0 .|. (b1 `shiftL` 8) .|. (b2 `shiftL` 16)
- .|. (b3 `shiftL` 24)
- !rest = BS.drop 4 bs
- in Right (val, rest)
-{-# INLINE decode_le32 #-}
-
--- | Decode a little-endian 64-bit integer.
---
--- >>> decode_le64 (BS.pack [0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00])
--- Right (1, "")
-decode_le64 :: BS.ByteString -> Either DecodeError (Word64, BS.ByteString)
-decode_le64 !bs
- | BS.length bs < 8 = Left (InsufficientBytes 8 (BS.length bs))
- | otherwise =
- let !b0 = fromIntegral (BS.index bs 0)
- !b1 = fromIntegral (BS.index bs 1)
- !b2 = fromIntegral (BS.index bs 2)
- !b3 = fromIntegral (BS.index bs 3)
- !b4 = fromIntegral (BS.index bs 4)
- !b5 = fromIntegral (BS.index bs 5)
- !b6 = fromIntegral (BS.index bs 6)
- !b7 = fromIntegral (BS.index bs 7)
- !val = b0 .|. (b1 `shiftL` 8) .|. (b2 `shiftL` 16)
- .|. (b3 `shiftL` 24) .|. (b4 `shiftL` 32)
- .|. (b5 `shiftL` 40) .|. (b6 `shiftL` 48)
- .|. (b7 `shiftL` 56)
- !rest = BS.drop 8 bs
- in Right (val, rest)
-{-# INLINE decode_le64 #-}
-
--- | Decode a Bitcoin varint (CompactSize).
---
--- Encoding:
--- * 0x00-0xFC: 1 byte
--- * 0xFD: 2 bytes little-endian follow
--- * 0xFE: 4 bytes little-endian follow
--- * 0xFF: 8 bytes little-endian follow
---
--- >>> decode_varint (BS.pack [0x01])
--- Right (1, "")
--- >>> decode_varint (BS.pack [0xfd, 0x00, 0x01])
--- Right (256, "")
-decode_varint :: BS.ByteString -> Either DecodeError (Word64, BS.ByteString)
-decode_varint !bs
- | BS.null bs = Left EmptyInput
- | otherwise =
- let !first = BS.index bs 0
- !rest = BS.drop 1 bs
- in case first of
- 0xFD -> decode_varint_16 rest
- 0xFE -> decode_varint_32 rest
- 0xFF -> decode_le64 rest
- _ -> Right (fromIntegral first, rest)
-{-# INLINE decode_varint #-}
-
--- | Decode a 16-bit varint payload.
-decode_varint_16 :: BS.ByteString -> Either DecodeError (Word64, BS.ByteString)
-decode_varint_16 !bs
- | BS.length bs < 2 = Left (InsufficientBytes 2 (BS.length bs))
- | otherwise =
- let !b0 = fromIntegral (BS.index bs 0) :: Word64
- !b1 = fromIntegral (BS.index bs 1) :: Word64
- !val = b0 .|. (b1 `shiftL` 8)
- !rest = BS.drop 2 bs
- in Right (val, rest)
-{-# INLINE decode_varint_16 #-}
-
--- | Decode a 32-bit varint payload.
-decode_varint_32 :: BS.ByteString -> Either DecodeError (Word64, BS.ByteString)
-decode_varint_32 !bs
- | BS.length bs < 4 = Left (InsufficientBytes 4 (BS.length bs))
- | otherwise =
- let !b0 = fromIntegral (BS.index bs 0) :: Word64
- !b1 = fromIntegral (BS.index bs 1) :: Word64
- !b2 = fromIntegral (BS.index bs 2) :: Word64
- !b3 = fromIntegral (BS.index bs 3) :: Word64
- !val = b0 .|. (b1 `shiftL` 8) .|. (b2 `shiftL` 16)
- .|. (b3 `shiftL` 24)
- !rest = BS.drop 4 bs
- in Right (val, rest)
-{-# INLINE decode_varint_32 #-}
-
--- | Decode a transaction outpoint (txid + output index).
---
--- Format: 32 bytes txid (little-endian) + 4 bytes index (little-endian)
---
--- >>> let tid = BS.replicate 32 0
--- >>> let idx = BS.pack [0x01, 0x00, 0x00, 0x00]
--- >>> decode_outpoint (tid <> idx)
--- Right (OutPoint {op_txid = ..., op_vout = 1}, "")
-decode_outpoint
- :: BS.ByteString
- -> Either DecodeError (OutPoint, BS.ByteString)
-decode_outpoint !bs
- | BS.length bs < 36 = Left (InsufficientBytes 36 (BS.length bs))
- | otherwise =
- let !tid = TxId (BS.take 32 bs)
- !rest1 = BS.drop 32 bs
- in case decode_le32 rest1 of
- Left err -> Left err
- Right (!idx, !rest2) ->
- let !outpoint = OutPoint tid idx
- in Right (outpoint, rest2)
-{-# INLINE decode_outpoint #-}
-
--- | Decode a transaction output (value + scriptPubKey).
---
--- Format: 8 bytes value (little-endian) + varint script length + script
-decode_output :: BS.ByteString -> Either DecodeError (RawOutput, BS.ByteString)
-decode_output !bs = do
- (!value, !rest1) <- decode_le64 bs
- (!scriptLen, !rest2) <- decode_varint rest1
- let !len = fromIntegral scriptLen
- if BS.length rest2 < len
- then Left (InsufficientBytes len (BS.length rest2))
- else
- let !script = Script (BS.take len rest2)
- !rest3 = BS.drop len rest2
- !output = RawOutput (Satoshi value) script
- in Right (output, rest3)
-{-# INLINE decode_output #-}
-
--- witness parsing -------------------------------------------------------------
-
--- | Decode a witness stack for one input.
---
--- Format: varint num_items + (varint length + data) for each item
-decode_witness
- :: BS.ByteString
- -> Either DecodeError (Witness, BS.ByteString)
-decode_witness !bs = do
- (!numItems, !rest1) <- decode_varint bs
- (!items, !rest2) <- decode_witness_items (fromIntegral numItems) rest1 []
- Right (Witness items, rest2)
-{-# INLINE decode_witness #-}
-
--- | Decode witness items recursively.
-decode_witness_items
- :: Int
- -> BS.ByteString
- -> [BS.ByteString]
- -> Either DecodeError ([BS.ByteString], BS.ByteString)
-decode_witness_items 0 !bs !acc = Right (reverse acc, bs)
-decode_witness_items !n !bs !acc = do
- (!itemLen, !rest1) <- decode_varint bs
- let !len = fromIntegral itemLen
- if BS.length rest1 < len
- then Left (InsufficientBytes len (BS.length rest1))
- else
- let !item = BS.take len rest1
- !rest2 = BS.drop len rest1
- in decode_witness_items (n - 1) rest2 (item : acc)
-
--- | Decode witness stacks for all inputs (internal, returns list).
-decode_witness_stacks
- :: Int
- -> BS.ByteString
- -> [[BS.ByteString]]
- -> Either DecodeError ([[BS.ByteString]], BS.ByteString)
-decode_witness_stacks 0 !bs !acc = Right (reverse acc, bs)
-decode_witness_stacks !n !bs !acc = do
- (Witness !items, !rest) <- decode_witness bs
- decode_witness_stacks (n - 1) rest (items : acc)
-
--- transaction parsing ---------------------------------------------------------
-- | Decode a raw Bitcoin transaction from bytes.
--
-- Handles both legacy and SegWit transaction formats.
--
--- SegWit format:
--- * version (4 bytes LE)
--- * marker (0x00) + flag (0x01)
--- * input count (varint)
--- * inputs: outpoint (32+4), scriptSig length (varint), scriptSig, sequence
--- * output count (varint)
--- * outputs: value (8 LE), scriptPubKey length (varint), scriptPubKey
--- * witness data (for each input)
--- * locktime (4 bytes LE)
---
-- >>> decode_tx rawTxBytes
--- Right (RawTx {...})
-decode_tx :: BS.ByteString -> Either DecodeError RawTx
-decode_tx !bs = do
- -- Version (4 bytes LE)
- (!version, !rest1) <- decode_le32 bs
-
- -- Check for SegWit marker/flag
- let !hasWitness = BS.length rest1 >= 2 &&
- BS.index rest1 0 == 0x00 &&
- BS.index rest1 1 == 0x01
-
- if hasWitness
- then decode_tx_segwit version (BS.drop 2 rest1)
- else decode_tx_legacy version rest1
-{-# INLINE decode_tx #-}
-
--- | Decode a SegWit transaction (after marker/flag consumed).
-decode_tx_segwit
- :: Word32
- -> BS.ByteString
- -> Either DecodeError RawTx
-decode_tx_segwit !version !bs = do
- -- Input count and inputs
- (!inputCount, !rest1) <- decode_varint bs
- (!inputs, !rest2) <- decode_inputs (fromIntegral inputCount) rest1 []
-
- -- Output count and outputs
- (!outputCount, !rest3) <- decode_varint rest2
- (!outputs, !rest4) <- decode_outputs (fromIntegral outputCount) rest3 []
-
- -- Witness data for each input
- (!witnesses, !rest5) <- decode_witness_stacks (length inputs) rest4 []
-
- -- Locktime (4 bytes LE)
- (!locktime, !_rest6) <- decode_le32 rest5
-
- Right RawTx
- { rtx_version = version
- , rtx_inputs = inputs
- , rtx_outputs = outputs
- , rtx_witness = witnesses
- , rtx_locktime = Locktime locktime
- }
-
--- | Decode a legacy (non-SegWit) transaction.
-decode_tx_legacy
- :: Word32
- -> BS.ByteString
- -> Either DecodeError RawTx
-decode_tx_legacy !version !bs = do
- -- Input count and inputs
- (!inputCount, !rest1) <- decode_varint bs
- (!inputs, !rest2) <- decode_inputs (fromIntegral inputCount) rest1 []
-
- -- Output count and outputs
- (!outputCount, !rest3) <- decode_varint rest2
- (!outputs, !rest4) <- decode_outputs (fromIntegral outputCount) rest3 []
-
- -- Locktime (4 bytes LE)
- (!locktime, !_rest5) <- decode_le32 rest4
-
- Right RawTx
- { rtx_version = version
- , rtx_inputs = inputs
- , rtx_outputs = outputs
- , rtx_witness = []
- , rtx_locktime = Locktime locktime
- }
-
--- | Decode transaction inputs recursively.
-decode_inputs
- :: Int
- -> BS.ByteString
- -> [RawInput]
- -> Either DecodeError ([RawInput], BS.ByteString)
-decode_inputs 0 !bs !acc = Right (reverse acc, bs)
-decode_inputs !n !bs !acc = do
- (!input, !rest) <- decode_input bs
- decode_inputs (n - 1) rest (input : acc)
-
--- | Decode a single transaction input.
---
--- Format: outpoint (36 bytes) + scriptSig length (varint) + scriptSig +
--- sequence (4 bytes LE)
-decode_input :: BS.ByteString -> Either DecodeError (RawInput, BS.ByteString)
-decode_input !bs = do
- (!outpoint, !rest1) <- decode_outpoint bs
- (!scriptLen, !rest2) <- decode_varint rest1
- let !len = fromIntegral scriptLen
- if BS.length rest2 < len
- then Left (InsufficientBytes len (BS.length rest2))
- else do
- let !scriptSig = BS.take len rest2
- !rest3 = BS.drop len rest2
- (!seqNum, !rest4) <- decode_le32 rest3
- let !input = RawInput outpoint scriptSig (Sequence seqNum)
- Right (input, rest4)
-
--- | Decode transaction outputs recursively.
-decode_outputs
- :: Int
- -> BS.ByteString
- -> [RawOutput]
- -> Either DecodeError ([RawOutput], BS.ByteString)
-decode_outputs 0 !bs !acc = Right (reverse acc, bs)
-decode_outputs !n !bs !acc = do
- (!output, !rest) <- decode_output bs
- decode_outputs (n - 1) rest (output : acc)
+-- Just (Tx {...})
+decode_tx :: BS.ByteString -> Maybe BT.Tx
+decode_tx = BT.from_bytes
diff --git a/lib/Lightning/Protocol/BOLT3/Encode.hs b/lib/Lightning/Protocol/BOLT3/Encode.hs
@@ -9,19 +9,7 @@
--
-- Serialization for BOLT #3 transactions and scripts.
--
--- Provides Bitcoin transaction serialization in both standard SegWit
--- format (with witness data) and the stripped format used for signing.
---
--- == Transaction Format (SegWit)
---
--- * version (4 bytes LE)
--- * marker (0x00) + flag (0x01)
--- * input count (varint)
--- * inputs: outpoint (32+4), scriptSig length (varint), scriptSig, sequence
--- * output count (varint)
--- * outputs: value (8 LE), scriptPubKey length (varint), scriptPubKey
--- * witness data (for each input)
--- * locktime (4 bytes LE)
+-- Delegates to ppad-tx for transaction encoding.
module Lightning.Protocol.BOLT3.Encode (
-- * Transaction serialization
@@ -33,267 +21,82 @@ module Lightning.Protocol.BOLT3.Encode (
-- * Witness serialization
, encode_witness
, encode_funding_witness
-
- -- * Primitive encoding
- , encode_varint
- , encode_le32
- , encode_le64
- , encode_outpoint
- , encode_output
) where
-import Data.Word (Word32, Word64)
+import qualified Bitcoin.Prim.Tx as BT
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BSB
-import qualified Data.ByteString.Lazy as BSL
+import Data.Word (Word64)
import Lightning.Protocol.BOLT3.Types
import Lightning.Protocol.BOLT3.Tx
--- primitive encoding ----------------------------------------------------------
-
--- | Encode a 32-bit value in little-endian format.
---
--- >>> encode_le32 0x12345678
--- "\x78\x56\x34\x12"
-encode_le32 :: Word32 -> BS.ByteString
-encode_le32 = BSL.toStrict . BSB.toLazyByteString . BSB.word32LE
-{-# INLINE encode_le32 #-}
+-- transaction encoding --------------------------------------------------------
--- | Encode a 64-bit value in little-endian format.
+-- | Encode a commitment transaction (SegWit format).
--
--- >>> encode_le64 0x123456789ABCDEF0
--- "\xF0\xDE\xBC\x9A\x78\x56\x34\x12"
-encode_le64 :: Word64 -> BS.ByteString
-encode_le64 = BSL.toStrict . BSB.toLazyByteString . BSB.word64LE
-{-# INLINE encode_le64 #-}
+-- Returns 'Nothing' if the transaction has no outputs.
+encode_tx :: CommitmentTx -> Maybe BS.ByteString
+encode_tx = fmap BT.to_bytes . commitment_to_tx
--- | Encode a value as a Bitcoin varint (CompactSize).
---
--- Encoding scheme:
---
--- * 0-252: 1 byte
--- * 253-65535: 0xFD followed by 2 bytes LE
--- * 65536-4294967295: 0xFE followed by 4 bytes LE
--- * larger: 0xFF followed by 8 bytes LE
---
--- >>> encode_varint 100
--- "\x64"
--- >>> encode_varint 1000
--- "\xFD\xE8\x03"
-encode_varint :: Word64 -> BS.ByteString
-encode_varint !n
- | n < 0xFD = BS.singleton (fromIntegral n)
- | n <= 0xFFFF = BSL.toStrict $ BSB.toLazyByteString $
- BSB.word8 0xFD <> BSB.word16LE (fromIntegral n)
- | n <= 0xFFFFFFFF = BSL.toStrict $ BSB.toLazyByteString $
- BSB.word8 0xFE <> BSB.word32LE (fromIntegral n)
- | otherwise = BSL.toStrict $ BSB.toLazyByteString $
- BSB.word8 0xFF <> BSB.word64LE n
-{-# INLINE encode_varint #-}
+-- | Encode an HTLC transaction (SegWit format).
+encode_htlc_tx :: HTLCTx -> BS.ByteString
+encode_htlc_tx = BT.to_bytes . htlc_to_tx
--- | Encode an outpoint (txid + output index).
+-- | Encode a closing transaction (SegWit format).
--
--- Format: 32 bytes txid (already LE in TxId) + 4 bytes output index LE
---
--- >>> encode_outpoint (OutPoint txid 0)
--- <32-byte txid><4-byte index>
-encode_outpoint :: OutPoint -> BS.ByteString
-encode_outpoint !op = BSL.toStrict $ BSB.toLazyByteString $
- let !(TxId bs) = op_txid op
- in BSB.byteString bs <>
- BSB.word32LE (op_vout op)
-{-# INLINE encode_outpoint #-}
+-- Returns 'Nothing' if the transaction has no outputs.
+encode_closing_tx :: ClosingTx -> Maybe BS.ByteString
+encode_closing_tx = fmap BT.to_bytes . closing_to_tx
--- | Encode a transaction output.
---
--- Format: 8 bytes value LE + varint scriptPubKey length + scriptPubKey
+-- | Encode a commitment transaction for signing (stripped
+-- format, no witness).
--
--- >>> encode_output (TxOutput (Satoshi 100000) script OutputToLocal)
--- <8-byte value><varint length><scriptPubKey>
-encode_output :: TxOutput -> BS.ByteString
-encode_output !out = BSL.toStrict $ BSB.toLazyByteString $
- let !script = unScript (txout_script out)
- !scriptLen = fromIntegral (BS.length script) :: Word64
- in BSB.word64LE (unSatoshi $ txout_value out) <>
- varint_builder scriptLen <>
- BSB.byteString script
-{-# INLINE encode_output #-}
+-- Returns 'Nothing' if the transaction has no outputs.
+encode_tx_for_signing
+ :: CommitmentTx -> Maybe BS.ByteString
+encode_tx_for_signing =
+ fmap BT.to_bytes_legacy . commitment_to_tx
-- witness encoding ------------------------------------------------------------
-- | Encode a witness stack.
--
--- Format: varint item count + (varint length + data) for each item
---
--- >>> encode_witness (Witness [sig, pubkey])
--- <varint 2><varint sigLen><sig><varint pkLen><pubkey>
+-- Format: varint item count, then for each item:
+-- varint length followed by item data.
encode_witness :: Witness -> BS.ByteString
-encode_witness (Witness !items) = BSL.toStrict $ BSB.toLazyByteString $
- let !count = fromIntegral (length items) :: Word64
- in varint_builder count <> mconcat (map encode_witness_item items)
-{-# INLINE encode_witness #-}
-
--- | Encode a single witness stack item.
-encode_witness_item :: BS.ByteString -> BSB.Builder
-encode_witness_item !bs =
- let !len = fromIntegral (BS.length bs) :: Word64
- in varint_builder len <> BSB.byteString bs
-{-# INLINE encode_witness_item #-}
+encode_witness (Witness !items) =
+ BT.to_strict $
+ put_varint (fromIntegral (length items))
+ <> foldMap put_item items
+ where
+ put_item :: BS.ByteString -> BSB.Builder
+ put_item !bs =
+ put_varint (fromIntegral (BS.length bs))
+ <> BSB.byteString bs
+
+-- | Encode a varint to a 'BSB.Builder'.
+put_varint :: Word64 -> BSB.Builder
+put_varint !n
+ | n < 0xFD = 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_varint #-}
-- | Encode a funding witness (2-of-2 multisig).
--
-- The witness stack is: @0 <sig1> <sig2> <witnessScript>@
--
--- Signatures must be ordered to match pubkey order in the funding script.
---
--- >>> encode_funding_witness sig1 sig2 fundingScript
--- <witness with 4 items: empty, sig1, sig2, script>
+-- Signatures must be ordered to match pubkey order in the
+-- funding script.
encode_funding_witness
- :: BS.ByteString -- ^ Signature for pubkey1 (lexicographically lesser)
- -> BS.ByteString -- ^ Signature for pubkey2 (lexicographically greater)
+ :: BS.ByteString -- ^ Signature for lesser pubkey
+ -> BS.ByteString -- ^ Signature for greater pubkey
-> Script -- ^ The funding witness script
-> BS.ByteString
-encode_funding_witness !sig1 !sig2 (Script !witnessScript) =
- BSL.toStrict $ BSB.toLazyByteString $
- varint_builder 4 <>
- encode_witness_item BS.empty <>
- encode_witness_item sig1 <>
- encode_witness_item sig2 <>
- encode_witness_item witnessScript
-{-# INLINE encode_funding_witness #-}
-
--- transaction encoding --------------------------------------------------------
-
--- | Encode a commitment transaction (SegWit format with witness).
---
--- SegWit format:
---
--- * version (4 bytes LE)
--- * marker (0x00)
--- * flag (0x01)
--- * input count (varint)
--- * inputs
--- * output count (varint)
--- * outputs
--- * witness data
--- * locktime (4 bytes LE)
---
--- Note: The witness is empty (just count=0) since the commitment tx
--- spending the funding output requires external signatures.
-encode_tx :: CommitmentTx -> BS.ByteString
-encode_tx !tx = BSL.toStrict $ BSB.toLazyByteString $
- -- Version
- BSB.word32LE (ctx_version tx) <>
- -- SegWit marker and flag
- BSB.word8 0x00 <>
- BSB.word8 0x01 <>
- -- Input count (always 1 for commitment tx)
- varint_builder 1 <>
- -- Input: outpoint + empty scriptSig + sequence
- BSB.byteString (encode_outpoint (ctx_input_outpoint tx)) <>
- varint_builder 0 <> -- scriptSig length (empty for SegWit)
- BSB.word32LE (unSequence $ ctx_input_sequence tx) <>
- -- Output count
- varint_builder (fromIntegral $ length $ ctx_outputs tx) <>
- -- Outputs
- mconcat (map (BSB.byteString . encode_output) (ctx_outputs tx)) <>
- -- Witness (empty stack for unsigned tx)
- varint_builder 0 <>
- -- Locktime
- BSB.word32LE (unLocktime $ ctx_locktime tx)
-
--- | Encode an HTLC transaction (SegWit format with witness).
---
--- HTLC transactions have a single input (the commitment tx HTLC output)
--- and a single output (the to_local-style delayed output).
-encode_htlc_tx :: HTLCTx -> BS.ByteString
-encode_htlc_tx !tx = BSL.toStrict $ BSB.toLazyByteString $
- -- Version
- BSB.word32LE (htx_version tx) <>
- -- SegWit marker and flag
- BSB.word8 0x00 <>
- BSB.word8 0x01 <>
- -- Input count (always 1)
- varint_builder 1 <>
- -- Input: outpoint + empty scriptSig + sequence
- BSB.byteString (encode_outpoint (htx_input_outpoint tx)) <>
- varint_builder 0 <> -- scriptSig length (empty for SegWit)
- BSB.word32LE (unSequence $ htx_input_sequence tx) <>
- -- Output count (always 1)
- varint_builder 1 <>
- -- Output: value + scriptPubKey
- BSB.word64LE (unSatoshi $ htx_output_value tx) <>
- let !script = unScript (htx_output_script tx)
- !scriptLen = fromIntegral (BS.length script) :: Word64
- in varint_builder scriptLen <> BSB.byteString script <>
- -- Witness (empty stack for unsigned tx)
- varint_builder 0 <>
- -- Locktime
- BSB.word32LE (unLocktime $ htx_locktime tx)
-
--- | Encode a closing transaction (SegWit format with witness).
---
--- Closing transactions have a single input (the funding output) and
--- one or two outputs (to_local and/or to_remote).
-encode_closing_tx :: ClosingTx -> BS.ByteString
-encode_closing_tx !tx = BSL.toStrict $ BSB.toLazyByteString $
- -- Version
- BSB.word32LE (cltx_version tx) <>
- -- SegWit marker and flag
- BSB.word8 0x00 <>
- BSB.word8 0x01 <>
- -- Input count (always 1)
- varint_builder 1 <>
- -- Input: outpoint + empty scriptSig + sequence
- BSB.byteString (encode_outpoint (cltx_input_outpoint tx)) <>
- varint_builder 0 <> -- scriptSig length (empty for SegWit)
- BSB.word32LE (unSequence $ cltx_input_sequence tx) <>
- -- Output count
- varint_builder (fromIntegral $ length $ cltx_outputs tx) <>
- -- Outputs
- mconcat (map (BSB.byteString . encode_output) (cltx_outputs tx)) <>
- -- Witness (empty stack for unsigned tx)
- varint_builder 0 <>
- -- Locktime
- BSB.word32LE (unLocktime $ cltx_locktime tx)
-
--- | Encode a commitment transaction for signing (stripped format).
---
--- The stripped format omits the SegWit marker, flag, and witness data.
--- This is the format used to compute the sighash for signing.
---
--- Format:
---
--- * version (4 bytes LE)
--- * input count (varint)
--- * inputs
--- * output count (varint)
--- * outputs
--- * locktime (4 bytes LE)
-encode_tx_for_signing :: CommitmentTx -> BS.ByteString
-encode_tx_for_signing !tx = BSL.toStrict $ BSB.toLazyByteString $
- -- Version
- BSB.word32LE (ctx_version tx) <>
- -- Input count (always 1 for commitment tx)
- varint_builder 1 <>
- -- Input: outpoint + empty scriptSig + sequence
- BSB.byteString (encode_outpoint (ctx_input_outpoint tx)) <>
- varint_builder 0 <> -- scriptSig length (empty for SegWit)
- BSB.word32LE (unSequence $ ctx_input_sequence tx) <>
- -- Output count
- varint_builder (fromIntegral $ length $ ctx_outputs tx) <>
- -- Outputs
- mconcat (map (BSB.byteString . encode_output) (ctx_outputs tx)) <>
- -- Locktime
- BSB.word32LE (unLocktime $ ctx_locktime tx)
-
--- internal helpers ------------------------------------------------------------
-
--- | Build a varint directly to Builder.
-varint_builder :: Word64 -> BSB.Builder
-varint_builder !n
- | n < 0xFD = 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 varint_builder #-}
+encode_funding_witness !sig1 !sig2 (Script !ws) =
+ encode_witness
+ (Witness [BS.empty, sig1, sig2, ws])
diff --git a/lib/Lightning/Protocol/BOLT3/Tx.hs b/lib/Lightning/Protocol/BOLT3/Tx.hs
@@ -36,6 +36,11 @@ module Lightning.Protocol.BOLT3.Tx (
, build_closing_tx
, build_legacy_closing_tx
+ -- * Conversion to ppad-tx
+ , commitment_to_tx
+ , htlc_to_tx
+ , closing_to_tx
+
-- * Transaction outputs
, TxOutput(..)
, OutputType(..)
@@ -56,8 +61,11 @@ module Lightning.Protocol.BOLT3.Tx (
, sort_outputs
) where
+import qualified Bitcoin.Prim.Tx as BT
import Data.Bits ((.&.), (.|.), shiftL, shiftR)
+import qualified Data.ByteString as BS
import Data.List (sortBy)
+import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
import Data.Word (Word32, Word64)
import GHC.Generics (Generic)
import Lightning.Protocol.BOLT3.Keys
@@ -558,6 +566,81 @@ untrimmed_htlcs dust feerate features =
filter (not . is_trimmed dust feerate features)
{-# INLINE untrimmed_htlcs #-}
+-- conversion to ppad-tx -------------------------------------------------------
+
+-- | Convert a 'TxOutput' to a ppad-tx 'BT.TxOut'.
+toTxOut :: TxOutput -> BT.TxOut
+toTxOut o = BT.TxOut
+ { BT.txout_value =
+ unSatoshi (txout_value o)
+ , BT.txout_script_pubkey =
+ unScript (txout_script o)
+ }
+{-# INLINE toTxOut #-}
+
+-- | Convert a commitment transaction to a ppad-tx 'BT.Tx'.
+--
+-- Returns 'Nothing' if the transaction has no outputs.
+commitment_to_tx :: CommitmentTx -> Maybe BT.Tx
+commitment_to_tx ctx = do
+ outs <- nonEmpty (map toTxOut (ctx_outputs ctx))
+ let !input = BT.TxIn
+ { BT.txin_prevout = ctx_input_outpoint ctx
+ , BT.txin_script_sig = BS.empty
+ , BT.txin_sequence =
+ unSequence (ctx_input_sequence ctx)
+ }
+ pure $! BT.Tx
+ { BT.tx_version = ctx_version ctx
+ , BT.tx_inputs = input :| []
+ , BT.tx_outputs = outs
+ , BT.tx_witnesses = []
+ , BT.tx_locktime = unLocktime (ctx_locktime ctx)
+ }
+
+-- | Convert an HTLC transaction to a ppad-tx 'BT.Tx'.
+htlc_to_tx :: HTLCTx -> BT.Tx
+htlc_to_tx htx =
+ let !input = BT.TxIn
+ { BT.txin_prevout = htx_input_outpoint htx
+ , BT.txin_script_sig = BS.empty
+ , BT.txin_sequence =
+ unSequence (htx_input_sequence htx)
+ }
+ !output = BT.TxOut
+ { BT.txout_value =
+ unSatoshi (htx_output_value htx)
+ , BT.txout_script_pubkey =
+ unScript (htx_output_script htx)
+ }
+ in BT.Tx
+ { BT.tx_version = htx_version htx
+ , BT.tx_inputs = input :| []
+ , BT.tx_outputs = output :| []
+ , BT.tx_witnesses = []
+ , BT.tx_locktime = unLocktime (htx_locktime htx)
+ }
+
+-- | Convert a closing transaction to a ppad-tx 'BT.Tx'.
+--
+-- Returns 'Nothing' if the transaction has no outputs.
+closing_to_tx :: ClosingTx -> Maybe BT.Tx
+closing_to_tx ctx = do
+ outs <- nonEmpty (map toTxOut (cltx_outputs ctx))
+ let !input = BT.TxIn
+ { BT.txin_prevout = cltx_input_outpoint ctx
+ , BT.txin_script_sig = BS.empty
+ , BT.txin_sequence =
+ unSequence (cltx_input_sequence ctx)
+ }
+ pure $! BT.Tx
+ { BT.tx_version = cltx_version ctx
+ , BT.tx_inputs = input :| []
+ , BT.tx_outputs = outs
+ , BT.tx_witnesses = []
+ , BT.tx_locktime = unLocktime (cltx_locktime ctx)
+ }
+
-- output ordering -------------------------------------------------------------
-- | Sort outputs per BOLT #3 ordering.
