commit 6056ef1dbc03a5661c63d962f6ac857a27c89f88
parent be56ba50a3acba8c0ae26e333ff0a2df5c43da6a
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 10 Oct 2026 13:27:52 +0400
lib, test: match HTLC outputs on script, amount and expiry
Classification matched an HTLC output to the first HTLC with the same
direction and script. The offered HTLC script doesn't commit to the
CLTV expiry and no HTLC script commits to the amount, so HTLCs
sharing a payment hash all mapped to the first one, and
spend_htlc_timeout then built a tx with the wrong value and locktime.
An output now matches an HTLC only if direction, script, amount and
the expiry recorded for the output all agree, and a matched HTLC is
removed from the candidates, so no two outputs resolve to the same
HTLC. Each HTLC's script is now computed once rather than once per
output.
Tests use the BOLT #3 Appendix C commitment whose htlcs #5 and #6
share a payment hash and amount: classification picks the right HTLC
for each output, and the resulting HTLC-timeout and HTLC-success txs
match the vectors.
Diffstat:
2 files changed, 218 insertions(+), 71 deletions(-)
diff --git a/lib/Lightning/Protocol/BOLT5/Detect.hs b/lib/Lightning/Protocol/BOLT5/Detect.hs
@@ -29,6 +29,7 @@ module Lightning.Protocol.BOLT5.Detect (
import qualified Bitcoin.Prim.Tx as BT
import qualified Crypto.Hash.SHA256 as SHA256
+import Data.List (mapAccumL)
import Data.Word (Word32)
import qualified Data.ByteString as BS
import Lightning.Protocol.BOLT3
@@ -79,6 +80,10 @@ identify_close !localCommitTx !remoteCommitTx
-- spend, to_remote is resolved by the commitment itself, HTLC
-- outputs need second-stage transactions, and anchors can be
-- spent immediately.
+--
+-- An HTLC output is matched to the HTLC with the same direction,
+-- script, amount and CLTV expiry, and each HTLC matches at most one
+-- output.
classify_local_commit_outputs
:: CommitmentTx
-- ^ Our local commitment transaction.
@@ -99,11 +104,15 @@ classify_local_commit_outputs !commitTx !keys !delay
let !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 cands (idx, out) =
+ classifyLocalOutput txid revpk delayedpk
+ delay features keys cands idx out
+ in snd (mapAccumL classify
+ (htlc_candidates keys features htlcs)
+ (zip [0..] outputs))
--- | Classify a single output from a local commitment tx.
+-- | Classify a single output from a local commitment tx, removing
+-- any matched HTLC from the candidates.
classifyLocalOutput
:: TxId
-> RevocationPubkey
@@ -111,36 +120,34 @@ classifyLocalOutput
-> ToSelfDelay
-> ChannelFeatures
-> CommitmentKeys
- -> [HTLC]
+ -> [(HTLC, Script)]
-> Word32
-> TxOutput
- -> UnresolvedOutput
+ -> ([(HTLC, Script)], UnresolvedOutput)
classifyLocalOutput !txid !revpk !delayedpk !delay
- !features !keys !htlcs !idx !out =
+ !features !keys !cands !idx !out =
let !op = OutPoint txid idx
!val = txout_value out
- !resolution = case txout_type out of
+ !(rest, resolution) = case txout_type out of
OutputToLocal ->
- SpendToLocal delay revpk delayedpk
+ (cands, SpendToLocal delay revpk delayedpk)
OutputToRemote ->
- Resolved
+ (cands, Resolved)
OutputLocalAnchor ->
- AnchorSpend (ck_local_funding keys)
+ (cands, 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
+ (cands, Resolved)
+ OutputOfferedHTLC expiry ->
+ case take_htlc HTLCOffered expiry out cands of
+ (Just htlc, cands') ->
+ (cands', SpendHTLCTimeout htlc keys features)
+ (Nothing, cands') -> (cands', Resolved)
+ OutputReceivedHTLC expiry ->
+ case take_htlc HTLCReceived expiry out cands of
+ (Just htlc, cands') ->
+ (cands', SpendHTLCSuccess htlc keys features)
+ (Nothing, cands') -> (cands', Resolved)
+ in (rest, UnresolvedOutput op val resolution)
-- | Classify outputs of the remote commitment transaction.
--
@@ -148,6 +155,8 @@ classifyLocalOutput !txid !revpk !delayedpk !delay
-- there are no CSV delays on our outputs. We can spend offered
-- HTLCs directly after timeout, and received HTLCs directly
-- with the preimage.
+--
+-- HTLC outputs are matched as in 'classify_local_commit_outputs'.
classify_remote_commit_outputs
:: CommitmentTx
-- ^ The remote commitment transaction.
@@ -165,49 +174,48 @@ classify_remote_commit_outputs !commitTx !keys
Nothing -> []
Just !txid ->
let !outputs = ctx_outputs commitTx
- in zipWith
- (classifyRemoteOutput txid features keys htlcs)
- [0..] outputs
+ classify cands (idx, out) =
+ classifyRemoteOutput txid keys cands idx out
+ in snd (mapAccumL classify
+ (htlc_candidates keys features htlcs)
+ (zip [0..] outputs))
--- | Classify a single output from a remote commitment tx.
+-- | Classify a single output from a remote commitment tx, removing
+-- any matched HTLC from the candidates.
classifyRemoteOutput
:: TxId
- -> ChannelFeatures
-> CommitmentKeys
- -> [HTLC]
+ -> [(HTLC, Script)]
-> Word32
-> TxOutput
- -> UnresolvedOutput
-classifyRemoteOutput !txid !features !keys
- !htlcs !idx !out =
+ -> ([(HTLC, Script)], UnresolvedOutput)
+classifyRemoteOutput !txid !keys !cands !idx !out =
let !op = OutPoint txid idx
!val = txout_value out
- !resolution = case txout_type out of
+ !(rest, resolution) = case txout_type out of
OutputToLocal ->
- Resolved -- Remote's to_local; not ours
+ (cands, Resolved) -- Remote's to_local; not ours
OutputToRemote ->
- Resolved -- Our to_remote; resolved by commitment
+ (cands, Resolved) -- Our to_remote; resolved by commitment
OutputLocalAnchor ->
- Resolved -- Remote's anchor
+ (cands, Resolved) -- Remote's anchor
OutputRemoteAnchor ->
- AnchorSpend (ck_remote_funding keys)
- OutputOfferedHTLC _expiry ->
+ (cands, 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 ->
+ case take_htlc HTLCOffered expiry out cands of
+ (Just htlc, cands') ->
+ (cands', SpendHTLCPreimageDirect htlc)
+ (Nothing, cands') -> (cands', 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
+ case take_htlc HTLCReceived expiry out cands of
+ (Just htlc, cands') ->
+ (cands', SpendHTLCTimeoutDirect htlc)
+ (Nothing, cands') -> (cands', Resolved)
+ in (rest, UnresolvedOutput op val resolution)
-- | Classify outputs of a revoked commitment transaction.
--
@@ -336,24 +344,15 @@ htlc_timed_out !currentHeight !htlc =
commitment_txid :: CommitmentTx -> Maybe TxId
commitment_txid !tx = fmap BT.txid (commitment_to_tx tx)
--- | Find an HTLC matching a given script in the output list.
-findHTLC
- :: HTLCDirection
- -> Script
- -> CommitmentKeys
+-- | Pair each HTLC with the P2WSH script of its commitment output.
+htlc_candidates
+ :: CommitmentKeys
-> ChannelFeatures
-> [HTLC]
- -> Maybe HTLC
-findHTLC !dir !targetScript !keys !features =
- go
+ -> [(HTLC, Script)]
+htlc_candidates !keys !features = map (\htlc -> (htlc, script htlc))
where
- go [] = Nothing
- go (htlc:rest)
- | htlc_direction htlc == dir
- , htlcScript htlc == targetScript = Just htlc
- | otherwise = go rest
-
- htlcScript htlc = case dir of
+ script htlc = case htlc_direction htlc of
HTLCOffered ->
to_p2wsh $ offered_htlc_script
(ck_revocation_pubkey keys)
@@ -369,3 +368,29 @@ findHTLC !dir !targetScript !keys !features =
(htlc_payment_hash htlc)
(htlc_cltv_expiry htlc)
features
+
+-- | Find the HTLC for an HTLC output and remove it from the
+-- candidates.
+--
+-- The HTLC must agree with the output on direction, script, amount
+-- and CLTV expiry. The offered HTLC script doesn't commit to the
+-- expiry and no HTLC script commits to the amount, so HTLCs sharing
+-- a payment hash differ only in these. Removing the match ensures
+-- no two outputs resolve to the same HTLC.
+take_htlc
+ :: HTLCDirection
+ -> CltvExpiry
+ -- ^ Expiry recorded for the output.
+ -> TxOutput
+ -> [(HTLC, Script)]
+ -> (Maybe HTLC, [(HTLC, Script)])
+take_htlc !dir !expiry !out !cands =
+ case break matches cands of
+ (pre, (htlc, _) : post) -> (Just htlc, pre ++ post)
+ (_, []) -> (Nothing, cands)
+ where
+ matches (htlc, script) =
+ htlc_direction htlc == dir
+ && htlc_cltv_expiry htlc == expiry
+ && msatToSat (htlc_amount_msat htlc) == txout_value out
+ && script == txout_script out
diff --git a/test/Main.hs b/test/Main.hs
@@ -169,9 +169,9 @@ dummyLocalCommitWithHTLCs = CommitmentTx
OutputToLocal
, TxOutput (Satoshi 30000) dummyDestScript
OutputToRemote
- , TxOutput (Satoshi 10000) offeredScript
+ , TxOutput (Satoshi 1000) offeredScript
(OutputOfferedHTLC (CltvExpiry 500000))
- , TxOutput (Satoshi 10000) receivedScript
+ , TxOutput (Satoshi 1000) receivedScript
(OutputReceivedHTLC (CltvExpiry 500000))
]
, ctx_funding_script = dummyDestScript
@@ -337,6 +337,23 @@ vecCHtlcSuccess1 =
\7bcea5afba3f3cdce23988527c21030d417a46946384f88d5f3337267c5e5797\
\65875dc4daca813e21734b140639e752ae677502f501b175ac686800000000"
+-- | Appendix C: HTLC-timeout tx for htlc #6 from the same
+-- commitment (signed).
+vecCHtlcTimeout6 :: BS.ByteString
+vecCHtlcTimeout6 =
+ "020000000001014bdccf28653066a2c554cafeffdfe1e678e64a69b056684deb\
+ \0c4fba909423ec01000000000000000001e1120000000000002200204adb4e2f\
+ \00643db396dd120d4e7dc17625f5f2c11a40d857accc862d6b7dd80e05004830\
+ \45022100b575379f6d8743cb0087648f81cfd82d17a97fbf8f67e058c65ce8b9\
+ \d25df9500220554a210d65b02d9f36c6adf0f639430ca8293196ba5089bf67cc\
+ \3a9813b7b00a01483045022100ee2e16b90930a479b13f8823a7f14b600198c8\
+ \38161160b9436ed086d3fc57e002202a66fa2324f342a17129949c640bfe934c\
+ \bc73a869ba7c06aa25c5a3d0bfb53d01008576a91414011f7254d96b819c7698\
+ \6c277d115efce6f7b58763ac67210394854aa6eab5b2a8122cc726e9dded053a\
+ \2184d88256816826d6231c068d4a5b7c820120876475527c21030d417a469463\
+ \84f88d5f3337267c5e579765875dc4daca813e21734b140639e752ae67a91420\
+ \02cc93ebefbb1b73f0af055dcc27a0b504ad7688ac6868f9010000"
+
-- | Appendix C: HTLC-timeout tx for htlc #5 from the same
-- commitment (signed).
vecCHtlcTimeout5 :: BS.ByteString
@@ -392,6 +409,38 @@ offeredClaimParts = do
[_, sig, _, _, script] -> pure (sig, script)
_ -> assertFailure "unexpected HTLC-timeout witness"
+-- | Build the HTLC tx for an HTLC output of an Appendix C/F
+-- commitment (to_self_delay 144).
+vecHtlcTx :: FeeratePerKw -> B5.UnresolvedOutput -> IO B5.SpendingTx
+vecHtlcTx feerate uo = case B5.uo_type uo of
+ B5.SpendHTLCTimeout htlc keys features ->
+ pure (B5.spend_htlc_timeout (ctx htlc keys features) keys)
+ B5.SpendHTLCSuccess htlc keys features ->
+ pure (B5.spend_htlc_success (ctx htlc keys features) keys)
+ other -> assertFailure ("expected an HTLC output, got " <> show other)
+ where
+ ctx htlc keys features = HTLCContext
+ { hc_commitment_txid = op_txid (B5.uo_outpoint uo)
+ , hc_output_index = op_vout (B5.uo_outpoint uo)
+ , hc_htlc = htlc
+ , hc_to_self_delay = ToSelfDelay 144
+ , hc_feerate = feerate
+ , hc_features = features
+ , hc_revocation_pubkey = ck_revocation_pubkey keys
+ , hc_local_delayed = ck_local_delayed keys
+ }
+
+-- | Check an HTLC tx against a signed BOLT #3 vector: the unsigned
+-- tx and the witness script must match.
+assertHtlcTx :: B5.SpendingTx -> BS.ByteString -> Assertion
+assertHtlcTx stx vec = do
+ tx <- parseTx vec
+ items <- singleWitness tx
+ B5.stx_tx stx @?= tx { tx_witnesses = [] }
+ case reverse items of
+ script : _ -> B5.stx_input_script stx @?= Script script
+ [] -> assertFailure "empty witness"
+
-- types tests --------------------------------------------------------
types_tests :: TestTree
@@ -582,10 +631,10 @@ classify_tests = testGroup "Classify" [
, ctx_outputs =
[ TxOutput (Satoshi 50000) toLocalScript
OutputToLocal
- , TxOutput (Satoshi 10000) offeredScript
+ , TxOutput (Satoshi 1000) offeredScript
(OutputOfferedHTLC
(CltvExpiry 500000))
- , TxOutput (Satoshi 10000) receivedScript
+ , TxOutput (Satoshi 1000) receivedScript
(OutputReceivedHTLC
(CltvExpiry 500000))
]
@@ -704,6 +753,79 @@ classify_tests = testGroup "Classify" [
emptyCommit dummyKeys dummyDelay
dummyFeatures []
@?= []
+
+ , testCase "classify_local - HTLCs sharing a payment hash" $ do
+ -- Appendix C: htlcs #5 and #6 share a payment hash and amount
+ -- (5000 sat) and differ only in CLTV expiry (506 and 505).
+ commit <- assertJust "commitment" vecCommitSameHash
+ keys <- assertJust "keys" vecKeys
+ let features = ChannelFeatures False
+ outs = B5.classify_local_commit_outputs commit keys
+ (ToSelfDelay 144) features
+ [vecHtlc1, vecHtlc5, vecHtlc6]
+ map B5.uo_type (take 3 outs) @?=
+ [ B5.SpendHTLCSuccess vecHtlc1 keys features
+ , B5.SpendHTLCTimeout vecHtlc6 keys features
+ , B5.SpendHTLCTimeout vecHtlc5 keys features
+ ]
+
+ , testCase "HTLC txs - Appendix C, shared payment hash" $ do
+ commit <- assertJust "commitment" vecCommitSameHash
+ keys <- assertJust "keys" vecKeys
+ let outs = B5.classify_local_commit_outputs commit keys
+ (ToSelfDelay 144) (ChannelFeatures False)
+ [vecHtlc1, vecHtlc5, vecHtlc6]
+ case outs of
+ o0 : o1 : o2 : _ -> do
+ stx0 <- vecHtlcTx (FeeratePerKw 253) o0
+ assertHtlcTx stx0 vecCHtlcSuccess1
+ stx1 <- vecHtlcTx (FeeratePerKw 253) o1
+ assertHtlcTx stx1 vecCHtlcTimeout6
+ stx2 <- vecHtlcTx (FeeratePerKw 253) o2
+ assertHtlcTx stx2 vecCHtlcTimeout5
+ _ -> assertFailure "expected at least 3 outputs"
+
+ , testCase "classify_remote - HTLCs sharing a payment hash" $ do
+ commit <- assertJust "commitment" vecCommitSameHash
+ keys <- assertJust "keys" vecKeys
+ let outs = B5.classify_remote_commit_outputs commit keys
+ (ChannelFeatures False)
+ [vecHtlc1, vecHtlc5, vecHtlc6]
+ map B5.uo_type (take 3 outs) @?=
+ [ B5.SpendHTLCTimeoutDirect vecHtlc1
+ , B5.SpendHTLCPreimageDirect vecHtlc6
+ , B5.SpendHTLCPreimageDirect vecHtlc5
+ ]
+
+ , testCase "classify_local - HTLCs differing only in amount" $ do
+ let hA = vecHtlc HTLCOffered 5000000 600 0x07
+ hB = vecHtlc HTLCOffered 9000000 600 0x07
+ features = ChannelFeatures False
+ commit <- assertJust "commitment" $ vecCommitment
+ (FeeratePerKw 253) features (MilliSatoshi 6000000000)
+ [hA, hB]
+ keys <- assertJust "keys" vecKeys
+ let outs = B5.classify_local_commit_outputs commit keys
+ (ToSelfDelay 144) features [hB, hA]
+ [ (B5.uo_value o, h)
+ | o <- outs
+ , B5.SpendHTLCTimeout h _ _ <- [B5.uo_type o] ]
+ @?= [(Satoshi 5000, hA), (Satoshi 9000, hB)]
+
+ , testCase "classify_local - each HTLC matches one output" $ do
+ let h = vecHtlc HTLCOffered 5000000 600 0x07
+ features = ChannelFeatures False
+ commit <- assertJust "commitment" $ vecCommitment
+ (FeeratePerKw 253) features (MilliSatoshi 6000000000)
+ [h, h]
+ keys <- assertJust "keys" vecKeys
+ let timeouts hs = length
+ [ ()
+ | o <- B5.classify_local_commit_outputs commit keys
+ (ToSelfDelay 144) features hs
+ , B5.SpendHTLCTimeout {} <- [B5.uo_type o] ]
+ timeouts [h] @?= 1
+ timeouts [h, h] @?= 2
]
-- spend tests --------------------------------------------------------
