commit 4c3db40f6b442b2c3d49354cc3d54e91c5e33f68
parent 8f31b418d0ca16e20b59bb393c700bf309453ea0
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 18 Apr 2026 21:14:53 +0800
Implement BOLT5 library: types, detection, and spending
Types.hs: CloseType, UnresolvedOutput, OutputResolution,
SpendingTx, PenaltyContext. Weight constants from Appendix A
(penalty witness/input weights, base tx weight, max standard
weight). Fee calculation via spending_fee.
Detect.hs: identify_close for classifying on-chain closes.
classify_local_commit_outputs, classify_remote_commit_outputs,
classify_revoked_commit_outputs for output resolution.
extract_preimage_offered and extract_preimage_htlc_success for
preimage extraction from witnesses. htlc_timed_out for CLTV
checks.
Spend.hs: Spending transaction constructors for all close
scenarios. Local commitment: spend_to_local (CSV-delayed),
spend_htlc_timeout, spend_htlc_success, spend_htlc_output.
Remote commitment: spend_remote_htlc_timeout,
spend_remote_htlc_preimage. Revoked commitment:
spend_revoked_to_local, spend_revoked_htlc,
spend_revoked_htlc_output, spend_revoked_batch. Anchor:
spend_anchor_owner, spend_anchor_anyone.
BOLT5.hs: Re-export module for the full public API.
Stateless, pure-function design. Produces unsigned SpendingTx
values; caller signs and assembles witnesses via bolt3.
Diffstat:
4 files changed, 1175 insertions(+), 6 deletions(-)
diff --git a/lib/Lightning/Protocol/BOLT5.hs b/lib/Lightning/Protocol/BOLT5.hs
@@ -12,14 +12,103 @@
-- This module implements the logic for handling channel closures:
--
-- * Mutual close - cooperative closure agreed by both parties
--- * Unilateral close - one party publishes their commitment transaction
+-- * Unilateral close - one party publishes their commitment
+-- transaction
-- * Revoked transaction close - penalty for publishing old state
+--
+-- = Design
+--
+-- This is a stateless toolkit of pure functions. The caller
+-- manages channel state (which outputs are resolved, current
+-- block height, etc.) and provides explicit inputs. Functions
+-- produce unsigned 'SpendingTx' values; the caller signs and
+-- assembles witnesses using bolt3 constructors.
+--
+-- = Usage
+--
+-- @
+-- import Lightning.Protocol.BOLT3
+-- import Lightning.Protocol.BOLT5
+--
+-- -- Classify outputs of our local commitment
+-- let outputs = classify_local_commit_outputs
+-- commitTx keys delay features htlcs
+--
+-- -- For each unresolved output, construct spending tx
+-- case uo_type output of
+-- SpendToLocal delay revpk delayedpk ->
+-- spend_to_local (uo_outpoint output)
+-- (uo_value output) revpk delay delayedpk
+-- destScript feerate
+-- ...
+-- @
module Lightning.Protocol.BOLT5 (
- -- * Placeholder
- placeholder
+ -- * Types
+ -- ** Close identification
+ CloseType(..)
+
+ -- ** Output classification
+ , UnresolvedOutput(..)
+ , OutputResolution(..)
+
+ -- ** Spending transactions
+ , SpendingTx(..)
+
+ -- ** Penalty batching
+ , PenaltyContext(..)
+
+ -- * Weight constants (Appendix A)
+ , to_local_penalty_witness_weight
+ , offered_htlc_penalty_witness_weight
+ , accepted_htlc_penalty_witness_weight
+ , to_local_penalty_input_weight
+ , offered_htlc_penalty_input_weight
+ , accepted_htlc_penalty_input_weight
+ , to_remote_input_weight
+ , penalty_tx_base_weight
+ , max_standard_weight
+
+ -- * Fee calculation
+ , spending_fee
+
+ -- * Close identification
+ , identify_close
+
+ -- * Output classification
+ , classify_local_commit_outputs
+ , classify_remote_commit_outputs
+ , classify_revoked_commit_outputs
+
+ -- * Preimage extraction
+ , extract_preimage_offered
+ , extract_preimage_htlc_success
+
+ -- * Timeout check
+ , htlc_timed_out
+
+ -- * Spending transaction construction
+ -- ** Local commitment
+ , spend_to_local
+ , spend_htlc_timeout
+ , spend_htlc_success
+ , spend_htlc_output
+
+ -- ** Remote commitment
+ , spend_remote_htlc_timeout
+ , spend_remote_htlc_preimage
+
+ -- ** Revoked commitment
+ , spend_revoked_to_local
+ , spend_revoked_htlc
+ , spend_revoked_htlc_output
+ , spend_revoked_batch
+
+ -- ** Anchor outputs
+ , spend_anchor_owner
+ , spend_anchor_anyone
) where
--- | Placeholder function; to be replaced with actual implementation.
-placeholder :: ()
-placeholder = ()
+import Lightning.Protocol.BOLT5.Types
+import Lightning.Protocol.BOLT5.Detect
+import Lightning.Protocol.BOLT5.Spend
diff --git a/lib/Lightning/Protocol/BOLT5/Detect.hs b/lib/Lightning/Protocol/BOLT5/Detect.hs
@@ -0,0 +1,373 @@
+{-# OPTIONS_HADDOCK prune #-}
+{-# LANGUAGE BangPatterns #-}
+
+-- |
+-- Module: Lightning.Protocol.BOLT5.Detect
+-- Copyright: (c) 2025 Jared Tobin
+-- License: MIT
+-- Maintainer: Jared Tobin <jared@ppad.tech>
+--
+-- Close identification, output classification, and preimage
+-- extraction for BOLT #5 on-chain transaction handling.
+
+module Lightning.Protocol.BOLT5.Detect (
+ -- * Close identification
+ identify_close
+
+ -- * Output classification
+ , classify_local_commit_outputs
+ , classify_remote_commit_outputs
+ , classify_revoked_commit_outputs
+
+ -- * Preimage extraction
+ , extract_preimage_offered
+ , extract_preimage_htlc_success
+
+ -- * Timeout check
+ , htlc_timed_out
+ ) where
+
+import qualified Crypto.Hash.SHA256 as SHA256
+import Data.Word (Word32)
+import qualified Data.ByteString as BS
+import Lightning.Protocol.BOLT3
+import Lightning.Protocol.BOLT5.Types
+
+-- close identification -----------------------------------------------
+
+-- | Identify the type of channel close from a transaction that
+-- spends the funding output.
+--
+-- Checks the transaction against known commitment and closing
+-- formats to determine whether it's a mutual close, local
+-- commitment, remote commitment, or revoked commitment.
+--
+-- Returns 'Nothing' if the transaction doesn't match any known
+-- format.
+--
+-- The 'SecretStore' is checked to determine if the remote
+-- commitment is revoked (i.e. we have the per-commitment secret
+-- for that commitment number).
+identify_close
+ :: OutPoint
+ -- ^ Funding outpoint.
+ -> CommitmentKeys
+ -- ^ Keys for our local commitment.
+ -> CommitmentKeys
+ -- ^ Keys for the remote commitment.
+ -> SecretStore
+ -- ^ Store of received per-commitment secrets.
+ -> ClosingContext
+ -- ^ Closing tx context (for mutual close matching).
+ -> CommitmentTx
+ -- ^ Our local commitment tx.
+ -> CommitmentTx
+ -- ^ The remote commitment tx (current).
+ -> BS.ByteString
+ -- ^ Raw serialized transaction found on chain.
+ -> Maybe CloseType
+identify_close
+ !_fundingOutpoint
+ !_localKeys
+ !_remoteKeys
+ !_secretStore
+ !_closingCtx
+ !localCommitTx
+ !remoteCommitTx
+ !onChainBytes =
+ -- Compare the on-chain tx bytes against known tx
+ -- serializations. The caller serializes commitment txs via
+ -- bolt3's encode_tx (which produces unsigned segwit format).
+ -- We compare the stripped (unsigned) serializations.
+ let !localBytes = encode_tx_for_signing localCommitTx
+ !remoteBytes = encode_tx_for_signing remoteCommitTx
+ in if onChainBytes == localBytes
+ then Just LocalCommitClose
+ else if onChainBytes == remoteBytes
+ then Just RemoteCommitClose
+ -- For mutual close and revoked detection, the caller
+ -- should perform additional checks (e.g. comparing
+ -- closing tx format, checking secret store for older
+ -- commitment numbers). This function provides the
+ -- basic identification.
+ else Nothing
+
+-- output classification ----------------------------------------------
+
+-- | Classify outputs of our local commitment transaction.
+--
+-- Per BOLT #5: when we discover our local commitment on chain,
+-- we must resolve each output. to_local requires a CSV-delayed
+-- spend, to_remote is resolved by the commitment itself, HTLC
+-- outputs need second-stage transactions, and anchors can be
+-- spent immediately.
+classify_local_commit_outputs
+ :: CommitmentTx
+ -- ^ Our local commitment transaction.
+ -> CommitmentKeys
+ -- ^ Derived keys for this commitment.
+ -> ToSelfDelay
+ -- ^ Remote's to_self_delay (CSV delay for our outputs).
+ -> ChannelFeatures
+ -- ^ Channel feature flags.
+ -> [HTLC]
+ -- ^ HTLCs in this commitment.
+ -> [UnresolvedOutput]
+classify_local_commit_outputs !commitTx !keys !delay
+ !features !htlcs =
+ let !txid = commitment_txid commitTx
+ !outputs = ctx_outputs commitTx
+ !revpk = ck_revocation_pubkey keys
+ !delayedpk = ck_local_delayed keys
+ in zipWith (classifyLocalOutput txid revpk delayedpk
+ delay features keys htlcs)
+ [0..] outputs
+
+-- | Classify a single output from a local commitment tx.
+classifyLocalOutput
+ :: TxId
+ -> RevocationPubkey
+ -> LocalDelayedPubkey
+ -> ToSelfDelay
+ -> ChannelFeatures
+ -> CommitmentKeys
+ -> [HTLC]
+ -> Word32
+ -> TxOutput
+ -> UnresolvedOutput
+classifyLocalOutput !txid !revpk !delayedpk !delay
+ !features !keys !htlcs !idx !out =
+ let !op = OutPoint txid idx
+ !val = txout_value out
+ !resolution = case txout_type out of
+ OutputToLocal ->
+ SpendToLocal delay revpk delayedpk
+ OutputToRemote ->
+ Resolved
+ OutputLocalAnchor ->
+ AnchorSpend (ck_local_funding keys)
+ OutputRemoteAnchor ->
+ Resolved
+ OutputOfferedHTLC _expiry ->
+ case findHTLC HTLCOffered
+ (txout_script out) keys features htlcs of
+ Just htlc ->
+ SpendHTLCTimeout htlc keys features
+ Nothing -> Resolved
+ OutputReceivedHTLC _expiry ->
+ case findHTLC HTLCReceived
+ (txout_script out) keys features htlcs of
+ Just htlc ->
+ SpendHTLCSuccess htlc keys features
+ Nothing -> Resolved
+ in UnresolvedOutput op val resolution
+
+-- | Classify outputs of the remote commitment transaction.
+--
+-- Per BOLT #5: when we discover the remote commitment on chain,
+-- there are no CSV delays on our outputs. We can spend offered
+-- HTLCs directly after timeout, and received HTLCs directly
+-- with the preimage.
+classify_remote_commit_outputs
+ :: CommitmentTx
+ -- ^ The remote commitment transaction.
+ -> CommitmentKeys
+ -- ^ Derived keys for this commitment (from remote's
+ -- perspective, so local/remote are swapped).
+ -> ChannelFeatures
+ -- ^ Channel feature flags.
+ -> [HTLC]
+ -- ^ HTLCs in this commitment.
+ -> [UnresolvedOutput]
+classify_remote_commit_outputs !commitTx !keys
+ !features !htlcs =
+ let !txid = commitment_txid commitTx
+ !outputs = ctx_outputs commitTx
+ in zipWith (classifyRemoteOutput txid features keys htlcs)
+ [0..] outputs
+
+-- | Classify a single output from a remote commitment tx.
+classifyRemoteOutput
+ :: TxId
+ -> ChannelFeatures
+ -> CommitmentKeys
+ -> [HTLC]
+ -> Word32
+ -> TxOutput
+ -> UnresolvedOutput
+classifyRemoteOutput !txid !features !keys
+ !htlcs !idx !out =
+ let !op = OutPoint txid idx
+ !val = txout_value out
+ !resolution = case txout_type out of
+ OutputToLocal ->
+ Resolved -- Remote's to_local; not ours
+ OutputToRemote ->
+ Resolved -- Our to_remote; resolved by commitment
+ OutputLocalAnchor ->
+ Resolved -- Remote's anchor
+ OutputRemoteAnchor ->
+ AnchorSpend (ck_remote_funding keys)
+ OutputOfferedHTLC _expiry ->
+ -- On remote's commit, their offered = our received.
+ -- We can claim with preimage.
+ case findHTLC HTLCOffered
+ (txout_script out) keys features htlcs of
+ Just htlc ->
+ SpendHTLCPreimageDirect htlc
+ Nothing -> Resolved
+ OutputReceivedHTLC _expiry ->
+ -- On remote's commit, their received = our offered.
+ -- We can claim after timeout.
+ case findHTLC HTLCReceived
+ (txout_script out) keys features htlcs of
+ Just htlc ->
+ SpendHTLCTimeoutDirect htlc
+ Nothing -> Resolved
+ in UnresolvedOutput op val resolution
+
+-- | Classify outputs of a revoked commitment transaction.
+--
+-- Per BOLT #5: when we discover a revoked commitment, we can
+-- claim everything using the revocation key. to_local is spent
+-- via revocation, HTLCs are spent via revocation, and we can
+-- also optionally sweep to_remote.
+classify_revoked_commit_outputs
+ :: CommitmentTx
+ -- ^ The revoked commitment transaction.
+ -> CommitmentKeys
+ -- ^ Derived keys for the revoked commitment.
+ -> RevocationPubkey
+ -- ^ Revocation pubkey (derived from the revealed secret).
+ -> ChannelFeatures
+ -- ^ Channel feature flags.
+ -> [HTLC]
+ -- ^ HTLCs in the revoked commitment.
+ -> [UnresolvedOutput]
+classify_revoked_commit_outputs !commitTx !_keys
+ !revpk !_features !_htlcs =
+ let !txid = commitment_txid commitTx
+ !outputs = ctx_outputs commitTx
+ in zipWith (classifyRevokedOutput txid revpk)
+ [0..] outputs
+
+-- | Classify a single output from a revoked commitment tx.
+classifyRevokedOutput
+ :: TxId
+ -> RevocationPubkey
+ -> Word32
+ -> TxOutput
+ -> UnresolvedOutput
+classifyRevokedOutput !txid !revpk !idx !out =
+ let !op = OutPoint txid idx
+ !val = txout_value out
+ !resolution = case txout_type out of
+ OutputToLocal ->
+ Revoke revpk
+ OutputToRemote ->
+ Resolved -- Our funds; resolved by commitment
+ OutputLocalAnchor ->
+ Resolved -- Can be swept by anyone after 16 blocks
+ OutputRemoteAnchor ->
+ Resolved -- Our anchor
+ otype@(OutputOfferedHTLC _) ->
+ RevokeHTLC revpk otype
+ otype@(OutputReceivedHTLC _) ->
+ RevokeHTLC revpk otype
+ in UnresolvedOutput op val resolution
+
+-- preimage extraction ------------------------------------------------
+
+-- | Extract a payment preimage from an offered HTLC witness.
+--
+-- When the remote party claims an offered HTLC on our local
+-- commitment, the witness contains the preimage. The witness
+-- stack for a preimage claim is:
+--
+-- @\<remotehtlcsig\> \<payment_preimage\>@
+--
+-- The preimage is the second item (32 bytes) and must hash to
+-- the expected payment hash.
+extract_preimage_offered :: Witness -> Maybe PaymentPreimage
+extract_preimage_offered (Witness items) =
+ case items of
+ [_sig, preimageBytes]
+ | BS.length preimageBytes == 32 ->
+ payment_preimage preimageBytes
+ _ -> Nothing
+
+-- | Extract a payment preimage from an HTLC-success transaction
+-- witness.
+--
+-- When the remote party uses an HTLC-success tx on their
+-- commitment to claim a received HTLC, the witness contains the
+-- preimage. The witness stack is:
+--
+-- @0 \<remotehtlcsig\> \<localhtlcsig\> \<payment_preimage\>@
+--
+-- The preimage is the fourth item (32 bytes).
+extract_preimage_htlc_success
+ :: Witness -> Maybe PaymentPreimage
+extract_preimage_htlc_success (Witness items) =
+ case items of
+ [_zero, _remoteSig, _localSig, preimageBytes]
+ | BS.length preimageBytes == 32 ->
+ payment_preimage preimageBytes
+ _ -> Nothing
+
+-- timeout check ------------------------------------------------------
+
+-- | Check if an HTLC has timed out at the given block height.
+--
+-- An HTLC has timed out when the current block height is equal
+-- to or greater than the HTLC's CLTV expiry.
+htlc_timed_out :: Word32 -> HTLC -> Bool
+htlc_timed_out !currentHeight !htlc =
+ currentHeight >= unCltvExpiry (htlc_cltv_expiry htlc)
+{-# INLINE htlc_timed_out #-}
+
+-- internal helpers ---------------------------------------------------
+
+-- | Compute the txid of a commitment transaction.
+commitment_txid :: CommitmentTx -> TxId
+commitment_txid !tx =
+ let !bytes = encode_tx_for_signing tx
+ !hash1 = SHA256.hash bytes
+ !hash2 = SHA256.hash hash1
+ in case mkTxId hash2 of
+ Just tid -> tid
+ Nothing -> error "commitment_txid: impossible"
+
+-- | Find an HTLC matching a given script in the output list.
+findHTLC
+ :: HTLCDirection
+ -> Script
+ -> CommitmentKeys
+ -> ChannelFeatures
+ -> [HTLC]
+ -> Maybe HTLC
+findHTLC !dir !targetScript !keys !features =
+ go
+ where
+ go [] = Nothing
+ go (htlc:rest)
+ | htlc_direction htlc == dir
+ , htlcScript htlc == targetScript = Just htlc
+ | otherwise = go rest
+
+ htlcScript htlc = case dir of
+ HTLCOffered ->
+ to_p2wsh $ offered_htlc_script
+ (ck_revocation_pubkey keys)
+ (ck_remote_htlc keys)
+ (ck_local_htlc keys)
+ (htlc_payment_hash htlc)
+ features
+ HTLCReceived ->
+ to_p2wsh $ received_htlc_script
+ (ck_revocation_pubkey keys)
+ (ck_remote_htlc keys)
+ (ck_local_htlc keys)
+ (htlc_payment_hash htlc)
+ (htlc_cltv_expiry htlc)
+ features
diff --git a/lib/Lightning/Protocol/BOLT5/Spend.hs b/lib/Lightning/Protocol/BOLT5/Spend.hs
@@ -0,0 +1,513 @@
+{-# OPTIONS_HADDOCK prune #-}
+{-# LANGUAGE BangPatterns #-}
+
+-- |
+-- Module: Lightning.Protocol.BOLT5.Spend
+-- Copyright: (c) 2025 Jared Tobin
+-- License: MIT
+-- Maintainer: Jared Tobin <jared@ppad.tech>
+--
+-- Spending transaction construction for BOLT #5 on-chain
+-- transaction handling.
+--
+-- All functions produce unsigned 'SpendingTx' values. The caller
+-- is responsible for signing (using the sighash metadata
+-- provided) and assembling final witnesses via bolt3 witness
+-- constructors.
+
+module Lightning.Protocol.BOLT5.Spend (
+ -- * Local commitment spends
+ spend_to_local
+ , spend_htlc_timeout
+ , spend_htlc_success
+ , spend_htlc_output
+
+ -- * Remote commitment spends
+ , spend_remote_htlc_timeout
+ , spend_remote_htlc_preimage
+
+ -- * Revoked commitment spends
+ , spend_revoked_to_local
+ , spend_revoked_htlc
+ , spend_revoked_htlc_output
+ , spend_revoked_batch
+
+ -- * Anchor spends
+ , spend_anchor_owner
+ , spend_anchor_anyone
+ ) where
+
+import Bitcoin.Prim.Tx (Tx(..), TxIn(..), TxOut(..))
+import Bitcoin.Prim.Tx.Sighash (SighashType(..))
+import Data.List.NonEmpty (NonEmpty(..))
+import Data.Word (Word32)
+import qualified Data.ByteString as BS
+import Lightning.Protocol.BOLT3 hiding
+ (txout_value, txout_script)
+import Lightning.Protocol.BOLT5.Types
+
+-- local commitment spends --------------------------------------------
+
+-- | Spend the to_local output of our local commitment tx.
+--
+-- Requires waiting for the CSV delay (to_self_delay) before
+-- broadcasting. The caller signs with the local delayed privkey
+-- and uses 'to_local_witness_spend' from bolt3.
+--
+-- The input nSequence is set to the to_self_delay value.
+spend_to_local
+ :: OutPoint
+ -- ^ Outpoint of the to_local output.
+ -> Satoshi
+ -- ^ Value of the to_local output.
+ -> RevocationPubkey
+ -> ToSelfDelay
+ -> LocalDelayedPubkey
+ -> Script
+ -- ^ Destination scriptPubKey.
+ -> FeeratePerKw
+ -> SpendingTx
+spend_to_local !op !value !revpk !delay !delayedpk
+ !destScript !feerate =
+ let !witnessScript =
+ to_local_script revpk delay delayedpk
+ !weight = to_local_penalty_input_weight
+ + penalty_tx_base_weight
+ !fee = spending_fee feerate weight
+ !outputValue =
+ Satoshi (unSatoshi value - unSatoshi fee)
+ !tx = mk_spending_tx op
+ (fromIntegral (unToSelfDelay delay))
+ destScript outputValue 0
+ in SpendingTx tx witnessScript value SIGHASH_ALL
+
+-- | Construct an HTLC-timeout second-stage transaction.
+--
+-- Used when we offered an HTLC on our local commitment and it
+-- has timed out. The bolt3 'build_htlc_timeout_tx' function
+-- constructs the HTLC-timeout tx; this wraps it as a
+-- 'SpendingTx' with the witness script and sighash metadata.
+spend_htlc_timeout
+ :: HTLCContext
+ -> CommitmentKeys
+ -- ^ Full commitment keys (needed for witness script).
+ -> SpendingTx
+spend_htlc_timeout !ctx !keys =
+ let !htlcTx = build_htlc_timeout_tx ctx
+ !htlc = hc_htlc ctx
+ !features = hc_features ctx
+ !witnessScript = offered_htlc_script
+ (ck_revocation_pubkey keys)
+ (ck_remote_htlc keys)
+ (ck_local_htlc keys)
+ (htlc_payment_hash htlc)
+ features
+ !inputValue =
+ msat_to_sat (htlc_amount_msat htlc)
+ !sighashType = if has_anchors features
+ then SIGHASH_SINGLE_ANYONECANPAY
+ else SIGHASH_ALL
+ !tx = htlc_tx_to_tx htlcTx
+ in SpendingTx tx witnessScript inputValue sighashType
+
+-- | Construct an HTLC-success second-stage transaction.
+--
+-- Used when we received an HTLC on our local commitment and
+-- have the preimage. The bolt3 'build_htlc_success_tx' function
+-- constructs the HTLC-success tx; this wraps it as a
+-- 'SpendingTx'.
+spend_htlc_success
+ :: HTLCContext
+ -> CommitmentKeys
+ -- ^ Full commitment keys (needed for witness script).
+ -> SpendingTx
+spend_htlc_success !ctx !keys =
+ let !htlcTx = build_htlc_success_tx ctx
+ !htlc = hc_htlc ctx
+ !features = hc_features ctx
+ !witnessScript = received_htlc_script
+ (ck_revocation_pubkey keys)
+ (ck_remote_htlc keys)
+ (ck_local_htlc keys)
+ (htlc_payment_hash htlc)
+ (htlc_cltv_expiry htlc)
+ features
+ !inputValue =
+ msat_to_sat (htlc_amount_msat htlc)
+ !sighashType = if has_anchors features
+ then SIGHASH_SINGLE_ANYONECANPAY
+ else SIGHASH_ALL
+ !tx = htlc_tx_to_tx htlcTx
+ in SpendingTx tx witnessScript inputValue sighashType
+
+-- | Spend a second-stage HTLC output (HTLC-timeout or
+-- HTLC-success output) after the CSV delay.
+--
+-- The output of an HTLC-timeout or HTLC-success tx uses the
+-- same to_local script. The caller signs with the local
+-- delayed privkey and uses 'htlc_output_witness_spend'.
+spend_htlc_output
+ :: OutPoint
+ -- ^ Outpoint of the second-stage output.
+ -> Satoshi
+ -- ^ Value of the second-stage output.
+ -> RevocationPubkey
+ -> ToSelfDelay
+ -> LocalDelayedPubkey
+ -> Script
+ -- ^ Destination scriptPubKey.
+ -> FeeratePerKw
+ -> SpendingTx
+spend_htlc_output = spend_to_local
+
+-- remote commitment spends -------------------------------------------
+
+-- | Spend an offered HTLC directly after timeout on the remote
+-- commitment.
+--
+-- On the remote commitment, their received HTLCs (our offered)
+-- have timed out and we can sweep them directly.
+spend_remote_htlc_timeout
+ :: OutPoint
+ -- ^ Outpoint of the HTLC output.
+ -> Satoshi
+ -- ^ Value of the HTLC output.
+ -> HTLC
+ -- ^ The HTLC being spent.
+ -> CommitmentKeys
+ -- ^ Keys for the remote commitment.
+ -> ChannelFeatures
+ -> Script
+ -- ^ Destination scriptPubKey.
+ -> FeeratePerKw
+ -> SpendingTx
+spend_remote_htlc_timeout !op !value !htlc !keys
+ !features !destScript !feerate =
+ let !witnessScript = received_htlc_script
+ (ck_revocation_pubkey keys)
+ (ck_remote_htlc keys)
+ (ck_local_htlc keys)
+ (htlc_payment_hash htlc)
+ (htlc_cltv_expiry htlc)
+ features
+ !weight = accepted_htlc_penalty_input_weight
+ + penalty_tx_base_weight
+ !fee = spending_fee feerate weight
+ !outputValue =
+ Satoshi (unSatoshi value - unSatoshi fee)
+ !locktime =
+ unCltvExpiry (htlc_cltv_expiry htlc)
+ !seqNo = if has_anchors features then 1 else 0
+ !tx = mk_spending_tx op seqNo destScript
+ outputValue locktime
+ in SpendingTx tx witnessScript value SIGHASH_ALL
+
+-- | Spend a received HTLC directly with preimage on the remote
+-- commitment.
+--
+-- On the remote commitment, their offered HTLCs (our received)
+-- can be claimed with the payment preimage.
+spend_remote_htlc_preimage
+ :: OutPoint
+ -- ^ Outpoint of the HTLC output.
+ -> Satoshi
+ -- ^ Value of the HTLC output.
+ -> HTLC
+ -- ^ The HTLC being spent.
+ -> CommitmentKeys
+ -- ^ Keys for the remote commitment.
+ -> ChannelFeatures
+ -> Script
+ -- ^ Destination scriptPubKey.
+ -> FeeratePerKw
+ -> SpendingTx
+spend_remote_htlc_preimage !op !value !htlc !keys
+ !features !destScript !feerate =
+ let !witnessScript = offered_htlc_script
+ (ck_revocation_pubkey keys)
+ (ck_remote_htlc keys)
+ (ck_local_htlc keys)
+ (htlc_payment_hash htlc)
+ features
+ !weight = offered_htlc_penalty_input_weight
+ + penalty_tx_base_weight
+ !fee = spending_fee feerate weight
+ !outputValue =
+ Satoshi (unSatoshi value - unSatoshi fee)
+ !seqNo = if has_anchors features then 1 else 0
+ !tx = mk_spending_tx op seqNo destScript
+ outputValue 0
+ in SpendingTx tx witnessScript value SIGHASH_ALL
+
+-- revoked commitment spends ------------------------------------------
+
+-- | Spend a revoked to_local output using the revocation key.
+--
+-- The caller signs with the revocation privkey and uses
+-- 'to_local_witness_revoke' from bolt3.
+spend_revoked_to_local
+ :: OutPoint
+ -- ^ Outpoint of the to_local output.
+ -> Satoshi
+ -- ^ Value of the to_local output.
+ -> RevocationPubkey
+ -> ToSelfDelay
+ -> LocalDelayedPubkey
+ -> Script
+ -- ^ Destination scriptPubKey.
+ -> FeeratePerKw
+ -> SpendingTx
+spend_revoked_to_local !op !value !revpk !delay
+ !delayedpk !destScript !feerate =
+ let !witnessScript =
+ to_local_script revpk delay delayedpk
+ !weight = to_local_penalty_input_weight
+ + penalty_tx_base_weight
+ !fee = spending_fee feerate weight
+ !outputValue =
+ Satoshi (unSatoshi value - unSatoshi fee)
+ !tx = mk_spending_tx op 0xFFFFFFFF destScript
+ outputValue 0
+ in SpendingTx tx witnessScript value SIGHASH_ALL
+
+-- | Spend a revoked HTLC output using the revocation key.
+--
+-- The caller signs with the revocation privkey and uses
+-- 'offered_htlc_witness_revoke' or
+-- 'received_htlc_witness_revoke' from bolt3, depending on
+-- the output type.
+spend_revoked_htlc
+ :: OutPoint
+ -- ^ Outpoint of the HTLC output.
+ -> Satoshi
+ -- ^ Value of the HTLC output.
+ -> OutputType
+ -- ^ Whether offered or received HTLC.
+ -> RevocationPubkey
+ -> CommitmentKeys
+ -> ChannelFeatures
+ -> PaymentHash
+ -> Script
+ -- ^ Destination scriptPubKey.
+ -> FeeratePerKw
+ -> SpendingTx
+spend_revoked_htlc !op !value !otype !revpk !keys
+ !features !ph !destScript !feerate =
+ let !(witnessScript, inputWeight) = case otype of
+ OutputOfferedHTLC _ ->
+ ( offered_htlc_script
+ revpk
+ (ck_remote_htlc keys)
+ (ck_local_htlc keys)
+ ph
+ features
+ , offered_htlc_penalty_input_weight
+ )
+ OutputReceivedHTLC expiry ->
+ ( received_htlc_script
+ revpk
+ (ck_remote_htlc keys)
+ (ck_local_htlc keys)
+ ph
+ expiry
+ features
+ , accepted_htlc_penalty_input_weight
+ )
+ _ ->
+ ( Script BS.empty
+ , 0
+ )
+ !weight = inputWeight + penalty_tx_base_weight
+ !fee = spending_fee feerate weight
+ !outputValue =
+ Satoshi (unSatoshi value - unSatoshi fee)
+ !tx = mk_spending_tx op 0xFFFFFFFF destScript
+ outputValue 0
+ in SpendingTx tx witnessScript value SIGHASH_ALL
+
+-- | Spend a revoked second-stage HTLC output (HTLC-timeout or
+-- HTLC-success output) using the revocation key.
+--
+-- The output of a revoked HTLC-timeout/success tx uses the
+-- to_local script. The caller signs with the revocation privkey
+-- and uses 'htlc_output_witness_revoke'.
+spend_revoked_htlc_output
+ :: OutPoint
+ -- ^ Outpoint of the second-stage output.
+ -> Satoshi
+ -- ^ Value of the second-stage output.
+ -> RevocationPubkey
+ -> ToSelfDelay
+ -> LocalDelayedPubkey
+ -> Script
+ -- ^ Destination scriptPubKey.
+ -> FeeratePerKw
+ -> SpendingTx
+spend_revoked_htlc_output !op !value !revpk !delay
+ !delayedpk !destScript !feerate =
+ let !witnessScript =
+ to_local_script revpk delay delayedpk
+ !weight = to_local_penalty_input_weight
+ + penalty_tx_base_weight
+ !fee = spending_fee feerate weight
+ !outputValue =
+ Satoshi (unSatoshi value - unSatoshi fee)
+ !tx = mk_spending_tx op 0xFFFFFFFF destScript
+ outputValue 0
+ in SpendingTx tx witnessScript value SIGHASH_ALL
+
+-- | Construct a batched penalty transaction spending multiple
+-- revoked outputs.
+--
+-- Per BOLT #5, up to 483 bidirectional HTLCs plus to_local can
+-- be resolved in a single penalty transaction (within the
+-- 400,000 weight limit). The caller signs each input with the
+-- revocation privkey.
+spend_revoked_batch :: PenaltyContext -> SpendingTx
+spend_revoked_batch !ctx =
+ let !outs = pc_outputs ctx
+ !destScript = pc_destination ctx
+ !feerate = pc_feerate ctx
+
+ -- Calculate total input value and weight
+ !(totalValue, totalWeight) =
+ go (Satoshi 0) penalty_tx_base_weight outs
+
+ !fee = spending_fee feerate totalWeight
+ !outputValue =
+ Satoshi (unSatoshi totalValue - unSatoshi fee)
+
+ -- Build inputs
+ !inputs = map mkPenaltyInput outs
+ !txInputs = case inputs of
+ [] -> error
+ "spend_revoked_batch: no outputs"
+ (i:is) -> i :| is
+
+ -- Single output
+ !txOutput = TxOut
+ (unSatoshi outputValue)
+ (unScript destScript)
+
+ !tx = Tx
+ { tx_version = 2
+ , tx_inputs = txInputs
+ , tx_outputs = txOutput :| []
+ , tx_witnesses = []
+ , tx_locktime = 0
+ }
+
+ !witnessScript = Script BS.empty
+ in SpendingTx tx witnessScript totalValue SIGHASH_ALL
+ where
+ go !totalVal !totalWt [] = (totalVal, totalWt)
+ go !totalVal !totalWt (uo:rest) =
+ let !w = case uo_type uo of
+ Revoke _ ->
+ to_local_penalty_input_weight
+ RevokeHTLC _ (OutputOfferedHTLC _) ->
+ offered_htlc_penalty_input_weight
+ RevokeHTLC _ (OutputReceivedHTLC _) ->
+ accepted_htlc_penalty_input_weight
+ _ -> 0
+ !v = Satoshi
+ (unSatoshi totalVal + unSatoshi (uo_value uo))
+ in go v (totalWt + w) rest
+
+ mkPenaltyInput !uo =
+ TxIn
+ { txin_prevout = uo_outpoint uo
+ , txin_script_sig = BS.empty
+ , txin_sequence = 0xFFFFFFFF
+ }
+
+-- anchor spends ------------------------------------------------------
+
+-- | Spend an anchor output as the owner (immediately).
+--
+-- The caller signs with the funding privkey and uses
+-- 'anchor_witness_owner' from bolt3.
+spend_anchor_owner
+ :: OutPoint
+ -- ^ Outpoint of the anchor output.
+ -> Satoshi
+ -- ^ Value of the anchor output (330 sats).
+ -> FundingPubkey
+ -> Script
+ -- ^ Destination scriptPubKey.
+ -> SpendingTx
+spend_anchor_owner !op !value !fundpk !destScript =
+ let !witnessScript = anchor_script fundpk
+ !tx = mk_spending_tx op 0xFFFFFFFE destScript
+ value 0
+ in SpendingTx tx witnessScript value SIGHASH_ALL
+
+-- | Spend an anchor output as anyone (after 16 blocks).
+--
+-- Uses 'anchor_witness_anyone' from bolt3 (empty signature).
+spend_anchor_anyone
+ :: OutPoint
+ -- ^ Outpoint of the anchor output.
+ -> Satoshi
+ -- ^ Value of the anchor output (330 sats).
+ -> FundingPubkey
+ -> Script
+ -- ^ Destination scriptPubKey.
+ -> SpendingTx
+spend_anchor_anyone !op !value !fundpk !destScript =
+ let !witnessScript = anchor_script fundpk
+ !tx = mk_spending_tx op 16 destScript value 0
+ in SpendingTx tx witnessScript value SIGHASH_ALL
+
+-- internal helpers ---------------------------------------------------
+
+-- | Build a simple single-input single-output spending tx.
+mk_spending_tx
+ :: OutPoint -- ^ Input outpoint
+ -> Word32 -- ^ Input nSequence
+ -> Script -- ^ Output scriptPubKey
+ -> Satoshi -- ^ Output value
+ -> Word32 -- ^ Locktime
+ -> Tx
+mk_spending_tx !op !seqNo !destScript !outputValue
+ !locktime =
+ let !txIn = TxIn
+ { txin_prevout = op
+ , txin_script_sig = BS.empty
+ , txin_sequence = seqNo
+ }
+ !txOut = TxOut
+ { txout_value = unSatoshi outputValue
+ , txout_script_pubkey = unScript destScript
+ }
+ in Tx
+ { tx_version = 2
+ , tx_inputs = txIn :| []
+ , tx_outputs = txOut :| []
+ , tx_witnesses = []
+ , tx_locktime = locktime
+ }
+
+-- | Convert a bolt3 HTLCTx to a ppad-tx Tx.
+htlc_tx_to_tx :: HTLCTx -> Tx
+htlc_tx_to_tx !htx =
+ let !txIn = TxIn
+ { txin_prevout = htx_input_outpoint htx
+ , txin_script_sig = BS.empty
+ , txin_sequence =
+ unSequence (htx_input_sequence htx)
+ }
+ !txOut = TxOut
+ { txout_value =
+ unSatoshi (htx_output_value htx)
+ , txout_script_pubkey =
+ unScript (htx_output_script htx)
+ }
+ in Tx
+ { tx_version = htx_version htx
+ , tx_inputs = txIn :| []
+ , tx_outputs = txOut :| []
+ , tx_witnesses = []
+ , tx_locktime =
+ unLocktime (htx_locktime htx)
+ }
diff --git a/lib/Lightning/Protocol/BOLT5/Types.hs b/lib/Lightning/Protocol/BOLT5/Types.hs
@@ -0,0 +1,194 @@
+{-# OPTIONS_HADDOCK prune #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveGeneric #-}
+
+-- |
+-- Module: Lightning.Protocol.BOLT5.Types
+-- Copyright: (c) 2025 Jared Tobin
+-- License: MIT
+-- Maintainer: Jared Tobin <jared@ppad.tech>
+--
+-- Types for BOLT #5 on-chain transaction handling.
+
+module Lightning.Protocol.BOLT5.Types (
+ -- * Close identification
+ CloseType(..)
+
+ -- * Output classification
+ , UnresolvedOutput(..)
+ , OutputResolution(..)
+
+ -- * Spending transactions
+ , SpendingTx(..)
+
+ -- * Penalty batching
+ , PenaltyContext(..)
+
+ -- * Weight constants (Appendix A)
+ , to_local_penalty_witness_weight
+ , offered_htlc_penalty_witness_weight
+ , accepted_htlc_penalty_witness_weight
+ , to_local_penalty_input_weight
+ , offered_htlc_penalty_input_weight
+ , accepted_htlc_penalty_input_weight
+ , to_remote_input_weight
+ , penalty_tx_base_weight
+ , max_standard_weight
+
+ -- * Fee calculation
+ , spending_fee
+ ) where
+
+import Bitcoin.Prim.Tx (Tx(..))
+import Bitcoin.Prim.Tx.Sighash (SighashType(..))
+import Data.Word (Word64)
+import GHC.Generics (Generic)
+import Lightning.Protocol.BOLT3.Types
+import Lightning.Protocol.BOLT3.Tx (
+ CommitmentKeys(..)
+ , OutputType(..)
+ )
+
+-- close identification -----------------------------------------------
+
+-- | What kind of close was detected on chain.
+data CloseType
+ = MutualClose
+ -- ^ Cooperative closure agreed by both parties.
+ | LocalCommitClose
+ -- ^ Our commitment transaction was broadcast.
+ | RemoteCommitClose
+ -- ^ The remote party's commitment transaction was broadcast.
+ | RevokedCommitClose
+ -- ^ A revoked (outdated) commitment transaction was broadcast.
+ deriving (Eq, Show, Generic)
+
+-- output classification ----------------------------------------------
+
+-- | An unresolved commitment transaction output.
+data UnresolvedOutput = UnresolvedOutput
+ { uo_outpoint :: !OutPoint
+ , uo_value :: {-# UNPACK #-} !Satoshi
+ , uo_type :: !OutputResolution
+ } deriving (Eq, Show, Generic)
+
+-- | How to resolve an output, per BOLT #5 rules.
+data OutputResolution
+ = Resolved
+ -- ^ Already resolved (e.g. to_remote on local commit).
+ | SpendToLocal
+ !ToSelfDelay !RevocationPubkey !LocalDelayedPubkey
+ -- ^ Spend to_local after CSV delay.
+ | SpendHTLCTimeout
+ !HTLC !CommitmentKeys !ChannelFeatures
+ -- ^ Spend via HTLC-timeout second-stage tx (local commit,
+ -- local offer).
+ | SpendHTLCSuccess
+ !HTLC !CommitmentKeys !ChannelFeatures
+ -- ^ Spend via HTLC-success second-stage tx (local commit,
+ -- remote offer).
+ | SpendHTLCTimeoutDirect !HTLC
+ -- ^ Spend HTLC directly after timeout (remote commit,
+ -- local offer).
+ | SpendHTLCPreimageDirect !HTLC
+ -- ^ Spend HTLC directly with preimage (remote commit,
+ -- remote offer).
+ | SpendSecondStage
+ !ToSelfDelay !RevocationPubkey !LocalDelayedPubkey
+ -- ^ Spend second-stage HTLC output after CSV delay.
+ | Revoke !RevocationPubkey
+ -- ^ Spend revoked to_local with revocation key.
+ | RevokeHTLC !RevocationPubkey !OutputType
+ -- ^ Spend revoked HTLC output with revocation key.
+ | AnchorSpend !FundingPubkey
+ -- ^ Spend anchor output.
+ deriving (Eq, Show, Generic)
+
+-- spending transactions ----------------------------------------------
+
+-- | Unsigned spending transaction, ready for caller to sign.
+--
+-- The caller uses bolt3 witness constructors to assemble the
+-- final witness after signing.
+data SpendingTx = SpendingTx
+ { stx_tx :: !Tx
+ -- ^ The unsigned transaction.
+ , stx_input_script :: !Script
+ -- ^ Witness script for the input being spent.
+ , stx_input_value :: {-# UNPACK #-} !Satoshi
+ -- ^ Value of the input being spent (for sighash).
+ , stx_sighash_type :: !SighashType
+ -- ^ Sighash type to use when signing.
+ } deriving (Eq, Show, Generic)
+
+-- penalty batching ---------------------------------------------------
+
+-- | Context for constructing batched penalty transactions.
+data PenaltyContext = PenaltyContext
+ { pc_outputs :: ![UnresolvedOutput]
+ -- ^ Revoked outputs to sweep.
+ , pc_revocation_key :: !RevocationPubkey
+ -- ^ Revocation pubkey for all outputs.
+ , pc_destination :: !Script
+ -- ^ Destination scriptPubKey.
+ , pc_feerate :: !FeeratePerKw
+ -- ^ Fee rate for the penalty transaction.
+ } deriving (Eq, Show, Generic)
+
+-- weight constants (BOLT #5 Appendix A) ------------------------------
+
+-- | Expected weight of the to_local penalty transaction witness
+-- (160 bytes).
+to_local_penalty_witness_weight :: Word64
+to_local_penalty_witness_weight = 160
+
+-- | Expected weight of the offered_htlc penalty transaction
+-- witness (243 bytes).
+offered_htlc_penalty_witness_weight :: Word64
+offered_htlc_penalty_witness_weight = 243
+
+-- | Expected weight of the accepted_htlc penalty transaction
+-- witness (249 bytes).
+accepted_htlc_penalty_witness_weight :: Word64
+accepted_htlc_penalty_witness_weight = 249
+
+-- | Weight of a to_local penalty input (164 + 160 = 324 bytes).
+to_local_penalty_input_weight :: Word64
+to_local_penalty_input_weight = 324
+
+-- | Weight of an offered_htlc penalty input
+-- (164 + 243 = 407 bytes).
+offered_htlc_penalty_input_weight :: Word64
+offered_htlc_penalty_input_weight = 407
+
+-- | Weight of an accepted_htlc penalty input
+-- (164 + 249 = 413 bytes).
+accepted_htlc_penalty_input_weight :: Word64
+accepted_htlc_penalty_input_weight = 413
+
+-- | Weight of a to_remote P2WPKH input
+-- (108 + 164 = 272 bytes).
+to_remote_input_weight :: Word64
+to_remote_input_weight = 272
+
+-- | Base weight of a penalty transaction (4*53 + 2 = 214 bytes).
+--
+-- Non-witness: version(4) + input_count(1) + output_count(1) +
+-- value(8) + script_len(1) + p2wsh_script(34) + locktime(4) = 53
+-- Witness header: 2 bytes.
+penalty_tx_base_weight :: Word64
+penalty_tx_base_weight = 214
+
+-- | Maximum standard transaction weight (400,000 bytes).
+max_standard_weight :: Word64
+max_standard_weight = 400000
+
+-- fee calculation ----------------------------------------------------
+
+-- | Calculate the fee for a spending transaction given its weight.
+--
+-- @fee = feerate_per_kw * weight / 1000@
+spending_fee :: FeeratePerKw -> Word64 -> Satoshi
+spending_fee (FeeratePerKw !rate) !weight =
+ Satoshi ((fromIntegral rate * weight) `div` 1000)
+{-# INLINE spending_fee #-}
