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