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