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