Main.hs (21558B)
1 {-# LANGUAGE OverloadedStrings #-} 2 3 module Main where 4 5 import qualified Crypto.Curve.Secp256k1 as S 6 import qualified Data.ByteString as BS 7 import qualified Data.ByteString.Base16 as B16 8 import Data.Maybe (isJust, isNothing) 9 import Data.Word (Word32, Word64) 10 import Test.Tasty 11 import Test.Tasty.HUnit 12 import Test.Tasty.QuickCheck 13 import Lightning.Protocol.BOLT3 14 import Lightning.Protocol.BOLT3.Types 15 ( Pubkey(..), Point(..) 16 , PaymentHash(..), PerCommitmentPoint(..) 17 , PerCommitmentSecret(..) 18 ) 19 20 -- Module-level wNAF context. Built once; reused across every 21 -- equivalence test below. Mirrors how downstream callers should use 22 -- it. 23 tex :: S.Context 24 tex = S.precompute 25 {-# NOINLINE tex #-} 26 27 main :: IO () 28 main = defaultMain $ testGroup "ppad-bolt3" [ 29 testGroup "Key derivation" [ 30 keyDerivationTests 31 ] 32 , testGroup "Secret generation" [ 33 secretGenerationTests 34 ] 35 , testGroup "Secret storage" [ 36 secretStorageTests 37 ] 38 , testGroup "Fee calculation" [ 39 feeCalculationTests 40 ] 41 , testGroup "Trimming" [ 42 trimmingTests 43 ] 44 , testGroup "Smart constructors" [ 45 smartConstructorTests 46 ] 47 , testGroup "Properties" [ 48 propertyTests 49 ] 50 ] 51 52 -- hex decoding helper 53 hex :: BS.ByteString -> BS.ByteString 54 hex h = case B16.decode h of 55 Right bs -> bs 56 Left _ -> error "invalid hex" 57 58 -- Key derivation test vectors from Appendix E --------------------------------- 59 60 keyDerivationTests :: TestTree 61 keyDerivationTests = testGroup "BOLT #3 Appendix E" [ 62 testCase "derive_pubkey" $ do 63 let basepoint = Point $ hex 64 "036d6caac248af96f6afa7f904f550253a0f3ef3f5aa2fe6838a95b216691468e2" 65 perCommitmentPoint = PerCommitmentPoint $ Point $ hex 66 "025f7117a78150fe2ef97db7cfc83bd57b2e2c0d0dd25eaf467a4a1c2a45ce1486" 67 expected = hex 68 "0235f2dbfaa89b57ec7b055afe29849ef7ddfeb1cefdb9ebdc43f5494984db29e5" 69 case derive_pubkey basepoint perCommitmentPoint of 70 Nothing -> assertFailure "derive_pubkey returned Nothing" 71 Just (Pubkey pk) -> pk @?= expected 72 73 , testCase "derive_pubkey' matches vector" $ do 74 let basepoint = Point $ hex 75 "036d6caac248af96f6afa7f904f550253a0f3ef3f5aa2fe6838a95b216691468e2" 76 perCommitmentPoint = PerCommitmentPoint $ Point $ hex 77 "025f7117a78150fe2ef97db7cfc83bd57b2e2c0d0dd25eaf467a4a1c2a45ce1486" 78 expected = hex 79 "0235f2dbfaa89b57ec7b055afe29849ef7ddfeb1cefdb9ebdc43f5494984db29e5" 80 case derive_pubkey' tex basepoint perCommitmentPoint of 81 Nothing -> assertFailure "derive_pubkey' returned Nothing" 82 Just (Pubkey pk) -> pk @?= expected 83 84 , testCase "derive_revocationpubkey" $ do 85 let revocationBasepoint = RevocationBasepoint $ Point $ hex 86 "036d6caac248af96f6afa7f904f550253a0f3ef3f5aa2fe6838a95b216691468e2" 87 perCommitmentPoint = PerCommitmentPoint $ Point $ hex 88 "025f7117a78150fe2ef97db7cfc83bd57b2e2c0d0dd25eaf467a4a1c2a45ce1486" 89 expected = hex 90 "02916e326636d19c33f13e8c0c3a03dd157f332f3e99c317c141dd865eb01f8ff0" 91 case derive_revocationpubkey revocationBasepoint perCommitmentPoint of 92 Nothing -> assertFailure "derive_revocationpubkey returned Nothing" 93 Just (RevocationPubkey (Pubkey pk)) -> pk @?= expected 94 ] 95 96 -- Secret generation test vectors from Appendix D ------------------------------ 97 98 secretGenerationTests :: TestTree 99 secretGenerationTests = testGroup "BOLT #3 Appendix D - Generation" [ 100 testCase "generate_from_seed 0 final node" $ do 101 let seed = hex 102 "0000000000000000000000000000000000000000000000000000000000000000" 103 i = 281474976710655 104 expected = hex 105 "02a40c85b6f28da08dfdbe0926c53fab2de6d28c10301f8f7c4073d5e42e3148" 106 generate_from_seed seed i @?= expected 107 108 , testCase "generate_from_seed FF final node" $ do 109 let seed = hex 110 "FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF" 111 i = 281474976710655 112 expected = hex 113 "7cc854b54e3e0dcdb010d7a3fee464a9687be6e8db3be6854c475621e007a5dc" 114 generate_from_seed seed i @?= expected 115 116 , testCase "generate_from_seed FF alternate bits 1" $ do 117 let seed = hex 118 "FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF" 119 i = 0xaaaaaaaaaaa 120 expected = hex 121 "56f4008fb007ca9acf0e15b054d5c9fd12ee06cea347914ddbaed70d1c13a528" 122 generate_from_seed seed i @?= expected 123 124 , testCase "generate_from_seed FF alternate bits 2" $ do 125 let seed = hex 126 "FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF" 127 i = 0x555555555555 128 expected = hex 129 "9015daaeb06dba4ccc05b91b2f73bd54405f2be9f217fbacd3c5ac2e62327d31" 130 generate_from_seed seed i @?= expected 131 132 , testCase "generate_from_seed 01 last nontrivial node" $ do 133 let seed = hex 134 "0101010101010101010101010101010101010101010101010101010101010101" 135 i = 1 136 expected = hex 137 "915c75942a26bb3a433a8ce2cb0427c29ec6c1775cfc78328b57f6ba7bfeaa9c" 138 generate_from_seed seed i @?= expected 139 ] 140 141 -- Secret storage test vectors from Appendix D --------------------------------- 142 143 secretStorageTests :: TestTree 144 secretStorageTests = testGroup "BOLT #3 Appendix D - Storage" [ 145 testCase "insert_secret correct sequence" $ do 146 let secrets = [ 147 (281474976710655, hex 148 "7cc854b54e3e0dcdb010d7a3fee464a9687be6e8db3be6854c475621e007a5dc") 149 , (281474976710654, hex 150 "c7518c8ae4660ed02894df8976fa1a3659c1a8b4b5bec0c4b872abeba4cb8964") 151 , (281474976710653, hex 152 "2273e227a5b7449b6e70f1fb4652864038b1cbf9cd7c043a7d6456b7fc275ad8") 153 , (281474976710652, hex 154 "27cddaa5624534cb6cb9d7da077cf2b22ab21e9b506fd4998a51d54502e99116") 155 , (281474976710651, hex 156 "c65716add7aa98ba7acb236352d665cab17345fe45b55fb879ff80e6bd0c41dd") 157 , (281474976710650, hex 158 "969660042a28f32d9be17344e09374b379962d03db1574df5a8a5a47e19ce3f2") 159 , (281474976710649, hex 160 "a5a64476122ca0925fb344bdc1854c1c0a59fc614298e50a33e331980a220f32") 161 , (281474976710648, hex 162 "05cde6323d949933f7f7b78776bcc1ea6d9b31447732e3802e1f7ac44b650e17") 163 ] 164 let insertAll store [] = Just store 165 insertAll store ((idx, secret):rest) = 166 case insert_secret secret idx store of 167 Nothing -> Nothing 168 Just store' -> insertAll store' rest 169 case insertAll empty_store secrets of 170 Nothing -> assertFailure "insert_secret failed on correct sequence" 171 Just _ -> return () 172 173 , testCase "insert_secret #1 incorrect" $ do 174 -- First secret is from wrong seed, second should fail 175 let store0 = empty_store 176 case insert_secret (hex 177 "02a40c85b6f28da08dfdbe0926c53fab2de6d28c10301f8f7c4073d5e42e3148") 178 281474976710655 store0 of 179 Nothing -> assertFailure "First insert should succeed" 180 Just store1 -> 181 case insert_secret (hex 182 "c7518c8ae4660ed02894df8976fa1a3659c1a8b4b5bec0c4b872abeba4cb8964") 183 281474976710654 store1 of 184 Nothing -> return () -- Expected to fail 185 Just _ -> assertFailure "Second insert should fail" 186 ] 187 188 -- Fee calculation tests ------------------------------------------------------- 189 190 feeCalculationTests :: TestTree 191 feeCalculationTests = testGroup "Fee calculation" [ 192 testCase "commitment_fee no anchors, 0 htlcs" $ do 193 let feerate = FeeratePerKw 5000 194 features = ChannelFeatures { cf_option_anchors = False } 195 fee = commitment_fee feerate features 0 196 fee @?= Satoshi 3620 -- 5000 * 724 / 1000 = 3620 197 198 , testCase "commitment_fee no anchors, 2 htlcs" $ do 199 let feerate = FeeratePerKw 5000 200 features = ChannelFeatures { cf_option_anchors = False } 201 fee = commitment_fee feerate features 2 202 -- weight = 724 + 172*2 = 1068 203 -- fee = 5000 * 1068 / 1000 = 5340 204 fee @?= Satoshi 5340 205 206 , testCase "commitment_fee with anchors, 0 htlcs" $ do 207 let feerate = FeeratePerKw 5000 208 features = ChannelFeatures { cf_option_anchors = True } 209 fee = commitment_fee feerate features 0 210 -- 5000 * 1124 / 1000 = 5620 211 fee @?= Satoshi 5620 212 213 , testCase "htlc_timeout_fee no anchors" $ do 214 let feerate = FeeratePerKw 5000 215 features = ChannelFeatures { cf_option_anchors = False } 216 fee = htlc_timeout_fee feerate features 217 -- 5000 * 663 / 1000 = 3315 218 fee @?= Satoshi 3315 219 220 , testCase "htlc_success_fee no anchors" $ do 221 let feerate = FeeratePerKw 5000 222 features = ChannelFeatures { cf_option_anchors = False } 223 fee = htlc_success_fee feerate features 224 -- 5000 * 703 / 1000 = 3515 225 fee @?= Satoshi 3515 226 227 , testCase "htlc_timeout_fee with anchors is 0" $ do 228 let feerate = FeeratePerKw 5000 229 features = ChannelFeatures { cf_option_anchors = True } 230 fee = htlc_timeout_fee feerate features 231 fee @?= Satoshi 0 232 233 , testCase "htlc_success_fee with anchors is 0" $ do 234 let feerate = FeeratePerKw 5000 235 features = ChannelFeatures { cf_option_anchors = True } 236 fee = htlc_success_fee feerate features 237 fee @?= Satoshi 0 238 ] 239 240 -- Trimming tests -------------------------------------------------------------- 241 242 trimmingTests :: TestTree 243 trimmingTests = testGroup "HTLC trimming" [ 244 testCase "offered HTLC above threshold not trimmed" $ do 245 let dust = DustLimit (Satoshi 546) 246 feerate = FeeratePerKw 5000 247 features = ChannelFeatures { cf_option_anchors = False } 248 htlc = HTLC 249 { htlc_direction = HTLCOffered 250 , htlc_amount_msat = MilliSatoshi 5000000 -- 5000 sats 251 , htlc_payment_hash = PaymentHash (BS.replicate 32 0) 252 , htlc_cltv_expiry = CltvExpiry 500000 253 } 254 -- threshold = 546 + 3315 = 3861 255 -- 5000 > 3861, so not trimmed 256 is_trimmed dust feerate features htlc @?= False 257 258 , testCase "offered HTLC below threshold is trimmed" $ do 259 let dust = DustLimit (Satoshi 546) 260 feerate = FeeratePerKw 5000 261 features = ChannelFeatures { cf_option_anchors = False } 262 htlc = HTLC 263 { htlc_direction = HTLCOffered 264 , htlc_amount_msat = MilliSatoshi 1000000 -- 1000 sats 265 , htlc_payment_hash = PaymentHash (BS.replicate 32 0) 266 , htlc_cltv_expiry = CltvExpiry 500000 267 } 268 -- threshold = 546 + 3315 = 3861 269 -- 1000 < 3861, so trimmed 270 is_trimmed dust feerate features htlc @?= True 271 272 , testCase "received HTLC above threshold not trimmed" $ do 273 let dust = DustLimit (Satoshi 546) 274 feerate = FeeratePerKw 5000 275 features = ChannelFeatures { cf_option_anchors = False } 276 htlc = HTLC 277 { htlc_direction = HTLCReceived 278 , htlc_amount_msat = MilliSatoshi 7000000 -- 7000 sats 279 , htlc_payment_hash = PaymentHash (BS.replicate 32 0) 280 , htlc_cltv_expiry = CltvExpiry 500000 281 } 282 -- threshold = 546 + 3515 = 4061 283 -- 7000 > 4061, so not trimmed 284 is_trimmed dust feerate features htlc @?= False 285 286 , testCase "received HTLC below threshold is trimmed" $ do 287 let dust = DustLimit (Satoshi 546) 288 feerate = FeeratePerKw 5000 289 features = ChannelFeatures { cf_option_anchors = False } 290 htlc = HTLC 291 { htlc_direction = HTLCReceived 292 , htlc_amount_msat = MilliSatoshi 800000 -- 800 sats 293 , htlc_payment_hash = PaymentHash (BS.replicate 32 0) 294 , htlc_cltv_expiry = CltvExpiry 500000 295 } 296 -- threshold = 546 + 3515 = 4061 297 -- 800 < 4061, so trimmed 298 is_trimmed dust feerate features htlc @?= True 299 ] 300 301 -- Smart constructor tests ----------------------------------------------------- 302 303 smartConstructorTests :: TestTree 304 smartConstructorTests = testGroup "validation" [ 305 -- 33-byte types 306 testCase "pubkey accepts 33 bytes" $ do 307 let bs = BS.replicate 33 0x02 308 isJust (pubkey bs) @?= True 309 , testCase "pubkey rejects 32 bytes" $ do 310 let bs = BS.replicate 32 0x02 311 isNothing (pubkey bs) @?= True 312 , testCase "pubkey rejects 34 bytes" $ do 313 let bs = BS.replicate 34 0x02 314 isNothing (pubkey bs) @?= True 315 , testCase "point accepts 33 bytes" $ do 316 let bs = BS.replicate 33 0x03 317 isJust (point bs) @?= True 318 , testCase "point rejects 32 bytes" $ do 319 let bs = BS.replicate 32 0x03 320 isNothing (point bs) @?= True 321 322 -- 32-byte types 323 , testCase "seckey accepts 32 bytes" $ do 324 let bs = BS.replicate 32 0x01 325 isJust (seckey bs) @?= True 326 , testCase "seckey rejects 31 bytes" $ do 327 let bs = BS.replicate 31 0x01 328 isNothing (seckey bs) @?= True 329 , testCase "seckey rejects 33 bytes" $ do 330 let bs = BS.replicate 33 0x01 331 isNothing (seckey bs) @?= True 332 , testCase "mkTxId accepts 32 bytes" $ do 333 let bs = BS.replicate 32 0x00 334 isJust (mkTxId bs) @?= True 335 , testCase "mkTxId rejects 31 bytes" $ do 336 let bs = BS.replicate 31 0x00 337 isNothing (mkTxId bs) @?= True 338 , testCase "paymentHash accepts 32 bytes" $ do 339 let bs = BS.replicate 32 0xab 340 isJust (paymentHash bs) @?= True 341 , testCase "paymentHash rejects 33 bytes" $ do 342 let bs = BS.replicate 33 0xab 343 isNothing (paymentHash bs) @?= True 344 , testCase "paymentPreimage accepts 32 bytes" $ do 345 let bs = BS.replicate 32 0xcd 346 isJust (paymentPreimage bs) @?= True 347 , testCase "paymentPreimage rejects 31 bytes" $ do 348 let bs = BS.replicate 31 0xcd 349 isNothing (paymentPreimage bs) @?= True 350 , testCase "perCommitmentSecret accepts 32 bytes" $ do 351 let bs = BS.replicate 32 0xef 352 isJust (perCommitmentSecret bs) @?= True 353 , testCase "perCommitmentSecret rejects 33 bytes" $ do 354 let bs = BS.replicate 33 0xef 355 isNothing (perCommitmentSecret bs) @?= True 356 357 -- 48-bit commitment number 358 , testCase "commitment_number accepts 0" $ do 359 isJust (commitment_number 0) @?= True 360 , testCase "commitment_number accepts 2^48-1" $ do 361 isJust (commitment_number 281474976710655) @?= True 362 , testCase "commitment_number rejects 2^48" $ do 363 isNothing (commitment_number 281474976710656) @?= True 364 , testCase "commitment_number rejects maxBound Word64" $ do 365 isNothing (commitment_number maxBound) @?= True 366 367 -- next_commitment_number 368 , testCase "next_commitment_number 0 -> 1" $ 369 case commitment_number 0 of 370 Nothing -> assertFailure "commitment_number 0" 371 Just cn0 -> case next_commitment_number cn0 of 372 Nothing -> assertFailure "next failed" 373 Just cn1 -> unCommitmentNumber cn1 @?= 1 374 , testCase "next_commitment_number (2^48-2) -> (2^48-1)" $ 375 case commitment_number 281474976710654 of 376 Nothing -> assertFailure "commitment_number" 377 Just cn -> case next_commitment_number cn of 378 Nothing -> assertFailure "next failed" 379 Just cn' -> 380 unCommitmentNumber cn' @?= 281474976710655 381 , testCase "next_commitment_number (2^48-1) -> Nothing" $ 382 case commitment_number 281474976710655 of 383 Nothing -> assertFailure "commitment_number" 384 Just cn -> 385 isNothing (next_commitment_number cn) @?= True 386 ] 387 388 -- Property tests ------------------------------------------------------- 389 390 -- | Maximum valid commitment number (2^48 - 1). 391 maxCommitNum :: Word64 392 maxCommitNum = 281474976710655 393 394 propertyTests :: TestTree 395 propertyTests = testGroup "invariants" [ 396 testProperty "commitment_number validates 48-bit" 397 propCommitmentNumberRange 398 , testProperty "next_commitment_number stays valid" 399 propNextCommitmentNumber 400 , testProperty "trimmed/untrimmed partition" 401 propTrimPartition 402 , testProperty "commitment_fee increases with HTLCs" 403 propFeeMonotonic 404 , testProperty "derive_per_commitment_point' ≡ derive_per_commitment_point" 405 propDerivePcpEquiv 406 , testProperty "derive_pubkey' ≡ derive_pubkey" 407 propDerivePubkeyEquiv 408 , testProperty "derive_localpubkey' ≡ derive_localpubkey" 409 propDeriveLocalEquiv 410 , testProperty "derive_local_htlcpubkey' ≡ derive_local_htlcpubkey" 411 propDeriveLocalHtlcEquiv 412 , testProperty "derive_remote_htlcpubkey' ≡ derive_remote_htlcpubkey" 413 propDeriveRemoteHtlcEquiv 414 , testProperty "derive_local_delayedpubkey' ≡ derive_local_delayedpubkey" 415 propDeriveLocalDelEquiv 416 , testProperty "derive_remote_delayedpubkey' ≡ derive_remote_delayedpubkey" 417 propDeriveRemoteDelEquiv 418 ] 419 420 -- | Random 32-byte secret, then derive a basepoint and per-commit 421 -- point from it. Returns (basepoint, pcp). Using derived points 422 -- keeps us on the curve without having to generate valid points 423 -- directly. 424 genPointPair :: Gen (Point, PerCommitmentPoint) 425 genPointPair = do 426 sk1 <- vectorOf 32 (choose (0, 255 :: Int)) 427 sk2 <- vectorOf 32 (choose (0, 255 :: Int)) 428 let bs1 = BS.pack (fmap fromIntegral sk1) 429 bs2 = BS.pack (fmap fromIntegral sk2) 430 mkPt b = case S.parse_int256 b of 431 Nothing -> Nothing 432 Just w -> S.serialize_point <$> S.derive_pub w 433 case (mkPt bs1, mkPt bs2) of 434 (Just p1, Just p2) -> 435 pure (Point p1, PerCommitmentPoint (Point p2)) 436 _ -> genPointPair -- ~negligible retry; sk=0 or sk>=q 437 438 propDerivePcpEquiv :: Property 439 propDerivePcpEquiv = 440 forAll (vectorOf 32 (choose (0, 255 :: Int))) $ \sk -> 441 let bs = BS.pack (fmap fromIntegral sk) 442 sec = PerCommitmentSecret bs 443 in derive_per_commitment_point' tex sec 444 === derive_per_commitment_point sec 445 446 propDerivePubkeyEquiv :: Property 447 propDerivePubkeyEquiv = 448 forAll genPointPair $ \(bp, pcp) -> 449 derive_pubkey' tex bp pcp === derive_pubkey bp pcp 450 451 propDeriveLocalEquiv :: Property 452 propDeriveLocalEquiv = 453 forAll genPointPair $ \(bp, pcp) -> 454 let pbp = PaymentBasepoint bp 455 in derive_localpubkey' tex pbp pcp 456 === derive_localpubkey pbp pcp 457 458 propDeriveLocalHtlcEquiv :: Property 459 propDeriveLocalHtlcEquiv = 460 forAll genPointPair $ \(bp, pcp) -> 461 let hbp = HtlcBasepoint bp 462 in derive_local_htlcpubkey' tex hbp pcp 463 === derive_local_htlcpubkey hbp pcp 464 465 propDeriveRemoteHtlcEquiv :: Property 466 propDeriveRemoteHtlcEquiv = 467 forAll genPointPair $ \(bp, pcp) -> 468 let hbp = HtlcBasepoint bp 469 in derive_remote_htlcpubkey' tex hbp pcp 470 === derive_remote_htlcpubkey hbp pcp 471 472 propDeriveLocalDelEquiv :: Property 473 propDeriveLocalDelEquiv = 474 forAll genPointPair $ \(bp, pcp) -> 475 let dbp = DelayedPaymentBasepoint bp 476 in derive_local_delayedpubkey' tex dbp pcp 477 === derive_local_delayedpubkey dbp pcp 478 479 propDeriveRemoteDelEquiv :: Property 480 propDeriveRemoteDelEquiv = 481 forAll genPointPair $ \(bp, pcp) -> 482 let dbp = DelayedPaymentBasepoint bp 483 in derive_remote_delayedpubkey' tex dbp pcp 484 === derive_remote_delayedpubkey dbp pcp 485 486 -- | commitment_number accepts values in [0, 2^48-1] and 487 -- rejects values >= 2^48. 488 propCommitmentNumberRange :: Property 489 propCommitmentNumberRange = 490 forAll (choose (0, maxBound)) $ \n -> 491 case commitment_number n of 492 Just cn -> n <= maxCommitNum 493 && unCommitmentNumber cn == n 494 Nothing -> n > maxCommitNum 495 496 -- | If cn is a valid commitment number below the max, 497 -- next_commitment_number yields a valid successor. 498 propNextCommitmentNumber :: Property 499 propNextCommitmentNumber = 500 forAll (choose (0, maxCommitNum)) $ \n -> 501 case commitment_number n of 502 Nothing -> False 503 Just cn 504 | n < maxCommitNum -> 505 case next_commitment_number cn of 506 Nothing -> False 507 Just cn' -> 508 unCommitmentNumber cn' == n + 1 509 | otherwise -> 510 isNothing (next_commitment_number cn) 511 512 -- | trimmed_htlcs and untrimmed_htlcs partition the 513 -- input list: every HTLC is in exactly one set and 514 -- trimmed HTLCs have amount below the threshold. 515 propTrimPartition :: Property 516 propTrimPartition = 517 forAll (choose (1 :: Word32, 50000)) $ \feeW -> 518 forAll (choose (1, 20)) $ \numHtlcs -> 519 forAll (vectorOf numHtlcs genHTLC) $ \htlcs -> 520 let dust = DustLimit (Satoshi 546) 521 feerate = FeeratePerKw feeW 522 features = ChannelFeatures 523 { cf_option_anchors = False } 524 trimmed = trimmed_htlcs 525 dust feerate features htlcs 526 untrimmed = untrimmed_htlcs 527 dust feerate features htlcs 528 in length trimmed + length untrimmed 529 == length htlcs 530 531 -- | commitment_fee is monotonically non-decreasing in 532 -- the number of HTLCs. 533 propFeeMonotonic :: Property 534 propFeeMonotonic = 535 forAll (choose (1 :: Word32, 50000)) $ \feeW -> 536 forAll (choose (0, 100)) $ \n -> 537 let feerate = FeeratePerKw feeW 538 features = ChannelFeatures 539 { cf_option_anchors = False } 540 fee0 = commitment_fee feerate features n 541 fee1 = commitment_fee feerate features (n + 1) 542 in fee1 >= fee0 543 544 -- | Generate a random HTLC. 545 genHTLC :: Gen HTLC 546 genHTLC = do 547 dir <- elements [HTLCOffered, HTLCReceived] 548 amt <- choose (0, 10000000) 549 cltv <- choose (0, 1000000) 550 pure HTLC 551 { htlc_direction = dir 552 , htlc_amount_msat = MilliSatoshi amt 553 , htlc_payment_hash = PaymentHash 554 (BS.replicate 32 0x00) 555 , htlc_cltv_expiry = CltvExpiry cltv 556 }