Validate.hs (11224B)
1 {-# OPTIONS_HADDOCK prune #-} 2 {-# LANGUAGE BangPatterns #-} 3 {-# LANGUAGE DeriveGeneric #-} 4 5 -- | 6 -- Module: Lightning.Protocol.BOLT3.Validate 7 -- Copyright: (c) 2025 Jared Tobin 8 -- License: MIT 9 -- Maintainer: Jared Tobin <jared@ppad.tech> 10 -- 11 -- Stateless validation for BOLT #3 transactions. 12 -- 13 -- Provides validation for: 14 -- 15 -- * Commitment transaction structure and outputs 16 -- * HTLC transaction structure 17 -- * Closing transaction structure 18 -- * Output ordering per BIP69+CLTV 19 -- * Dust limit compliance 20 21 module Lightning.Protocol.BOLT3.Validate ( 22 -- * Validation errors 23 ValidationError(..) 24 25 -- * Commitment transaction validation 26 , validate_commitment_tx 27 , validate_commitment_locktime 28 , validate_commitment_sequence 29 30 -- * HTLC transaction validation 31 , validate_htlc_tx 32 , validate_htlc_timeout_tx 33 , validate_htlc_success_tx 34 35 -- * Closing transaction validation 36 , validate_closing_tx 37 , validate_legacy_closing_tx 38 39 -- * Output validation 40 , validate_output_ordering 41 , validate_dust_limits 42 , validate_anchor_outputs 43 44 -- * Fee validation 45 , validate_commitment_fee 46 , validate_htlc_fee 47 ) where 48 49 import Data.Bits ((.&.), shiftR) 50 import Data.Word (Word32, Word64) 51 import GHC.Generics (Generic) 52 import Lightning.Protocol.BOLT3.Types 53 import Lightning.Protocol.BOLT3.Tx 54 55 -- validation errors ----------------------------------------------------------- 56 57 -- | Errors that can occur during validation. 58 data ValidationError 59 = InvalidVersion {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32 60 -- ^ Expected version, actual version 61 | InvalidLocktime {-# UNPACK #-} !Word32 62 -- ^ Invalid locktime format 63 | InvalidSequence {-# UNPACK #-} !Word32 64 -- ^ Invalid sequence format 65 | InvalidOutputOrdering 66 -- ^ Outputs not in BIP69+CLTV order 67 | DustLimitViolation {-# UNPACK #-} !Int !Satoshi !Satoshi 68 -- ^ Output index, actual value, dust limit 69 | MissingAnchorOutput 70 -- ^ Expected anchor output not present 71 | InvalidAnchorValue {-# UNPACK #-} !Satoshi 72 -- ^ Anchor value not 330 satoshis 73 | InvalidFee {-# UNPACK #-} !Satoshi {-# UNPACK #-} !Satoshi 74 -- ^ Expected fee, actual fee 75 | InvalidHTLCLocktime {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32 76 -- ^ Expected locktime, actual locktime 77 | InvalidHTLCSequence {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32 78 -- ^ Expected sequence, actual sequence 79 | NoOutputs 80 -- ^ Transaction has no outputs 81 | TooManyOutputs {-# UNPACK #-} !Int 82 -- ^ More outputs than expected 83 deriving (Eq, Show, Generic) 84 85 -- commitment transaction validation ------------------------------------------- 86 87 -- | Validate a commitment transaction. 88 -- 89 -- Checks: 90 -- 91 -- * Version is 2 92 -- * Locktime format (upper 8 bits = 0x20) 93 -- * Sequence format (upper 8 bits = 0x80) 94 -- * Output ordering per BIP69+CLTV 95 -- * Dust limit compliance 96 -- * Anchor outputs if option_anchors 97 validate_commitment_tx 98 :: DustLimit 99 -> ChannelFeatures 100 -> CommitmentTx 101 -> Either ValidationError () 102 validate_commitment_tx dust features tx = do 103 -- Version must be 2 104 validateVersion 2 (ctx_version tx) 105 -- Locktime format 106 validate_commitment_locktime (ctx_locktime tx) 107 -- Sequence format 108 validate_commitment_sequence (ctx_input_sequence tx) 109 -- Output ordering 110 validate_output_ordering (ctx_outputs tx) 111 -- Dust limits 112 validate_dust_limits dust (ctx_outputs tx) 113 -- Anchors if applicable 114 if has_anchors features 115 then validate_anchor_outputs (ctx_outputs tx) 116 else pure () 117 {-# INLINE validate_commitment_tx #-} 118 119 -- | Validate commitment transaction locktime format. 120 -- 121 -- Upper 8 bits must be 0x20. 122 validate_commitment_locktime :: Locktime -> Either ValidationError () 123 validate_commitment_locktime (Locktime lt) = 124 let !upper = (lt `shiftR` 24) .&. 0xFF 125 in if upper == 0x20 126 then Right () 127 else Left (InvalidLocktime lt) 128 {-# INLINE validate_commitment_locktime #-} 129 130 -- | Validate commitment transaction sequence format. 131 -- 132 -- Upper 8 bits must be 0x80. 133 validate_commitment_sequence :: Sequence -> Either ValidationError () 134 validate_commitment_sequence (Sequence sq) = 135 let !upper = (sq `shiftR` 24) .&. 0xFF 136 in if upper == 0x80 137 then Right () 138 else Left (InvalidSequence sq) 139 {-# INLINE validate_commitment_sequence #-} 140 141 -- HTLC transaction validation ------------------------------------------------- 142 143 -- | Validate an HTLC transaction (timeout or success). 144 -- 145 -- Checks: 146 -- 147 -- * Version is 2 148 -- * Single output 149 validate_htlc_tx :: HTLCTx -> Either ValidationError () 150 validate_htlc_tx tx = do 151 validateVersion 2 (htx_version tx) 152 pure () 153 {-# INLINE validate_htlc_tx #-} 154 155 -- | Validate an HTLC-timeout transaction. 156 -- 157 -- Checks: 158 -- 159 -- * Base HTLC validation 160 -- * Locktime equals HTLC cltv_expiry 161 -- * Sequence is 0 (or 1 with option_anchors) 162 validate_htlc_timeout_tx 163 :: ChannelFeatures 164 -> CltvExpiry 165 -> HTLCTx 166 -> Either ValidationError () 167 validate_htlc_timeout_tx features expiry tx = do 168 validate_htlc_tx tx 169 -- Locktime must be cltv_expiry 170 let !expectedLt = unCltvExpiry expiry 171 !actualLt = unLocktime (htx_locktime tx) 172 if expectedLt == actualLt 173 then pure () 174 else Left (InvalidHTLCLocktime expectedLt actualLt) 175 -- Sequence 176 let !expectedSeq = if has_anchors features then 1 else 0 177 !actualSeq = unSequence (htx_input_sequence tx) 178 if expectedSeq == actualSeq 179 then pure () 180 else Left (InvalidHTLCSequence expectedSeq actualSeq) 181 {-# INLINE validate_htlc_timeout_tx #-} 182 183 -- | Validate an HTLC-success transaction. 184 -- 185 -- Checks: 186 -- 187 -- * Base HTLC validation 188 -- * Locktime is 0 189 -- * Sequence is 0 (or 1 with option_anchors) 190 validate_htlc_success_tx 191 :: ChannelFeatures 192 -> HTLCTx 193 -> Either ValidationError () 194 validate_htlc_success_tx features tx = do 195 validate_htlc_tx tx 196 -- Locktime must be 0 197 let !actualLt = unLocktime (htx_locktime tx) 198 if actualLt == 0 199 then pure () 200 else Left (InvalidHTLCLocktime 0 actualLt) 201 -- Sequence 202 let !expectedSeq = if has_anchors features then 1 else 0 203 !actualSeq = unSequence (htx_input_sequence tx) 204 if expectedSeq == actualSeq 205 then pure () 206 else Left (InvalidHTLCSequence expectedSeq actualSeq) 207 {-# INLINE validate_htlc_success_tx #-} 208 209 -- closing transaction validation ---------------------------------------------- 210 211 -- | Validate a closing transaction (option_simple_close). 212 -- 213 -- Checks: 214 -- 215 -- * Version is 2 216 -- * Sequence is 0xFFFFFFFD 217 -- * At least one output 218 -- * Output ordering per BIP69 219 validate_closing_tx :: ClosingTx -> Either ValidationError () 220 validate_closing_tx tx = do 221 validateVersion 2 (cltx_version tx) 222 let !actualSeq = unSequence (cltx_input_sequence tx) 223 if actualSeq == 0xFFFFFFFD 224 then pure () 225 else Left (InvalidSequence actualSeq) 226 validateOutputCount (cltx_outputs tx) 227 validate_output_ordering (cltx_outputs tx) 228 {-# INLINE validate_closing_tx #-} 229 230 -- | Validate a legacy closing transaction (closing_signed). 231 -- 232 -- Checks: 233 -- 234 -- * Version is 2 235 -- * Locktime is 0 236 -- * Sequence is 0xFFFFFFFF 237 -- * At least one output 238 -- * Output ordering per BIP69 239 validate_legacy_closing_tx :: ClosingTx -> Either ValidationError () 240 validate_legacy_closing_tx tx = do 241 validateVersion 2 (cltx_version tx) 242 let !actualLt = unLocktime (cltx_locktime tx) 243 if actualLt == 0 244 then pure () 245 else Left (InvalidLocktime actualLt) 246 let !actualSeq = unSequence (cltx_input_sequence tx) 247 if actualSeq == 0xFFFFFFFF 248 then pure () 249 else Left (InvalidSequence actualSeq) 250 validateOutputCount (cltx_outputs tx) 251 validate_output_ordering (cltx_outputs tx) 252 {-# INLINE validate_legacy_closing_tx #-} 253 254 -- output validation ----------------------------------------------------------- 255 256 -- | Validate output ordering per BIP69+CLTV. 257 -- 258 -- Outputs must be sorted by: 259 -- 1. Value (smallest first) 260 -- 2. ScriptPubKey (lexicographic) 261 -- 3. CLTV expiry (for HTLC outputs) 262 validate_output_ordering :: [TxOutput] -> Either ValidationError () 263 validate_output_ordering outputs = 264 let !sorted = sort_outputs outputs 265 in if outputs == sorted 266 then Right () 267 else Left InvalidOutputOrdering 268 {-# INLINE validate_output_ordering #-} 269 270 -- | Validate that no output violates dust limits. 271 validate_dust_limits 272 :: DustLimit 273 -> [TxOutput] 274 -> Either ValidationError () 275 validate_dust_limits dust = go 0 where 276 !limit = unDustLimit dust 277 go !_ [] = Right () 278 go !idx (out:rest) = 279 let !val = txout_value out 280 in case txout_type out of 281 -- Anchors have fixed value, don't check against dust limit 282 OutputLocalAnchor -> go (idx + 1) rest 283 OutputRemoteAnchor -> go (idx + 1) rest 284 -- All other outputs must be above dust 285 _ -> if unSatoshi val >= unSatoshi limit 286 then go (idx + 1) rest 287 else Left (DustLimitViolation idx val limit) 288 {-# INLINE validate_dust_limits #-} 289 290 -- | Validate anchor outputs are present and correctly valued. 291 validate_anchor_outputs :: [TxOutput] -> Either ValidationError () 292 validate_anchor_outputs outputs = 293 let !anchors = filter isAnchor outputs 294 in if null anchors 295 then Left MissingAnchorOutput 296 else validateAnchorValues anchors 297 where 298 isAnchor out = case txout_type out of 299 OutputLocalAnchor -> True 300 OutputRemoteAnchor -> True 301 _ -> False 302 303 validateAnchorValues [] = Right () 304 validateAnchorValues (a:as) = 305 let !val = txout_value a 306 in if val == anchor_output_value 307 then validateAnchorValues as 308 else Left (InvalidAnchorValue val) 309 {-# INLINE validate_anchor_outputs #-} 310 311 -- fee validation -------------------------------------------------------------- 312 313 -- | Validate commitment transaction fee. 314 -- 315 -- Checks that the fee matches the expected calculation. 316 validate_commitment_fee 317 :: FeeratePerKw 318 -> ChannelFeatures 319 -> Word64 -- ^ Number of untrimmed HTLCs 320 -> Satoshi -- ^ Actual fee 321 -> Either ValidationError () 322 validate_commitment_fee feerate features numHtlcs actualFee = 323 let !expectedFee = commitment_fee feerate features numHtlcs 324 in if actualFee == expectedFee 325 then Right () 326 else Left (InvalidFee expectedFee actualFee) 327 {-# INLINE validate_commitment_fee #-} 328 329 -- | Validate HTLC transaction fee. 330 validate_htlc_fee 331 :: FeeratePerKw 332 -> ChannelFeatures 333 -> HTLCDirection 334 -> Satoshi -- ^ Actual fee 335 -> Either ValidationError () 336 validate_htlc_fee feerate features direction actualFee = 337 let !expectedFee = case direction of 338 HTLCOffered -> htlc_timeout_fee feerate features 339 HTLCReceived -> htlc_success_fee feerate features 340 in if actualFee == expectedFee 341 then Right () 342 else Left (InvalidFee expectedFee actualFee) 343 {-# INLINE validate_htlc_fee #-} 344 345 -- helpers --------------------------------------------------------------------- 346 347 -- | Validate transaction version. 348 validateVersion :: Word32 -> Word32 -> Either ValidationError () 349 validateVersion expected actual = 350 if expected == actual 351 then Right () 352 else Left (InvalidVersion expected actual) 353 {-# INLINE validateVersion #-} 354 355 -- | Validate that transaction has at least one output. 356 validateOutputCount :: [TxOutput] -> Either ValidationError () 357 validateOutputCount [] = Left NoOutputs 358 validateOutputCount _ = Right () 359 {-# INLINE validateOutputCount #-}