Main.hs (17879B)
1 {-# LANGUAGE BangPatterns #-} 2 {-# LANGUAGE OverloadedStrings #-} 3 4 module Main where 5 6 import qualified Crypto.Curve.Secp256k1 as S 7 import Control.DeepSeq (NFData(..)) 8 import Criterion.Main 9 import Data.Word (Word64) 10 import qualified Data.ByteString as BS 11 import Lightning.Protocol.BOLT3 12 import Lightning.Protocol.BOLT3.Types 13 ( Pubkey(..), Point(..) 14 , PaymentHash(..), PerCommitmentPoint(..) 15 , PerCommitmentSecret(..) 16 , CommitmentNumber(..) 17 ) 18 19 -- NFData instances for benchmarking 20 -- (Satoshi, MilliSatoshi, Point, PaymentHash, PerCommitmentSecret 21 -- derive NFData via ppad-bolt1) 22 23 instance NFData Pubkey where 24 rnf (Pubkey x) = rnf x 25 26 instance NFData PerCommitmentPoint where 27 rnf (PerCommitmentPoint x) = rnf x 28 29 instance NFData RevocationPubkey where 30 rnf (RevocationPubkey x) = rnf x 31 32 instance NFData RevocationBasepoint where 33 rnf (RevocationBasepoint x) = rnf x 34 35 instance NFData ChannelFeatures where 36 rnf (ChannelFeatures x) = rnf x 37 38 instance NFData FeeratePerKw where 39 rnf (FeeratePerKw x) = rnf x 40 41 instance NFData DustLimit where 42 rnf (DustLimit x) = rnf x 43 44 instance NFData CltvExpiry where 45 rnf (CltvExpiry x) = rnf x 46 47 instance NFData HTLCDirection where 48 rnf HTLCOffered = () 49 rnf HTLCReceived = () 50 51 instance NFData HTLC where 52 rnf (HTLC d a h c) = rnf d `seq` rnf a `seq` rnf h `seq` rnf c 53 54 -- Transaction types 55 instance NFData CommitmentTx where 56 rnf (CommitmentTx v l i s o f) = 57 rnf v `seq` rnf l `seq` rnf i `seq` rnf s `seq` rnf o `seq` rnf f 58 59 instance NFData HTLCTx where 60 rnf (HTLCTx v l i s ov os) = 61 rnf v `seq` rnf l `seq` rnf i `seq` rnf s `seq` rnf ov `seq` rnf os 62 63 instance NFData ClosingTx where 64 rnf (ClosingTx v l i s o f) = 65 rnf v `seq` rnf l `seq` rnf i `seq` rnf s `seq` rnf o `seq` rnf f 66 67 -- Output types 68 instance NFData TxOutput where 69 rnf (TxOutput v s t) = rnf v `seq` rnf s `seq` rnf t 70 71 instance NFData OutputType where 72 rnf OutputToLocal = () 73 rnf OutputToRemote = () 74 rnf OutputLocalAnchor = () 75 rnf OutputRemoteAnchor = () 76 rnf (OutputOfferedHTLC e) = rnf e 77 rnf (OutputReceivedHTLC e) = rnf e 78 79 -- Primitives 80 instance NFData Script where 81 rnf (Script bs) = rnf bs 82 83 84 instance NFData Sequence where 85 rnf (Sequence x) = rnf x 86 87 instance NFData Locktime where 88 rnf (Locktime x) = rnf x 89 90 instance NFData ToSelfDelay where 91 rnf (ToSelfDelay x) = rnf x 92 93 instance NFData CommitmentNumber where 94 rnf (CommitmentNumber x) = rnf x 95 96 -- Context types 97 instance NFData CommitmentContext where 98 rnf ctx = rnf (cc_funding_outpoint ctx) `seq` 99 rnf (cc_commitment_number ctx) `seq` 100 rnf (cc_htlcs ctx) `seq` 101 rnf (cc_keys ctx) 102 103 instance NFData CommitmentKeys where 104 rnf keys = rnf (ck_revocation_pubkey keys) `seq` 105 rnf (ck_local_delayed keys) `seq` 106 rnf (ck_local_htlc keys) `seq` 107 rnf (ck_remote_htlc keys) 108 109 instance NFData HTLCContext where 110 rnf ctx = rnf (hc_commitment_txid ctx) `seq` 111 rnf (hc_htlc ctx) 112 113 instance NFData ClosingContext where 114 rnf ctx = rnf (clc_funding_outpoint ctx) `seq` 115 rnf (clc_local_amount ctx) `seq` 116 rnf (clc_remote_amount ctx) 117 118 -- Key types 119 instance NFData LocalDelayedPubkey where 120 rnf (LocalDelayedPubkey p) = rnf p 121 122 instance NFData RemoteDelayedPubkey where 123 rnf (RemoteDelayedPubkey p) = rnf p 124 125 instance NFData LocalHtlcPubkey where 126 rnf (LocalHtlcPubkey p) = rnf p 127 128 instance NFData RemoteHtlcPubkey where 129 rnf (RemoteHtlcPubkey p) = rnf p 130 131 instance NFData LocalPubkey where 132 rnf (LocalPubkey p) = rnf p 133 134 instance NFData RemotePubkey where 135 rnf (RemotePubkey p) = rnf p 136 137 instance NFData PaymentBasepoint where 138 rnf (PaymentBasepoint p) = rnf p 139 140 instance NFData DelayedPaymentBasepoint where 141 rnf (DelayedPaymentBasepoint p) = rnf p 142 143 instance NFData HtlcBasepoint where 144 rnf (HtlcBasepoint p) = rnf p 145 146 instance NFData FundingPubkey where 147 rnf (FundingPubkey p) = rnf p 148 149 -- Secret storage (SecretStore is a newtype over list) 150 instance NFData SecretStore where 151 rnf store = rnf (derive_old_secret 0 store) 152 153 -- Validation errors 154 instance NFData ValidationError where 155 rnf (InvalidVersion a b) = rnf a `seq` rnf b 156 rnf (InvalidLocktime a) = rnf a 157 rnf (InvalidSequence a) = rnf a 158 rnf InvalidOutputOrdering = () 159 rnf (DustLimitViolation a b c) = rnf a `seq` rnf b `seq` rnf c 160 rnf MissingAnchorOutput = () 161 rnf (InvalidAnchorValue a) = rnf a 162 rnf (InvalidFee a b) = rnf a `seq` rnf b 163 rnf (InvalidHTLCLocktime a b) = rnf a `seq` rnf b 164 rnf (InvalidHTLCSequence a b) = rnf a `seq` rnf b 165 rnf NoOutputs = () 166 rnf (TooManyOutputs a) = rnf a 167 168 -- | Precomputed wNAF context, built once and reused across the 169 -- apostrophe-suffixed benches. NOINLINE keeps it from being 170 -- re-created on every call site. 171 tex :: S.Context 172 tex = S.precompute 173 {-# NOINLINE tex #-} 174 175 main :: IO () 176 main = defaultMain [ 177 bgroup "key derivation" [ 178 bench "derive_pubkey" $ 179 whnf (derive_pubkey basepoint) perCommitmentPoint 180 , bench "derive_pubkey'" $ 181 whnf (derive_pubkey' tex basepoint) perCommitmentPoint 182 , bench "derive_per_commitment_point" $ 183 whnf derive_per_commitment_point samplePcs 184 , bench "derive_per_commitment_point'" $ 185 whnf (derive_per_commitment_point' tex) 186 samplePcs 187 , bench "derive_revocationpubkey" $ 188 whnf (derive_revocationpubkey revocationBasepoint) perCommitmentPoint 189 ] 190 , bgroup "secret generation" [ 191 bench "generate_from_seed (final node)" $ 192 whnf (generate_from_seed seed) 281474976710655 193 , bench "generate_from_seed (first node)" $ 194 whnf (generate_from_seed seed) 0 195 ] 196 , bgroup "fee calculation" [ 197 bench "commitment_fee (no anchors, 0 htlcs)" $ 198 whnf (commitment_fee feerate noAnchors) 0 199 , bench "commitment_fee (no anchors, 10 htlcs)" $ 200 whnf (commitment_fee feerate noAnchors) 10 201 , bench "commitment_fee (anchors, 10 htlcs)" $ 202 whnf (commitment_fee feerate withAnchors) 10 203 , bench "htlc_timeout_fee" $ 204 whnf (htlc_timeout_fee feerate) noAnchors 205 , bench "htlc_success_fee" $ 206 whnf (htlc_success_fee feerate) noAnchors 207 ] 208 , bgroup "trimming" [ 209 bench "is_trimmed (offered, not trimmed)" $ 210 whnf (is_trimmed dust feerate noAnchors) htlcNotTrimmed 211 , bench "is_trimmed (offered, trimmed)" $ 212 whnf (is_trimmed dust feerate noAnchors) htlcTrimmed 213 , bench "htlc_trim_threshold (offered)" $ 214 whnf (htlc_trim_threshold dust feerate noAnchors) HTLCOffered 215 ] 216 , bgroup "tx building" [ 217 bench "build_commitment_tx (0 htlcs, no anchors)" $ 218 whnf build_commitment_tx (mkCommitmentContext htlcs0 noAnchors) 219 , bench "build_commitment_tx (10 htlcs, no anchors)" $ 220 whnf build_commitment_tx (mkCommitmentContext htlcs10 noAnchors) 221 , bench "build_commitment_tx (100 htlcs, no anchors)" $ 222 whnf build_commitment_tx (mkCommitmentContext htlcs100 noAnchors) 223 , bench "build_commitment_tx (10 htlcs, anchors)" $ 224 whnf build_commitment_tx (mkCommitmentContext htlcs10 withAnchors) 225 , bench "build_htlc_timeout_tx" $ 226 whnf build_htlc_timeout_tx sampleHtlcContext 227 , bench "build_htlc_success_tx" $ 228 whnf build_htlc_success_tx sampleHtlcContext 229 , bench "build_closing_tx" $ 230 whnf build_closing_tx sampleClosingContext 231 ] 232 , bgroup "script generation" [ 233 bench "funding_script" $ 234 whnf (funding_script (FundingPubkey samplePubkey1)) 235 (FundingPubkey samplePubkey2) 236 , bench "to_local_script" $ 237 whnf (to_local_script (RevocationPubkey samplePubkey1) 238 (ToSelfDelay 144)) 239 (LocalDelayedPubkey samplePubkey2) 240 , bench "to_remote_script (no anchors)" $ 241 whnf (to_remote_script (RemotePubkey samplePubkey1)) noAnchors 242 , bench "to_remote_script (anchors)" $ 243 whnf (to_remote_script (RemotePubkey samplePubkey1)) withAnchors 244 , bench "anchor_script" $ 245 whnf anchor_script (FundingPubkey samplePubkey1) 246 , bench "offered_htlc_script" $ 247 whnf (offered_htlc_script (RevocationPubkey samplePubkey1) 248 (RemoteHtlcPubkey samplePubkey2) 249 (LocalHtlcPubkey samplePubkey3) 250 (PaymentHash $ BS.replicate 32 0)) 251 noAnchors 252 , bench "received_htlc_script" $ 253 whnf (received_htlc_script (RevocationPubkey samplePubkey1) 254 (RemoteHtlcPubkey samplePubkey2) 255 (LocalHtlcPubkey samplePubkey3) 256 (PaymentHash $ BS.replicate 32 0) 257 (CltvExpiry 500000)) 258 noAnchors 259 ] 260 , bgroup "serialization" [ 261 env (pure $ build_commitment_tx $ mkCommitmentContext htlcs0 noAnchors) 262 $ \tx -> bench "encode_tx (0 htlcs)" $ whnf encode_tx tx 263 , env (pure $ build_commitment_tx $ mkCommitmentContext htlcs10 noAnchors) 264 $ \tx -> bench "encode_tx (10 htlcs)" $ whnf encode_tx tx 265 , env (pure $ build_commitment_tx $ mkCommitmentContext htlcs100 noAnchors) 266 $ \tx -> bench "encode_tx (100 htlcs)" $ whnf encode_tx tx 267 , bench "encode_htlc_tx" $ 268 whnf encode_htlc_tx (build_htlc_timeout_tx sampleHtlcContext) 269 , bench "encode_closing_tx" $ 270 whnf encode_closing_tx (build_closing_tx sampleClosingContext) 271 ] 272 , bgroup "parsing" [ 273 env (pure $ encodeTx0 htlcs0 noAnchors) 274 $ \bs -> bench "decode_tx (0 htlcs)" $ whnf decode_tx bs 275 , env (pure $ encodeTx0 htlcs10 noAnchors) 276 $ \bs -> bench "decode_tx (10 htlcs)" $ whnf decode_tx bs 277 , env (pure $ encodeTx0 htlcs100 noAnchors) 278 $ \bs -> bench "decode_tx (100 htlcs)" $ whnf decode_tx bs 279 ] 280 , bgroup "validation" [ 281 env (pure $ build_commitment_tx $ mkCommitmentContext htlcs10 noAnchors) 282 $ \tx -> bench "validate_commitment_tx (valid)" $ 283 whnf (validate_commitment_tx dust noAnchors) tx 284 , env (pure $ build_htlc_timeout_tx sampleHtlcContext) 285 $ \tx -> bench "validate_htlc_tx" $ 286 whnf validate_htlc_tx tx 287 , env (pure $ build_closing_tx sampleClosingContext) 288 $ \tx -> bench "validate_closing_tx" $ 289 whnf validate_closing_tx tx 290 , env (pure $ ctx_outputs $ build_commitment_tx $ 291 mkCommitmentContext htlcs10 noAnchors) 292 $ \outs -> bench "validate_output_ordering" $ 293 whnf validate_output_ordering outs 294 ] 295 , bgroup "secret storage" [ 296 bench "insert_secret (first)" $ 297 whnf (insert_secret (BS.replicate 32 0xFF) 281474976710655) 298 empty_store 299 , env setupFilledStore $ \store -> 300 bench "derive_old_secret (recent)" $ 301 whnf (derive_old_secret 281474976710654) store 302 , env setupFilledStore $ \store -> 303 bench "derive_old_secret (old)" $ 304 whnf (derive_old_secret 281474976710600) store 305 ] 306 , bgroup "output sorting" [ 307 env (pure $ ctx_outputs $ build_commitment_tx $ 308 mkCommitmentContext htlcs10 noAnchors) 309 $ \outs -> bench "sort_outputs (10)" $ nf sort_outputs outs 310 , env (pure $ ctx_outputs $ build_commitment_tx $ 311 mkCommitmentContext htlcs100 noAnchors) 312 $ \outs -> bench "sort_outputs (100)" $ nf sort_outputs outs 313 ] 314 ] 315 where 316 -- Key derivation test data 317 basepoint = Point $ BS.pack 318 [0x03, 0x6d, 0x6c, 0xaa, 0xc2, 0x48, 0xaf, 0x96, 0xf6, 0xaf, 0xa7, 319 0xf9, 0x04, 0xf5, 0x50, 0x25, 0x3a, 0x0f, 0x3e, 0xf3, 0xf5, 0xaa, 320 0x2f, 0xe6, 0x83, 0x8a, 0x95, 0xb2, 0x16, 0x69, 0x14, 0x68, 0xe2] 321 322 perCommitmentPoint = PerCommitmentPoint $ Point $ BS.pack 323 [0x02, 0x5f, 0x71, 0x17, 0xa7, 0x81, 0x50, 0xfe, 0x2e, 0xf9, 0x7d, 324 0xb7, 0xcf, 0xc8, 0x3b, 0xd5, 0x7b, 0x2e, 0x2c, 0x0d, 0x0d, 0xd2, 325 0x5e, 0xaf, 0x46, 0x7a, 0x4a, 0x1c, 0x2a, 0x45, 0xce, 0x14, 0x86] 326 327 revocationBasepoint = RevocationBasepoint $ Point $ BS.pack 328 [0x03, 0x6d, 0x6c, 0xaa, 0xc2, 0x48, 0xaf, 0x96, 0xf6, 0xaf, 0xa7, 329 0xf9, 0x04, 0xf5, 0x50, 0x25, 0x3a, 0x0f, 0x3e, 0xf3, 0xf5, 0xaa, 330 0x2f, 0xe6, 0x83, 0x8a, 0x95, 0xb2, 0x16, 0x69, 0x14, 0x68, 0xe2] 331 332 samplePcs :: PerCommitmentSecret 333 samplePcs = 334 PerCommitmentSecret (BS.replicate 32 0x01) 335 336 -- Secret generation test data 337 seed = BS.replicate 32 0xFF 338 339 -- Fee calculation test data 340 feerate = FeeratePerKw 5000 341 noAnchors = ChannelFeatures { cf_option_anchors = False } 342 withAnchors = ChannelFeatures { cf_option_anchors = True } 343 344 -- Trimming test data 345 dust = DustLimit (Satoshi 546) 346 347 htlcNotTrimmed = HTLC 348 { htlc_direction = HTLCOffered 349 , htlc_amount_msat = MilliSatoshi 5000000 350 , htlc_payment_hash = PaymentHash (BS.replicate 32 0) 351 , htlc_cltv_expiry = CltvExpiry 500000 352 } 353 354 htlcTrimmed = HTLC 355 { htlc_direction = HTLCOffered 356 , htlc_amount_msat = MilliSatoshi 1000000 357 , htlc_payment_hash = PaymentHash (BS.replicate 32 0) 358 , htlc_cltv_expiry = CltvExpiry 500000 359 } 360 361 -- Sample pubkeys 362 samplePubkey1, samplePubkey2, samplePubkey3 :: Pubkey 363 samplePubkey1 = Pubkey $ BS.pack 364 [0x03, 0x6d, 0x6c, 0xaa, 0xc2, 0x48, 0xaf, 0x96, 0xf6, 0xaf, 0xa7, 365 0xf9, 0x04, 0xf5, 0x50, 0x25, 0x3a, 0x0f, 0x3e, 0xf3, 0xf5, 0xaa, 366 0x2f, 0xe6, 0x83, 0x8a, 0x95, 0xb2, 0x16, 0x69, 0x14, 0x68, 0xe2] 367 samplePubkey2 = Pubkey $ BS.pack 368 [0x02, 0x5f, 0x71, 0x17, 0xa7, 0x81, 0x50, 0xfe, 0x2e, 0xf9, 0x7d, 369 0xb7, 0xcf, 0xc8, 0x3b, 0xd5, 0x7b, 0x2e, 0x2c, 0x0d, 0x0d, 0xd2, 370 0x5e, 0xaf, 0x46, 0x7a, 0x4a, 0x1c, 0x2a, 0x45, 0xce, 0x14, 0x86] 371 samplePubkey3 = samplePubkey1 372 373 -- Helper to encode a commitment tx for decode benchmarks 374 encodeTx0 :: [HTLC] -> ChannelFeatures -> BS.ByteString 375 encodeTx0 htlcs features = 376 case encode_tx (build_commitment_tx 377 (mkCommitmentContext htlcs features)) of 378 Nothing -> BS.empty 379 Just bs -> bs 380 381 -- Funding outpoint 382 sampleFundingOutpoint :: OutPoint 383 sampleFundingOutpoint = OutPoint (TxId $ BS.replicate 32 0x01) 0 384 385 -- HTLC lists 386 mkHtlc :: HTLCDirection -> Word64 -> Word64 -> HTLC 387 mkHtlc dir amtMsat expiry = HTLC 388 { htlc_direction = dir 389 , htlc_amount_msat = MilliSatoshi amtMsat 390 , htlc_payment_hash = PaymentHash (BS.replicate 32 0x00) 391 , htlc_cltv_expiry = CltvExpiry (fromIntegral expiry) 392 } 393 394 htlcs0, htlcs10, htlcs100 :: [HTLC] 395 htlcs0 = [] 396 htlcs10 = [mkHtlc (if even i then HTLCOffered else HTLCReceived) 397 (5000000 + i * 100000) (500000 + i) 398 | i <- [0..9]] 399 htlcs100 = [mkHtlc (if even i then HTLCOffered else HTLCReceived) 400 (5000000 + i * 10000) (500000 + i) 401 | i <- [0..99]] 402 403 -- CommitmentKeys fixture 404 sampleCommitmentKeys :: CommitmentKeys 405 sampleCommitmentKeys = CommitmentKeys 406 { ck_revocation_pubkey = RevocationPubkey samplePubkey1 407 , ck_local_delayed = LocalDelayedPubkey samplePubkey1 408 , ck_local_htlc = LocalHtlcPubkey samplePubkey1 409 , ck_remote_htlc = RemoteHtlcPubkey samplePubkey2 410 , ck_local_payment = LocalPubkey samplePubkey1 411 , ck_remote_payment = RemotePubkey samplePubkey2 412 , ck_local_funding = FundingPubkey samplePubkey1 413 , ck_remote_funding = FundingPubkey samplePubkey2 414 } 415 416 -- CommitmentContext builder 417 mkCommitmentContext :: [HTLC] -> ChannelFeatures -> CommitmentContext 418 mkCommitmentContext htlcs features = CommitmentContext 419 { cc_funding_outpoint = sampleFundingOutpoint 420 , cc_commitment_number = CommitmentNumber 42 421 , cc_local_payment_bp = 422 PaymentBasepoint $ Point $ unPubkey samplePubkey1 423 , cc_remote_payment_bp = 424 PaymentBasepoint $ Point $ unPubkey samplePubkey2 425 , cc_to_self_delay = ToSelfDelay 144 426 , cc_dust_limit = DustLimit (Satoshi 546) 427 , cc_feerate = FeeratePerKw 5000 428 , cc_features = features 429 , cc_is_funder = True 430 , cc_to_local_msat = MilliSatoshi 500000000 431 , cc_to_remote_msat = MilliSatoshi 500000000 432 , cc_htlcs = htlcs 433 , cc_keys = sampleCommitmentKeys 434 } 435 436 -- HTLC context 437 sampleHtlcContext :: HTLCContext 438 sampleHtlcContext = HTLCContext 439 { hc_commitment_txid = TxId $ BS.replicate 32 0x01 440 , hc_output_index = 0 441 , hc_htlc = mkHtlc HTLCOffered 5000000 500000 442 , hc_to_self_delay = ToSelfDelay 144 443 , hc_feerate = FeeratePerKw 5000 444 , hc_features = noAnchors 445 , hc_revocation_pubkey = RevocationPubkey samplePubkey1 446 , hc_local_delayed = LocalDelayedPubkey samplePubkey1 447 } 448 449 -- Closing context 450 sampleClosingContext :: ClosingContext 451 sampleClosingContext = ClosingContext 452 { clc_funding_outpoint = sampleFundingOutpoint 453 , clc_local_amount = Satoshi 500000 454 , clc_remote_amount = Satoshi 500000 455 , clc_local_script = 456 Script $ BS.pack [0x00, 0x14] <> BS.replicate 20 0x01 457 , clc_remote_script = 458 Script $ BS.pack [0x00, 0x14] <> BS.replicate 20 0x02 459 , clc_local_dust_limit = DustLimit (Satoshi 546) 460 , clc_remote_dust_limit = DustLimit (Satoshi 546) 461 , clc_fee = Satoshi 1000 462 , clc_is_funder = True 463 , clc_locktime = Locktime 0 464 , clc_funding_script = funding_script (FundingPubkey samplePubkey1) 465 (FundingPubkey samplePubkey2) 466 } 467 468 -- Setup for secret storage benchmarks 469 setupFilledStore :: IO SecretStore 470 setupFilledStore = do 471 let secrets = [(generate_from_seed seed i, i) 472 | i <- [281474976710655, 281474976710654 .. 281474976710600]] 473 pure $! foldl insertOrFail empty_store secrets 474 where 475 insertOrFail store (sec, idx) = 476 case insert_secret sec idx store of 477 Just s -> s 478 Nothing -> store