Detect.hs (11376B)
1 {-# OPTIONS_HADDOCK prune #-} 2 {-# LANGUAGE BangPatterns #-} 3 4 -- | 5 -- Module: Lightning.Protocol.BOLT5.Detect 6 -- Copyright: (c) 2025 Jared Tobin 7 -- License: MIT 8 -- Maintainer: Jared Tobin <jared@ppad.tech> 9 -- 10 -- Close identification, output classification, and preimage 11 -- extraction for BOLT #5 on-chain transaction handling. 12 13 module Lightning.Protocol.BOLT5.Detect ( 14 -- * Close identification 15 identify_close 16 17 -- * Output classification 18 , classify_local_commit_outputs 19 , classify_remote_commit_outputs 20 , classify_revoked_commit_outputs 21 22 -- * Preimage extraction 23 , extract_preimage_offered 24 , extract_preimage_htlc_success 25 26 -- * Timeout check 27 , htlc_timed_out 28 ) where 29 30 import qualified Bitcoin.Prim.Tx as BT 31 import Data.Word (Word32) 32 import qualified Data.ByteString as BS 33 import Lightning.Protocol.BOLT3 34 import Lightning.Protocol.BOLT5.Types 35 36 -- close identification ----------------------------------------------- 37 38 -- | Identify the type of channel close from a transaction that 39 -- spends the funding output. 40 -- 41 -- Compares the on-chain transaction bytes against the known 42 -- local and remote commitment transaction serializations 43 -- (stripped/unsigned) to determine whether it's a local or 44 -- remote commitment close. 45 -- 46 -- Returns 'Nothing' if the transaction doesn't match either 47 -- commitment. Mutual close and revoked commitment detection 48 -- require additional checks by the caller (e.g. comparing 49 -- closing tx format, checking a secret store for older 50 -- commitment numbers). 51 identify_close 52 :: CommitmentTx 53 -- ^ Our local commitment tx. 54 -> CommitmentTx 55 -- ^ The remote commitment tx (current). 56 -> BS.ByteString 57 -- ^ Raw serialized transaction found on chain. 58 -> Maybe CloseType 59 identify_close !localCommitTx !remoteCommitTx 60 !onChainBytes = 61 let !localBytes = encode_tx_for_signing localCommitTx 62 !remoteBytes = encode_tx_for_signing remoteCommitTx 63 in if localBytes == Just onChainBytes 64 then Just LocalCommitClose 65 else if remoteBytes == Just onChainBytes 66 then Just RemoteCommitClose 67 else Nothing 68 69 -- output classification ---------------------------------------------- 70 71 -- | Classify outputs of our local commitment transaction. 72 -- 73 -- Per BOLT #5: when we discover our local commitment on chain, 74 -- we must resolve each output. to_local requires a CSV-delayed 75 -- spend, to_remote is resolved by the commitment itself, HTLC 76 -- outputs need second-stage transactions, and anchors can be 77 -- spent immediately. 78 classify_local_commit_outputs 79 :: CommitmentTx 80 -- ^ Our local commitment transaction. 81 -> CommitmentKeys 82 -- ^ Derived keys for this commitment. 83 -> ToSelfDelay 84 -- ^ Remote's to_self_delay (CSV delay for our outputs). 85 -> ChannelFeatures 86 -- ^ Channel feature flags. 87 -> [HTLC] 88 -- ^ HTLCs in this commitment. 89 -> [UnresolvedOutput] 90 classify_local_commit_outputs !commitTx !keys !delay 91 !features !htlcs = 92 case commitment_txid commitTx of 93 Nothing -> [] 94 Just !txid -> 95 let !outputs = ctx_outputs commitTx 96 !revpk = ck_revocation_pubkey keys 97 !delayedpk = ck_local_delayed keys 98 in zipWith (classifyLocalOutput txid revpk delayedpk 99 delay features keys htlcs) 100 [0..] outputs 101 102 -- | Classify a single output from a local commitment tx. 103 classifyLocalOutput 104 :: TxId 105 -> RevocationPubkey 106 -> LocalDelayedPubkey 107 -> ToSelfDelay 108 -> ChannelFeatures 109 -> CommitmentKeys 110 -> [HTLC] 111 -> Word32 112 -> TxOutput 113 -> UnresolvedOutput 114 classifyLocalOutput !txid !revpk !delayedpk !delay 115 !features !keys !htlcs !idx !out = 116 let !op = OutPoint txid idx 117 !val = txout_value out 118 !resolution = case txout_type out of 119 OutputToLocal -> 120 SpendToLocal delay revpk delayedpk 121 OutputToRemote -> 122 Resolved 123 OutputLocalAnchor -> 124 AnchorSpend (ck_local_funding keys) 125 OutputRemoteAnchor -> 126 Resolved 127 OutputOfferedHTLC _expiry -> 128 case findHTLC HTLCOffered 129 (txout_script out) keys features htlcs of 130 Just htlc -> 131 SpendHTLCTimeout htlc keys features 132 Nothing -> Resolved 133 OutputReceivedHTLC _expiry -> 134 case findHTLC HTLCReceived 135 (txout_script out) keys features htlcs of 136 Just htlc -> 137 SpendHTLCSuccess htlc keys features 138 Nothing -> Resolved 139 in UnresolvedOutput op val resolution 140 141 -- | Classify outputs of the remote commitment transaction. 142 -- 143 -- Per BOLT #5: when we discover the remote commitment on chain, 144 -- there are no CSV delays on our outputs. We can spend offered 145 -- HTLCs directly after timeout, and received HTLCs directly 146 -- with the preimage. 147 classify_remote_commit_outputs 148 :: CommitmentTx 149 -- ^ The remote commitment transaction. 150 -> CommitmentKeys 151 -- ^ Derived keys for this commitment (from remote's 152 -- perspective, so local/remote are swapped). 153 -> ChannelFeatures 154 -- ^ Channel feature flags. 155 -> [HTLC] 156 -- ^ HTLCs in this commitment. 157 -> [UnresolvedOutput] 158 classify_remote_commit_outputs !commitTx !keys 159 !features !htlcs = 160 case commitment_txid commitTx of 161 Nothing -> [] 162 Just !txid -> 163 let !outputs = ctx_outputs commitTx 164 in zipWith 165 (classifyRemoteOutput txid features keys htlcs) 166 [0..] outputs 167 168 -- | Classify a single output from a remote commitment tx. 169 classifyRemoteOutput 170 :: TxId 171 -> ChannelFeatures 172 -> CommitmentKeys 173 -> [HTLC] 174 -> Word32 175 -> TxOutput 176 -> UnresolvedOutput 177 classifyRemoteOutput !txid !features !keys 178 !htlcs !idx !out = 179 let !op = OutPoint txid idx 180 !val = txout_value out 181 !resolution = case txout_type out of 182 OutputToLocal -> 183 Resolved -- Remote's to_local; not ours 184 OutputToRemote -> 185 Resolved -- Our to_remote; resolved by commitment 186 OutputLocalAnchor -> 187 Resolved -- Remote's anchor 188 OutputRemoteAnchor -> 189 AnchorSpend (ck_remote_funding keys) 190 OutputOfferedHTLC _expiry -> 191 -- On remote's commit, their offered = our received. 192 -- We can claim with preimage. 193 case findHTLC HTLCOffered 194 (txout_script out) keys features htlcs of 195 Just htlc -> 196 SpendHTLCPreimageDirect htlc 197 Nothing -> Resolved 198 OutputReceivedHTLC _expiry -> 199 -- On remote's commit, their received = our offered. 200 -- We can claim after timeout. 201 case findHTLC HTLCReceived 202 (txout_script out) keys features htlcs of 203 Just htlc -> 204 SpendHTLCTimeoutDirect htlc 205 Nothing -> Resolved 206 in UnresolvedOutput op val resolution 207 208 -- | Classify outputs of a revoked commitment transaction. 209 -- 210 -- Per BOLT #5: when we discover a revoked commitment, we can 211 -- claim everything using the revocation key. to_local is spent 212 -- via revocation, HTLCs are spent via revocation, and we can 213 -- also optionally sweep to_remote. 214 classify_revoked_commit_outputs 215 :: CommitmentTx 216 -- ^ The revoked commitment transaction. 217 -> CommitmentKeys 218 -- ^ Derived keys for the revoked commitment. 219 -> RevocationPubkey 220 -- ^ Revocation pubkey (derived from the revealed secret). 221 -> ChannelFeatures 222 -- ^ Channel feature flags. 223 -> [HTLC] 224 -- ^ HTLCs in the revoked commitment. 225 -> [UnresolvedOutput] 226 classify_revoked_commit_outputs !commitTx !_keys 227 !revpk !_features !_htlcs = 228 case commitment_txid commitTx of 229 Nothing -> [] 230 Just !txid -> 231 let !outputs = ctx_outputs commitTx 232 in zipWith (classifyRevokedOutput txid revpk) 233 [0..] outputs 234 235 -- | Classify a single output from a revoked commitment tx. 236 classifyRevokedOutput 237 :: TxId 238 -> RevocationPubkey 239 -> Word32 240 -> TxOutput 241 -> UnresolvedOutput 242 classifyRevokedOutput !txid !revpk !idx !out = 243 let !op = OutPoint txid idx 244 !val = txout_value out 245 !resolution = case txout_type out of 246 OutputToLocal -> 247 Revoke revpk 248 OutputToRemote -> 249 Resolved -- Our funds; resolved by commitment 250 OutputLocalAnchor -> 251 Resolved -- Can be swept by anyone after 16 blocks 252 OutputRemoteAnchor -> 253 Resolved -- Our anchor 254 otype@(OutputOfferedHTLC _) -> 255 RevokeHTLC revpk otype 256 otype@(OutputReceivedHTLC _) -> 257 RevokeHTLC revpk otype 258 in UnresolvedOutput op val resolution 259 260 -- preimage extraction ------------------------------------------------ 261 262 -- | Extract a payment preimage from an offered HTLC witness. 263 -- 264 -- When the remote party claims an offered HTLC on our local 265 -- commitment, the witness contains the preimage. The witness 266 -- stack for a preimage claim is: 267 -- 268 -- @\<remotehtlcsig\> \<paymentPreimage\>@ 269 -- 270 -- The preimage is the second item (32 bytes) and must hash to 271 -- the expected payment hash. 272 extract_preimage_offered :: Witness -> Maybe PaymentPreimage 273 extract_preimage_offered (Witness items) = 274 case items of 275 [_sig, preimageBytes] 276 | BS.length preimageBytes == 32 -> 277 paymentPreimage preimageBytes 278 _ -> Nothing 279 280 -- | Extract a payment preimage from an HTLC-success transaction 281 -- witness. 282 -- 283 -- When the remote party uses an HTLC-success tx on their 284 -- commitment to claim a received HTLC, the witness contains the 285 -- preimage. The witness stack is: 286 -- 287 -- @0 \<remotehtlcsig\> \<localhtlcsig\> \<paymentPreimage\>@ 288 -- 289 -- The preimage is the fourth item (32 bytes). 290 extract_preimage_htlc_success 291 :: Witness -> Maybe PaymentPreimage 292 extract_preimage_htlc_success (Witness items) = 293 case items of 294 [_zero, _remoteSig, _localSig, preimageBytes] 295 | BS.length preimageBytes == 32 -> 296 paymentPreimage preimageBytes 297 _ -> Nothing 298 299 -- timeout check ------------------------------------------------------ 300 301 -- | Check if an HTLC has timed out at the given block height. 302 -- 303 -- An HTLC has timed out when the current block height is equal 304 -- to or greater than the HTLC's CLTV expiry. 305 htlc_timed_out :: Word32 -> HTLC -> Bool 306 htlc_timed_out !currentHeight !htlc = 307 currentHeight >= unCltvExpiry (htlc_cltv_expiry htlc) 308 {-# INLINE htlc_timed_out #-} 309 310 -- internal helpers --------------------------------------------------- 311 312 -- | Compute the txid of a commitment transaction. 313 -- 314 -- Returns 'Nothing' if the commitment has no outputs. 315 commitment_txid :: CommitmentTx -> Maybe TxId 316 commitment_txid !tx = fmap BT.txid (commitment_to_tx tx) 317 318 -- | Find an HTLC matching a given script in the output list. 319 findHTLC 320 :: HTLCDirection 321 -> Script 322 -> CommitmentKeys 323 -> ChannelFeatures 324 -> [HTLC] 325 -> Maybe HTLC 326 findHTLC !dir !targetScript !keys !features = 327 go 328 where 329 go [] = Nothing 330 go (htlc:rest) 331 | htlc_direction htlc == dir 332 , htlcScript htlc == targetScript = Just htlc 333 | otherwise = go rest 334 335 htlcScript htlc = case dir of 336 HTLCOffered -> 337 to_p2wsh $ offered_htlc_script 338 (ck_revocation_pubkey keys) 339 (ck_remote_htlc keys) 340 (ck_local_htlc keys) 341 (htlc_payment_hash htlc) 342 features 343 HTLCReceived -> 344 to_p2wsh $ received_htlc_script 345 (ck_revocation_pubkey keys) 346 (ck_remote_htlc keys) 347 (ck_local_htlc keys) 348 (htlc_payment_hash htlc) 349 (htlc_cltv_expiry htlc) 350 features