commit ae6fd0c6910f5d0d4a572a6216acf46179b6ac2b
parent 0e603abf62c98edf788d8706f96e63d037c19c34
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 10 Oct 2026 14:53:33 +0400
bench: rewrite for the new API
Benchmarks force results fully (nf), use the library's NFData
instances, and share fixtures, including a secret store holding
2^14 - 1 secrets whose next insertion checks every lower bucket.
Diffstat:
| A | bench/Fixtures.hs | | | 203 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| M | bench/Main.hs | | | 544 | +++++++++++-------------------------------------------------------------------- |
| M | bench/Weight.hs | | | 512 | ++++++++----------------------------------------------------------------------- |
| M | ppad-bolt3.cabal | | | 19 | ++++++++++++++----- |
4 files changed, 338 insertions(+), 940 deletions(-)
diff --git a/bench/Fixtures.hs b/bench/Fixtures.hs
@@ -0,0 +1,203 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Fixtures (
+ Fixtures(..)
+ , fixtures
+ , tex
+ ) where
+
+import qualified Bitcoin.Prim.Tx as BT
+import Control.DeepSeq (NFData, force)
+import Control.Exception (evaluate)
+import Control.Monad (foldM)
+import qualified Crypto.Curve.Secp256k1 as S
+import qualified Crypto.Hash.SHA256 as SHA256
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base16 as B16
+import GHC.Generics (Generic)
+import qualified Lightning.Protocol.BOLT1 as BOLT1
+import Lightning.Protocol.BOLT3
+
+-- | Shared wNAF context.
+tex :: S.Context
+tex = S.precompute
+{-# NOINLINE tex #-}
+
+data Fixtures = Fixtures
+ { fx_secret :: !BOLT1.PerCommitmentSecret
+ , fx_seed :: !Seed
+ , fx_basepoint :: !BOLT1.Point
+ , fx_pcp :: !PerCommitmentPoint
+ , fx_rbp :: !RevocationBasepoint
+ , fx_seckey :: !Seckey
+ , fx_local_bps :: !Basepoints
+ , fx_remote_bps :: !Basepoints
+ , fx_local_fund :: !FundingPubkey
+ , fx_remote_fund :: !FundingPubkey
+ , fx_store :: !SecretStore
+ , fx_store_next :: !(SecretIndex, BOLT1.PerCommitmentSecret)
+ , fx_store_oldest :: !SecretIndex
+ , fx_ctx_simple :: !CommitmentContext
+ , fx_ctx_htlcs :: !CommitmentContext
+ , fx_ctx_anchors :: !CommitmentContext
+ , fx_commit :: !CommitmentTx
+ , fx_htlc_ctx :: !HTLCContext
+ , fx_htlc_tx :: !HTLCTx
+ , fx_closing :: !ClosingContext
+ , fx_legacy :: !LegacyClosingContext
+ , fx_closing_tx :: !ClosingTx
+ } deriving Generic
+
+instance NFData Fixtures
+
+hex :: BS.ByteString -> Maybe BS.ByteString
+hex = B16.decode
+
+pt :: BS.ByteString -> Maybe BOLT1.Point
+pt h = hex h >>= BOLT1.point
+
+-- | Benchmark fixtures, from the BOLT #3 Appendix C parameters, fully
+-- evaluated.
+fixtures :: IO Fixtures
+fixtures = maybe (fail "invalid fixtures") (evaluate . force) build
+
+build :: Maybe Fixtures
+build = do
+ secret <- BOLT1.per_commitment_secret (BS.pack [31, 30 .. 0])
+ sd <- seed (BS.replicate 32 0xff)
+ basepoint <- pt
+ "036d6caac248af96f6afa7f904f550253a0f3ef3f5aa2fe6838a95b216691468e2"
+ pcp <- PerCommitmentPoint <$> pt
+ "025f7117a78150fe2ef97db7cfc83bd57b2e2c0d0dd25eaf467a4a1c2a45ce1486"
+ sk <- seckey (BS.pack [0 .. 31])
+
+ local_pay <- pt
+ "034f355bdcb7cc0af728ef3cceb9615d90684bb5b2ca5f859ab0f0b704075871aa"
+ remote_pay <- pt
+ "032c0b7cf95324a07d05398b240174dc0c2be444d96b159aa6c7f7b1e668680991"
+ local_delayed <- pt
+ "023c72addb4fdf09af94f0c94d7fe92a386a7e70cf8a1d85916386bb2535c7b1b1"
+ remote_rev <- pt
+ "02466d7fcae563e5cb09a0d1870bb580344804617879a14949cf22285f1bae3f27"
+ local_fund <- FundingPubkey <$> pt
+ "023da092f6980e58d2c037173180e9a465476026ee50f96695963e8efe436f54eb"
+ remote_fund <- FundingPubkey <$> pt
+ "030e9f7b623d2ccc7c9bd44d66d5ce21ce504c0acf6385a132cec6d3c39fa711c1"
+ let local_bps = Basepoints (RevocationBasepoint local_pay)
+ (PaymentBasepoint local_pay) (DelayedPaymentBasepoint local_delayed)
+ (HtlcBasepoint local_pay)
+ remote_bps = Basepoints (RevocationBasepoint remote_rev)
+ (PaymentBasepoint remote_pay) (DelayedPaymentBasepoint remote_pay)
+ (HtlcBasepoint remote_pay)
+ keys <- derive_commitment_keys local_bps local_fund remote_bps remote_fund
+ pcp
+
+ -- a store holding the 2^14 - 1 most recent secrets; the next index has
+ -- 14 trailing zeros, so inserting it checks every lower bucket
+ let n = 16383 :: Int
+ idxs <- traverse secret_index (take n [0xFFFFFFFFFFFF, 0xFFFFFFFFFFFE ..])
+ store <- foldM (\st i -> insert_secret (generate_from_seed sd i) i st)
+ empty_secret_store idxs
+ next <- secret_index (0xFFFFFFFFFFFF - fromIntegral n)
+ oldest <- secret_index 0xFFFFFFFFFFFF
+
+ txid <- hex
+ "8984484a580b825b9972d7adb15050b3ab624ccd731946b3eeddb92f4e7ef6be"
+ let outpoint = BT.OutPoint (BT.TxId (BS.reverse txid)) 0
+ cn <- commitment_number 42
+ dust <- DustLimit <$> BOLT1.satoshi 546
+ to_local <- BOLT1.milli_satoshi 6988000000
+ to_remote <- BOLT1.milli_satoshi 3000000000
+ htlcs <- traverse htlc
+ [ (HTLCReceived, 1000000, 500, 0x00), (HTLCReceived, 2000000, 501, 0x01)
+ , (HTLCOffered, 2000000, 502, 0x02), (HTLCOffered, 3000000, 503, 0x03)
+ , (HTLCReceived, 4000000, 504, 0x04) ]
+ let ctx_simple = CommitmentContext
+ { cc_funding_outpoint = outpoint
+ , cc_commitment_number = cn
+ , cc_local_payment_bp = PaymentBasepoint local_pay
+ , cc_remote_payment_bp = PaymentBasepoint remote_pay
+ , cc_to_self_delay = ToSelfDelay 144
+ , cc_dust_limit = dust
+ , cc_feerate = FeeratePerKw 15000
+ , cc_format = StaticRemotekey
+ , cc_is_funder = True
+ , cc_to_local_msat = to_local
+ , cc_to_remote_msat = to_remote
+ , cc_htlcs = []
+ , cc_keys = keys
+ }
+ ctx_htlcs = ctx_simple { cc_feerate = FeeratePerKw 644
+ , cc_htlcs = htlcs }
+ ctx_anchors = ctx_htlcs { cc_format = Anchors }
+ commit <- build_commitment_tx ctx_htlcs
+ htlc_out <- case htlcs of
+ (h : _) -> Just h
+ [] -> Nothing
+ let htlc_ctx = HTLCContext
+ { hc_commitment_txid = BT.txid (commitment_to_tx commit)
+ , hc_output_index = 0
+ , hc_htlc = htlc_out
+ , hc_to_self_delay = ToSelfDelay 144
+ , hc_feerate = FeeratePerKw 644
+ , hc_format = StaticRemotekey
+ , hc_revocation_pubkey = ck_revocation_pubkey keys
+ , hc_local_delayed = ck_local_delayed keys
+ }
+ htlc_tx <- build_htlc_tx htlc_ctx
+
+ fee <- BOLT1.satoshi 1000
+ let p2wpkh b = Script (BS.pack [0x00, 0x14] <> BS.replicate 20 b)
+ closing = ClosingContext
+ { clc_funding_outpoint = outpoint
+ , clc_closer_msat = to_local
+ , clc_closee_msat = to_remote
+ , clc_closer_script = p2wpkh 0x11
+ , clc_closee_script = p2wpkh 0x22
+ , clc_fee = fee
+ , clc_locktime = Locktime 0
+ , clc_outputs = CloserAndCloseeOutputs
+ }
+ legacy = LegacyClosingContext
+ { lcc_funding_outpoint = outpoint
+ , lcc_local_msat = to_local
+ , lcc_remote_msat = to_remote
+ , lcc_local_script = p2wpkh 0x11
+ , lcc_remote_script = p2wpkh 0x22
+ , lcc_dust_limit = dust
+ , lcc_fee = fee
+ , lcc_is_funder = True
+ , lcc_omit_local = False
+ }
+ closing_tx <- build_closing_tx closing
+
+ pure Fixtures
+ { fx_secret = secret
+ , fx_seed = sd
+ , fx_basepoint = basepoint
+ , fx_pcp = pcp
+ , fx_rbp = RevocationBasepoint basepoint
+ , fx_seckey = sk
+ , fx_local_bps = local_bps
+ , fx_remote_bps = remote_bps
+ , fx_local_fund = local_fund
+ , fx_remote_fund = remote_fund
+ , fx_store = store
+ , fx_store_next = (next, generate_from_seed sd next)
+ , fx_store_oldest = oldest
+ , fx_ctx_simple = ctx_simple
+ , fx_ctx_htlcs = ctx_htlcs
+ , fx_ctx_anchors = ctx_anchors
+ , fx_commit = commit
+ , fx_htlc_ctx = htlc_ctx
+ , fx_htlc_tx = htlc_tx
+ , fx_closing = closing
+ , fx_legacy = legacy
+ , fx_closing_tx = closing_tx
+ }
+ where
+ htlc (dir, amt, expiry, b) = do
+ a <- BOLT1.milli_satoshi amt
+ ph <- BOLT1.payment_hash (SHA256.hash (BS.replicate 32 b))
+ pure (HTLC dir a ph (CltvExpiry expiry))
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -1,478 +1,82 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE OverloadedStrings #-}
-
module Main where
-import qualified Crypto.Curve.Secp256k1 as S
-import Control.DeepSeq (NFData(..))
import Criterion.Main
-import Data.Word (Word64)
-import qualified Data.ByteString as BS
+import Fixtures
import Lightning.Protocol.BOLT3
-import Lightning.Protocol.BOLT3.Types
- ( Pubkey(..), Point(..)
- , PaymentHash(..), PerCommitmentPoint(..)
- , PerCommitmentSecret(..)
- , CommitmentNumber(..)
- )
-
--- NFData instances for benchmarking
--- (Satoshi, MilliSatoshi, Point, PaymentHash, PerCommitmentSecret
--- derive NFData via ppad-bolt1)
-
-instance NFData Pubkey where
- rnf (Pubkey x) = rnf x
-
-instance NFData PerCommitmentPoint where
- rnf (PerCommitmentPoint x) = rnf x
-
-instance NFData RevocationPubkey where
- rnf (RevocationPubkey x) = rnf x
-
-instance NFData RevocationBasepoint where
- rnf (RevocationBasepoint x) = rnf x
-
-instance NFData ChannelFeatures where
- rnf (ChannelFeatures x) = rnf x
-
-instance NFData FeeratePerKw where
- rnf (FeeratePerKw x) = rnf x
-
-instance NFData DustLimit where
- rnf (DustLimit x) = rnf x
-
-instance NFData CltvExpiry where
- rnf (CltvExpiry x) = rnf x
-
-instance NFData HTLCDirection where
- rnf HTLCOffered = ()
- rnf HTLCReceived = ()
-
-instance NFData HTLC where
- rnf (HTLC d a h c) = rnf d `seq` rnf a `seq` rnf h `seq` rnf c
-
--- Transaction types
-instance NFData CommitmentTx where
- rnf (CommitmentTx v l i s o f) =
- rnf v `seq` rnf l `seq` rnf i `seq` rnf s `seq` rnf o `seq` rnf f
-
-instance NFData HTLCTx where
- rnf (HTLCTx v l i s ov os) =
- rnf v `seq` rnf l `seq` rnf i `seq` rnf s `seq` rnf ov `seq` rnf os
-
-instance NFData ClosingTx where
- rnf (ClosingTx v l i s o f) =
- rnf v `seq` rnf l `seq` rnf i `seq` rnf s `seq` rnf o `seq` rnf f
-
--- Output types
-instance NFData TxOutput where
- rnf (TxOutput v s t) = rnf v `seq` rnf s `seq` rnf t
-
-instance NFData OutputType where
- rnf OutputToLocal = ()
- rnf OutputToRemote = ()
- rnf OutputLocalAnchor = ()
- rnf OutputRemoteAnchor = ()
- rnf (OutputOfferedHTLC e) = rnf e
- rnf (OutputReceivedHTLC e) = rnf e
-
--- Primitives
-instance NFData Script where
- rnf (Script bs) = rnf bs
-
-
-instance NFData Sequence where
- rnf (Sequence x) = rnf x
-
-instance NFData Locktime where
- rnf (Locktime x) = rnf x
-
-instance NFData ToSelfDelay where
- rnf (ToSelfDelay x) = rnf x
-
-instance NFData CommitmentNumber where
- rnf (CommitmentNumber x) = rnf x
-
--- Context types
-instance NFData CommitmentContext where
- rnf ctx = rnf (cc_funding_outpoint ctx) `seq`
- rnf (cc_commitment_number ctx) `seq`
- rnf (cc_htlcs ctx) `seq`
- rnf (cc_keys ctx)
-
-instance NFData CommitmentKeys where
- rnf keys = rnf (ck_revocation_pubkey keys) `seq`
- rnf (ck_local_delayed keys) `seq`
- rnf (ck_local_htlc keys) `seq`
- rnf (ck_remote_htlc keys)
-
-instance NFData HTLCContext where
- rnf ctx = rnf (hc_commitment_txid ctx) `seq`
- rnf (hc_htlc ctx)
-
-instance NFData ClosingContext where
- rnf ctx = rnf (clc_funding_outpoint ctx) `seq`
- rnf (clc_local_amount ctx) `seq`
- rnf (clc_remote_amount ctx)
-
--- Key types
-instance NFData LocalDelayedPubkey where
- rnf (LocalDelayedPubkey p) = rnf p
-
-instance NFData RemoteDelayedPubkey where
- rnf (RemoteDelayedPubkey p) = rnf p
-
-instance NFData LocalHtlcPubkey where
- rnf (LocalHtlcPubkey p) = rnf p
-
-instance NFData RemoteHtlcPubkey where
- rnf (RemoteHtlcPubkey p) = rnf p
-
-instance NFData LocalPubkey where
- rnf (LocalPubkey p) = rnf p
-
-instance NFData RemotePubkey where
- rnf (RemotePubkey p) = rnf p
-
-instance NFData PaymentBasepoint where
- rnf (PaymentBasepoint p) = rnf p
-
-instance NFData DelayedPaymentBasepoint where
- rnf (DelayedPaymentBasepoint p) = rnf p
-
-instance NFData HtlcBasepoint where
- rnf (HtlcBasepoint p) = rnf p
-
-instance NFData FundingPubkey where
- rnf (FundingPubkey p) = rnf p
-
--- Secret storage (SecretStore is a newtype over list)
-instance NFData SecretStore where
- rnf store = rnf (derive_old_secret 0 store)
-
--- Validation errors
-instance NFData ValidationError where
- rnf (InvalidVersion a b) = rnf a `seq` rnf b
- rnf (InvalidLocktime a) = rnf a
- rnf (InvalidSequence a) = rnf a
- rnf InvalidOutputOrdering = ()
- rnf (DustLimitViolation a b c) = rnf a `seq` rnf b `seq` rnf c
- rnf MissingAnchorOutput = ()
- rnf (InvalidAnchorValue a) = rnf a
- rnf (InvalidFee a b) = rnf a `seq` rnf b
- rnf (InvalidHTLCLocktime a b) = rnf a `seq` rnf b
- rnf (InvalidHTLCSequence a b) = rnf a `seq` rnf b
- rnf NoOutputs = ()
- rnf (TooManyOutputs a) = rnf a
-
--- | Precomputed wNAF context, built once and reused across the
--- apostrophe-suffixed benches. NOINLINE keeps it from being
--- re-created on every call site.
-tex :: S.Context
-tex = S.precompute
-{-# NOINLINE tex #-}
main :: IO ()
-main = defaultMain [
- bgroup "key derivation" [
- bench "derive_pubkey" $
- whnf (derive_pubkey basepoint) perCommitmentPoint
- , bench "derive_pubkey'" $
- whnf (derive_pubkey' tex basepoint) perCommitmentPoint
- , bench "derive_per_commitment_point" $
- whnf derive_per_commitment_point samplePcs
- , bench "derive_per_commitment_point'" $
- whnf (derive_per_commitment_point' tex)
- samplePcs
- , bench "derive_revocationpubkey" $
- whnf (derive_revocationpubkey revocationBasepoint) perCommitmentPoint
- ]
- , bgroup "secret generation" [
- bench "generate_from_seed (final node)" $
- whnf (generate_from_seed seed) 281474976710655
- , bench "generate_from_seed (first node)" $
- whnf (generate_from_seed seed) 0
- ]
- , bgroup "fee calculation" [
- bench "commitment_fee (no anchors, 0 htlcs)" $
- whnf (commitment_fee feerate noAnchors) 0
- , bench "commitment_fee (no anchors, 10 htlcs)" $
- whnf (commitment_fee feerate noAnchors) 10
- , bench "commitment_fee (anchors, 10 htlcs)" $
- whnf (commitment_fee feerate withAnchors) 10
- , bench "htlc_timeout_fee" $
- whnf (htlc_timeout_fee feerate) noAnchors
- , bench "htlc_success_fee" $
- whnf (htlc_success_fee feerate) noAnchors
- ]
- , bgroup "trimming" [
- bench "is_trimmed (offered, not trimmed)" $
- whnf (is_trimmed dust feerate noAnchors) htlcNotTrimmed
- , bench "is_trimmed (offered, trimmed)" $
- whnf (is_trimmed dust feerate noAnchors) htlcTrimmed
- , bench "htlc_trim_threshold (offered)" $
- whnf (htlc_trim_threshold dust feerate noAnchors) HTLCOffered
+main = do
+ fx <- fixtures
+ let (next_idx, next_secret) = fx_store_next fx
+ keys = ck fx
+ defaultMain [
+ bgroup "keys" [
+ bench "derive_per_commitment_point" $
+ nf derive_per_commitment_point (fx_secret fx)
+ , bench "derive_per_commitment_point'" $
+ nf (derive_per_commitment_point' tex) (fx_secret fx)
+ , bench "derive_pubkey" $
+ nf (derive_pubkey (fx_basepoint fx)) (fx_pcp fx)
+ , bench "derive_revocationpubkey" $
+ nf (derive_revocationpubkey (fx_rbp fx)) (fx_pcp fx)
+ , bench "derive_commitment_keys" $
+ nf (derive_commitment_keys (fx_local_bps fx) (fx_local_fund fx)
+ (fx_remote_bps fx) (fx_remote_fund fx)) (fx_pcp fx)
+ , bench "derive_commitment_keys'" $
+ nf (derive_commitment_keys' tex (fx_local_bps fx) (fx_local_fund fx)
+ (fx_remote_bps fx) (fx_remote_fund fx)) (fx_pcp fx)
+ , bench "derive_privkey" $
+ nf (derive_privkey (fx_seckey fx)) (fx_pcp fx)
+ , bench "derive_revocationprivkey" $
+ nf (derive_revocationprivkey (fx_seckey fx)) (fx_secret fx)
+ ]
+ , bgroup "secrets" [
+ bench "generate_from_seed (index 2^48 - 1)" $
+ nf (generate_from_seed (fx_seed fx)) (fx_store_oldest fx)
+ , bench "insert_secret (14 lower buckets)" $
+ nf (insert_secret next_secret next_idx) (fx_store fx)
+ , bench "derive_old_secret (index 2^48 - 1)" $
+ nf (derive_old_secret (fx_store_oldest fx)) (fx_store fx)
+ , bench "secret_store . un_secret_store" $
+ nf (secret_store . un_secret_store) (fx_store fx)
+ ]
+ , bgroup "scripts" [
+ bench "funding_script" $
+ nf (funding_script (fx_local_fund fx)) (fx_remote_fund fx)
+ , bench "to_local_script" $
+ nf (to_local_script (ck_revocation_pubkey keys) (ToSelfDelay 144))
+ (ck_local_delayed keys)
+ , bench "offered_htlc_script" $
+ nf (offered_htlc_script (ck_revocation_pubkey keys)
+ (ck_remote_htlc keys) (ck_local_htlc keys) (hash fx))
+ Anchors
+ , bench "received_htlc_script" $
+ nf (received_htlc_script (ck_revocation_pubkey keys)
+ (ck_remote_htlc keys) (ck_local_htlc keys) (hash fx)
+ (CltvExpiry 500))
+ Anchors
+ ]
+ , bgroup "transactions" [
+ bench "build_commitment_tx (no htlcs)" $
+ nf build_commitment_tx (fx_ctx_simple fx)
+ , bench "build_commitment_tx (5 htlcs)" $
+ nf build_commitment_tx (fx_ctx_htlcs fx)
+ , bench "build_commitment_tx (5 htlcs, anchors)" $
+ nf build_commitment_tx (fx_ctx_anchors fx)
+ , bench "encode_commitment_tx (5 htlcs)" $
+ nf encode_commitment_tx (fx_commit fx)
+ , bench "build_htlc_tx" $
+ nf build_htlc_tx (fx_htlc_ctx fx)
+ , bench "encode_htlc_tx" $
+ nf encode_htlc_tx (fx_htlc_tx fx)
+ , bench "build_closing_tx" $
+ nf build_closing_tx (fx_closing fx)
+ , bench "build_legacy_closing_tx" $
+ nf build_legacy_closing_tx (fx_legacy fx)
+ , bench "encode_closing_tx" $
+ nf encode_closing_tx (fx_closing_tx fx)
+ ]
]
- , bgroup "tx building" [
- bench "build_commitment_tx (0 htlcs, no anchors)" $
- whnf build_commitment_tx (mkCommitmentContext htlcs0 noAnchors)
- , bench "build_commitment_tx (10 htlcs, no anchors)" $
- whnf build_commitment_tx (mkCommitmentContext htlcs10 noAnchors)
- , bench "build_commitment_tx (100 htlcs, no anchors)" $
- whnf build_commitment_tx (mkCommitmentContext htlcs100 noAnchors)
- , bench "build_commitment_tx (10 htlcs, anchors)" $
- whnf build_commitment_tx (mkCommitmentContext htlcs10 withAnchors)
- , bench "build_htlc_timeout_tx" $
- whnf build_htlc_timeout_tx sampleHtlcContext
- , bench "build_htlc_success_tx" $
- whnf build_htlc_success_tx sampleHtlcContext
- , bench "build_closing_tx" $
- whnf build_closing_tx sampleClosingContext
- ]
- , bgroup "script generation" [
- bench "funding_script" $
- whnf (funding_script (FundingPubkey samplePubkey1))
- (FundingPubkey samplePubkey2)
- , bench "to_local_script" $
- whnf (to_local_script (RevocationPubkey samplePubkey1)
- (ToSelfDelay 144))
- (LocalDelayedPubkey samplePubkey2)
- , bench "to_remote_script (no anchors)" $
- whnf (to_remote_script (RemotePubkey samplePubkey1)) noAnchors
- , bench "to_remote_script (anchors)" $
- whnf (to_remote_script (RemotePubkey samplePubkey1)) withAnchors
- , bench "anchor_script" $
- whnf anchor_script (FundingPubkey samplePubkey1)
- , bench "offered_htlc_script" $
- whnf (offered_htlc_script (RevocationPubkey samplePubkey1)
- (RemoteHtlcPubkey samplePubkey2)
- (LocalHtlcPubkey samplePubkey3)
- (PaymentHash $ BS.replicate 32 0))
- noAnchors
- , bench "received_htlc_script" $
- whnf (received_htlc_script (RevocationPubkey samplePubkey1)
- (RemoteHtlcPubkey samplePubkey2)
- (LocalHtlcPubkey samplePubkey3)
- (PaymentHash $ BS.replicate 32 0)
- (CltvExpiry 500000))
- noAnchors
- ]
- , bgroup "serialization" [
- env (pure $ build_commitment_tx $ mkCommitmentContext htlcs0 noAnchors)
- $ \tx -> bench "encode_tx (0 htlcs)" $ whnf encode_tx tx
- , env (pure $ build_commitment_tx $ mkCommitmentContext htlcs10 noAnchors)
- $ \tx -> bench "encode_tx (10 htlcs)" $ whnf encode_tx tx
- , env (pure $ build_commitment_tx $ mkCommitmentContext htlcs100 noAnchors)
- $ \tx -> bench "encode_tx (100 htlcs)" $ whnf encode_tx tx
- , bench "encode_htlc_tx" $
- whnf encode_htlc_tx (build_htlc_timeout_tx sampleHtlcContext)
- , bench "encode_closing_tx" $
- whnf encode_closing_tx (build_closing_tx sampleClosingContext)
- ]
- , bgroup "parsing" [
- env (pure $ encodeTx0 htlcs0 noAnchors)
- $ \bs -> bench "decode_tx (0 htlcs)" $ whnf decode_tx bs
- , env (pure $ encodeTx0 htlcs10 noAnchors)
- $ \bs -> bench "decode_tx (10 htlcs)" $ whnf decode_tx bs
- , env (pure $ encodeTx0 htlcs100 noAnchors)
- $ \bs -> bench "decode_tx (100 htlcs)" $ whnf decode_tx bs
- ]
- , bgroup "validation" [
- env (pure $ build_commitment_tx $ mkCommitmentContext htlcs10 noAnchors)
- $ \tx -> bench "validate_commitment_tx (valid)" $
- whnf (validate_commitment_tx dust noAnchors) tx
- , env (pure $ build_htlc_timeout_tx sampleHtlcContext)
- $ \tx -> bench "validate_htlc_tx" $
- whnf validate_htlc_tx tx
- , env (pure $ build_closing_tx sampleClosingContext)
- $ \tx -> bench "validate_closing_tx" $
- whnf validate_closing_tx tx
- , env (pure $ ctx_outputs $ build_commitment_tx $
- mkCommitmentContext htlcs10 noAnchors)
- $ \outs -> bench "validate_output_ordering" $
- whnf validate_output_ordering outs
- ]
- , bgroup "secret storage" [
- bench "insert_secret (first)" $
- whnf (insert_secret (BS.replicate 32 0xFF) 281474976710655)
- empty_store
- , env setupFilledStore $ \store ->
- bench "derive_old_secret (recent)" $
- whnf (derive_old_secret 281474976710654) store
- , env setupFilledStore $ \store ->
- bench "derive_old_secret (old)" $
- whnf (derive_old_secret 281474976710600) store
- ]
- , bgroup "output sorting" [
- env (pure $ ctx_outputs $ build_commitment_tx $
- mkCommitmentContext htlcs10 noAnchors)
- $ \outs -> bench "sort_outputs (10)" $ nf sort_outputs outs
- , env (pure $ ctx_outputs $ build_commitment_tx $
- mkCommitmentContext htlcs100 noAnchors)
- $ \outs -> bench "sort_outputs (100)" $ nf sort_outputs outs
- ]
- ]
where
- -- Key derivation test data
- basepoint = Point $ BS.pack
- [0x03, 0x6d, 0x6c, 0xaa, 0xc2, 0x48, 0xaf, 0x96, 0xf6, 0xaf, 0xa7,
- 0xf9, 0x04, 0xf5, 0x50, 0x25, 0x3a, 0x0f, 0x3e, 0xf3, 0xf5, 0xaa,
- 0x2f, 0xe6, 0x83, 0x8a, 0x95, 0xb2, 0x16, 0x69, 0x14, 0x68, 0xe2]
-
- perCommitmentPoint = PerCommitmentPoint $ Point $ BS.pack
- [0x02, 0x5f, 0x71, 0x17, 0xa7, 0x81, 0x50, 0xfe, 0x2e, 0xf9, 0x7d,
- 0xb7, 0xcf, 0xc8, 0x3b, 0xd5, 0x7b, 0x2e, 0x2c, 0x0d, 0x0d, 0xd2,
- 0x5e, 0xaf, 0x46, 0x7a, 0x4a, 0x1c, 0x2a, 0x45, 0xce, 0x14, 0x86]
-
- revocationBasepoint = RevocationBasepoint $ Point $ BS.pack
- [0x03, 0x6d, 0x6c, 0xaa, 0xc2, 0x48, 0xaf, 0x96, 0xf6, 0xaf, 0xa7,
- 0xf9, 0x04, 0xf5, 0x50, 0x25, 0x3a, 0x0f, 0x3e, 0xf3, 0xf5, 0xaa,
- 0x2f, 0xe6, 0x83, 0x8a, 0x95, 0xb2, 0x16, 0x69, 0x14, 0x68, 0xe2]
-
- samplePcs :: PerCommitmentSecret
- samplePcs =
- PerCommitmentSecret (BS.replicate 32 0x01)
-
- -- Secret generation test data
- seed = BS.replicate 32 0xFF
-
- -- Fee calculation test data
- feerate = FeeratePerKw 5000
- noAnchors = ChannelFeatures { cf_option_anchors = False }
- withAnchors = ChannelFeatures { cf_option_anchors = True }
-
- -- Trimming test data
- dust = DustLimit (Satoshi 546)
-
- htlcNotTrimmed = HTLC
- { htlc_direction = HTLCOffered
- , htlc_amount_msat = MilliSatoshi 5000000
- , htlc_payment_hash = PaymentHash (BS.replicate 32 0)
- , htlc_cltv_expiry = CltvExpiry 500000
- }
-
- htlcTrimmed = HTLC
- { htlc_direction = HTLCOffered
- , htlc_amount_msat = MilliSatoshi 1000000
- , htlc_payment_hash = PaymentHash (BS.replicate 32 0)
- , htlc_cltv_expiry = CltvExpiry 500000
- }
-
- -- Sample pubkeys
- samplePubkey1, samplePubkey2, samplePubkey3 :: Pubkey
- samplePubkey1 = Pubkey $ BS.pack
- [0x03, 0x6d, 0x6c, 0xaa, 0xc2, 0x48, 0xaf, 0x96, 0xf6, 0xaf, 0xa7,
- 0xf9, 0x04, 0xf5, 0x50, 0x25, 0x3a, 0x0f, 0x3e, 0xf3, 0xf5, 0xaa,
- 0x2f, 0xe6, 0x83, 0x8a, 0x95, 0xb2, 0x16, 0x69, 0x14, 0x68, 0xe2]
- samplePubkey2 = Pubkey $ BS.pack
- [0x02, 0x5f, 0x71, 0x17, 0xa7, 0x81, 0x50, 0xfe, 0x2e, 0xf9, 0x7d,
- 0xb7, 0xcf, 0xc8, 0x3b, 0xd5, 0x7b, 0x2e, 0x2c, 0x0d, 0x0d, 0xd2,
- 0x5e, 0xaf, 0x46, 0x7a, 0x4a, 0x1c, 0x2a, 0x45, 0xce, 0x14, 0x86]
- samplePubkey3 = samplePubkey1
-
- -- Helper to encode a commitment tx for decode benchmarks
- encodeTx0 :: [HTLC] -> ChannelFeatures -> BS.ByteString
- encodeTx0 htlcs features =
- case encode_tx (build_commitment_tx
- (mkCommitmentContext htlcs features)) of
- Nothing -> BS.empty
- Just bs -> bs
-
- -- Funding outpoint
- sampleFundingOutpoint :: OutPoint
- sampleFundingOutpoint = OutPoint (TxId $ BS.replicate 32 0x01) 0
-
- -- HTLC lists
- mkHtlc :: HTLCDirection -> Word64 -> Word64 -> HTLC
- mkHtlc dir amtMsat expiry = HTLC
- { htlc_direction = dir
- , htlc_amount_msat = MilliSatoshi amtMsat
- , htlc_payment_hash = PaymentHash (BS.replicate 32 0x00)
- , htlc_cltv_expiry = CltvExpiry (fromIntegral expiry)
- }
-
- htlcs0, htlcs10, htlcs100 :: [HTLC]
- htlcs0 = []
- htlcs10 = [mkHtlc (if even i then HTLCOffered else HTLCReceived)
- (5000000 + i * 100000) (500000 + i)
- | i <- [0..9]]
- htlcs100 = [mkHtlc (if even i then HTLCOffered else HTLCReceived)
- (5000000 + i * 10000) (500000 + i)
- | i <- [0..99]]
-
- -- CommitmentKeys fixture
- sampleCommitmentKeys :: CommitmentKeys
- sampleCommitmentKeys = CommitmentKeys
- { ck_revocation_pubkey = RevocationPubkey samplePubkey1
- , ck_local_delayed = LocalDelayedPubkey samplePubkey1
- , ck_local_htlc = LocalHtlcPubkey samplePubkey1
- , ck_remote_htlc = RemoteHtlcPubkey samplePubkey2
- , ck_local_payment = LocalPubkey samplePubkey1
- , ck_remote_payment = RemotePubkey samplePubkey2
- , ck_local_funding = FundingPubkey samplePubkey1
- , ck_remote_funding = FundingPubkey samplePubkey2
- }
-
- -- CommitmentContext builder
- mkCommitmentContext :: [HTLC] -> ChannelFeatures -> CommitmentContext
- mkCommitmentContext htlcs features = CommitmentContext
- { cc_funding_outpoint = sampleFundingOutpoint
- , cc_commitment_number = CommitmentNumber 42
- , cc_local_payment_bp =
- PaymentBasepoint $ Point $ unPubkey samplePubkey1
- , cc_remote_payment_bp =
- PaymentBasepoint $ Point $ unPubkey samplePubkey2
- , cc_to_self_delay = ToSelfDelay 144
- , cc_dust_limit = DustLimit (Satoshi 546)
- , cc_feerate = FeeratePerKw 5000
- , cc_features = features
- , cc_is_funder = True
- , cc_to_local_msat = MilliSatoshi 500000000
- , cc_to_remote_msat = MilliSatoshi 500000000
- , cc_htlcs = htlcs
- , cc_keys = sampleCommitmentKeys
- }
-
- -- HTLC context
- sampleHtlcContext :: HTLCContext
- sampleHtlcContext = HTLCContext
- { hc_commitment_txid = TxId $ BS.replicate 32 0x01
- , hc_output_index = 0
- , hc_htlc = mkHtlc HTLCOffered 5000000 500000
- , hc_to_self_delay = ToSelfDelay 144
- , hc_feerate = FeeratePerKw 5000
- , hc_features = noAnchors
- , hc_revocation_pubkey = RevocationPubkey samplePubkey1
- , hc_local_delayed = LocalDelayedPubkey samplePubkey1
- }
-
- -- Closing context
- sampleClosingContext :: ClosingContext
- sampleClosingContext = ClosingContext
- { clc_funding_outpoint = sampleFundingOutpoint
- , clc_local_amount = Satoshi 500000
- , clc_remote_amount = Satoshi 500000
- , clc_local_script =
- Script $ BS.pack [0x00, 0x14] <> BS.replicate 20 0x01
- , clc_remote_script =
- Script $ BS.pack [0x00, 0x14] <> BS.replicate 20 0x02
- , clc_local_dust_limit = DustLimit (Satoshi 546)
- , clc_remote_dust_limit = DustLimit (Satoshi 546)
- , clc_fee = Satoshi 1000
- , clc_is_funder = True
- , clc_locktime = Locktime 0
- , clc_funding_script = funding_script (FundingPubkey samplePubkey1)
- (FundingPubkey samplePubkey2)
- }
-
- -- Setup for secret storage benchmarks
- setupFilledStore :: IO SecretStore
- setupFilledStore = do
- let secrets = [(generate_from_seed seed i, i)
- | i <- [281474976710655, 281474976710654 .. 281474976710600]]
- pure $! foldl insertOrFail empty_store secrets
- where
- insertOrFail store (sec, idx) =
- case insert_secret sec idx store of
- Just s -> s
- Nothing -> store
+ ck = cc_keys . fx_ctx_simple
+ hash = htlc_payment_hash . hc_htlc . fx_htlc_ctx
diff --git a/bench/Weight.hs b/bench/Weight.hs
@@ -1,471 +1,53 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE OverloadedStrings #-}
-
module Main where
-import qualified Crypto.Curve.Secp256k1 as S
-import Control.DeepSeq (NFData(..))
-import qualified Data.ByteString as BS
-import Data.Word (Word32, Word64)
+import Fixtures
import Lightning.Protocol.BOLT3
-import Lightning.Protocol.BOLT3.Types
- ( Pubkey(..), Point(..)
- , PaymentHash(..), PerCommitmentPoint(..)
- , PerCommitmentSecret(..)
- , CommitmentNumber(..)
- )
import Weigh
--- | Precomputed wNAF context; reused across every apostrophe-
--- suffixed weigh entry.
-tex :: S.Context
-tex = S.precompute
-{-# NOINLINE tex #-}
-
--- NFData instances for weigh
--- (Satoshi, MilliSatoshi, Point, PaymentHash, PerCommitmentSecret
--- derive NFData via ppad-bolt1)
-
-instance NFData Pubkey where
- rnf (Pubkey x) = rnf x
-
-instance NFData PerCommitmentPoint where
- rnf (PerCommitmentPoint x) = rnf x
-
-instance NFData RevocationPubkey where
- rnf (RevocationPubkey x) = rnf x
-
-instance NFData RevocationBasepoint where
- rnf (RevocationBasepoint x) = rnf x
-
-instance NFData LocalDelayedPubkey where
- rnf (LocalDelayedPubkey p) = rnf p
-
-instance NFData RemoteDelayedPubkey where
- rnf (RemoteDelayedPubkey p) = rnf p
-
-instance NFData LocalHtlcPubkey where
- rnf (LocalHtlcPubkey p) = rnf p
-
-instance NFData RemoteHtlcPubkey where
- rnf (RemoteHtlcPubkey p) = rnf p
-
-instance NFData LocalPubkey where
- rnf (LocalPubkey p) = rnf p
-
-instance NFData RemotePubkey where
- rnf (RemotePubkey p) = rnf p
-
-instance NFData PaymentBasepoint where
- rnf (PaymentBasepoint p) = rnf p
-
-instance NFData DelayedPaymentBasepoint where
- rnf (DelayedPaymentBasepoint p) = rnf p
-
-instance NFData HtlcBasepoint where
- rnf (HtlcBasepoint p) = rnf p
-
-instance NFData FundingPubkey where
- rnf (FundingPubkey p) = rnf p
-
--- Channel features
-instance NFData ChannelFeatures where
- rnf (ChannelFeatures x) = rnf x
-
-instance NFData FeeratePerKw where
- rnf (FeeratePerKw x) = rnf x
-
-instance NFData DustLimit where
- rnf (DustLimit x) = rnf x
-
--- Hash types
-instance NFData CltvExpiry where
- rnf (CltvExpiry x) = rnf x
-
--- HTLC types
-instance NFData HTLCDirection where
- rnf HTLCOffered = ()
- rnf HTLCReceived = ()
-
-instance NFData HTLC where
- rnf (HTLC d a h c) = rnf d `seq` rnf a `seq` rnf h `seq` rnf c
-
--- Transaction types
-instance NFData CommitmentTx where
- rnf (CommitmentTx v l i s o f) =
- rnf v `seq` rnf l `seq` rnf i `seq` rnf s `seq` rnf o `seq` rnf f
-
-instance NFData HTLCTx where
- rnf (HTLCTx v l i s ov os) =
- rnf v `seq` rnf l `seq` rnf i `seq` rnf s `seq` rnf ov `seq` rnf os
-
-instance NFData ClosingTx where
- rnf (ClosingTx v l i s o f) =
- rnf v `seq` rnf l `seq` rnf i `seq` rnf s `seq` rnf o `seq` rnf f
-
--- Output types
-instance NFData TxOutput where
- rnf (TxOutput v s t) = rnf v `seq` rnf s `seq` rnf t
-
-instance NFData OutputType where
- rnf OutputToLocal = ()
- rnf OutputToRemote = ()
- rnf OutputLocalAnchor = ()
- rnf OutputRemoteAnchor = ()
- rnf (OutputOfferedHTLC e) = rnf e
- rnf (OutputReceivedHTLC e) = rnf e
-
--- Primitives
-instance NFData Script where
- rnf (Script bs) = rnf bs
-
-
-instance NFData Sequence where
- rnf (Sequence x) = rnf x
-
-instance NFData Locktime where
- rnf (Locktime x) = rnf x
-
-instance NFData ToSelfDelay where
- rnf (ToSelfDelay x) = rnf x
-
-instance NFData CommitmentNumber where
- rnf (CommitmentNumber x) = rnf x
-
--- Context types
-instance NFData CommitmentContext where
- rnf ctx = rnf (cc_funding_outpoint ctx) `seq`
- rnf (cc_commitment_number ctx) `seq`
- rnf (cc_htlcs ctx) `seq`
- rnf (cc_keys ctx)
-
-instance NFData CommitmentKeys where
- rnf keys = rnf (ck_revocation_pubkey keys) `seq`
- rnf (ck_local_delayed keys) `seq`
- rnf (ck_local_htlc keys) `seq`
- rnf (ck_remote_htlc keys)
-
-instance NFData HTLCContext where
- rnf ctx = rnf (hc_commitment_txid ctx) `seq`
- rnf (hc_htlc ctx)
-
-instance NFData ClosingContext where
- rnf ctx = rnf (clc_funding_outpoint ctx) `seq`
- rnf (clc_local_amount ctx) `seq`
- rnf (clc_remote_amount ctx)
-
-instance NFData ValidationError where
- rnf (InvalidVersion e a) = rnf e `seq` rnf a
- rnf (InvalidLocktime lt) = rnf lt
- rnf (InvalidSequence sq) = rnf sq
- rnf InvalidOutputOrdering = ()
- rnf (DustLimitViolation i v d) = rnf i `seq` rnf v `seq` rnf d
- rnf MissingAnchorOutput = ()
- rnf (InvalidAnchorValue v) = rnf v
- rnf (InvalidFee e a) = rnf e `seq` rnf a
- rnf (InvalidHTLCLocktime e a) = rnf e `seq` rnf a
- rnf (InvalidHTLCSequence e a) = rnf e `seq` rnf a
- rnf NoOutputs = ()
- rnf (TooManyOutputs n) = rnf n
-
--- Secret store (opaque, use generic rnf on the list)
-instance NFData SecretStore where
- rnf ss = ss `seq` ()
-
main :: IO ()
-main = tex `seq` mainWith $ do
- -- 'tex' is forced before mainWith so the one-time wNAF
- -- precompute (~50 KB) doesn't get billed to whichever
- -- apostrophe-suffixed func happens to evaluate it first.
- setColumns [Case, Allocated, GCs, Max]
-
- -- Key derivation allocations
- func "derive_pubkey" (derive_pubkey basepoint) perCommitmentPoint
- func "derive_pubkey'"
- (derive_pubkey' tex basepoint) perCommitmentPoint
- func "derive_per_commitment_point"
- derive_per_commitment_point samplePcs
- func "derive_per_commitment_point'"
- (derive_per_commitment_point' tex) samplePcs
- func "derive_revocationpubkey"
- (derive_revocationpubkey revocationBasepoint) perCommitmentPoint
-
- -- Secret generation allocations
- func "generate_from_seed (final)" (generate_from_seed seed) 281474976710655
- func "generate_from_seed (first)" (generate_from_seed seed) 0
-
- -- Fee calculation allocations
- func "commitment_fee (0 htlcs)" (commitment_fee feerate noAnchors) 0
- func "commitment_fee (10 htlcs)" (commitment_fee feerate noAnchors) 10
- func "htlc_timeout_fee" (htlc_timeout_fee feerate) noAnchors
- func "htlc_success_fee" (htlc_success_fee feerate) noAnchors
-
- -- Trimming allocations
- func "is_trimmed (not trimmed)"
- (is_trimmed dust feerate noAnchors) htlcNotTrimmed
- func "is_trimmed (trimmed)"
- (is_trimmed dust feerate noAnchors) htlcTrimmed
- func "htlc_trim_threshold"
- (htlc_trim_threshold dust feerate noAnchors) HTLCOffered
-
- -- Transaction building allocations
- func "build_commitment_tx (0 htlcs, no anchors)"
- build_commitment_tx (mkCommitmentContext htlcs0 noAnchors)
- func "build_commitment_tx (10 htlcs, no anchors)"
- build_commitment_tx (mkCommitmentContext htlcs10 noAnchors)
- func "build_commitment_tx (100 htlcs, no anchors)"
- build_commitment_tx (mkCommitmentContext htlcs100 noAnchors)
- func "build_commitment_tx (10 htlcs, anchors)"
- build_commitment_tx (mkCommitmentContext htlcs10 withAnchors)
- func "build_htlc_timeout_tx"
- build_htlc_timeout_tx sampleHtlcContext
- func "build_htlc_success_tx"
- build_htlc_success_tx sampleHtlcContext
- func "build_closing_tx"
- build_closing_tx sampleClosingContext
-
- -- Script generation allocations
- func "funding_script"
- (funding_script (FundingPubkey samplePubkey1))
- (FundingPubkey samplePubkey2)
- func "to_local_script"
- (to_local_script (RevocationPubkey samplePubkey1)
- (ToSelfDelay 144))
- (LocalDelayedPubkey samplePubkey2)
- func "to_remote_script (no anchors)"
- (to_remote_script (RemotePubkey samplePubkey1)) noAnchors
- func "to_remote_script (anchors)"
- (to_remote_script (RemotePubkey samplePubkey1)) withAnchors
- func "anchor_script"
- anchor_script (FundingPubkey samplePubkey1)
- func "offered_htlc_script"
- (offered_htlc_script (RevocationPubkey samplePubkey1)
- (RemoteHtlcPubkey samplePubkey2)
- (LocalHtlcPubkey samplePubkey3)
- (PaymentHash $ BS.replicate 32 0))
- noAnchors
- func "received_htlc_script"
- (received_htlc_script (RevocationPubkey samplePubkey1)
- (RemoteHtlcPubkey samplePubkey2)
- (LocalHtlcPubkey samplePubkey3)
- (PaymentHash $ BS.replicate 32 0)
- (CltvExpiry 500000))
- noAnchors
-
- -- Serialization allocations
- func "encode_tx (0 htlcs)"
- encode_tx (build_commitment_tx $
- mkCommitmentContext htlcs0 noAnchors)
- func "encode_tx (10 htlcs)"
- encode_tx (build_commitment_tx $
- mkCommitmentContext htlcs10 noAnchors)
- func "encode_tx (100 htlcs)"
- encode_tx (build_commitment_tx $
- mkCommitmentContext htlcs100 noAnchors)
- func "encode_htlc_tx"
- encode_htlc_tx (build_htlc_timeout_tx sampleHtlcContext)
- func "encode_closing_tx"
- encode_closing_tx (build_closing_tx sampleClosingContext)
-
- -- Parsing allocations
- func "decode_tx (0 htlcs)"
- decode_tx (encodeTx0 htlcs0 noAnchors)
- func "decode_tx (10 htlcs)"
- decode_tx (encodeTx0 htlcs10 noAnchors)
- func "decode_tx (100 htlcs)"
- decode_tx (encodeTx0 htlcs100 noAnchors)
-
- -- Validation allocations
- func "validate_commitment_tx (valid)"
- (validate_commitment_tx dust noAnchors)
- (build_commitment_tx $ mkCommitmentContext htlcs10 noAnchors)
- func "validate_htlc_tx"
- validate_htlc_tx (build_htlc_timeout_tx sampleHtlcContext)
- func "validate_closing_tx"
- validate_closing_tx (build_closing_tx sampleClosingContext)
- func "validate_output_ordering"
- validate_output_ordering (ctx_outputs $ build_commitment_tx $
- mkCommitmentContext htlcs10 noAnchors)
-
- -- Secret storage allocations
- func "insert_secret (first)"
- (insert_secret (BS.replicate 32 0xFF) 281474976710655)
- empty_store
- func "derive_old_secret (recent)"
- (derive_old_secret 281474976710654)
- filledStore
- func "derive_old_secret (old)"
- (derive_old_secret 281474976710600)
- filledStore
-
- -- Output sorting allocations
- func "sort_outputs (10)"
- sort_outputs (ctx_outputs $ build_commitment_tx $
- mkCommitmentContext htlcs10 noAnchors)
- func "sort_outputs (100)"
- sort_outputs (ctx_outputs $ build_commitment_tx $
- mkCommitmentContext htlcs100 noAnchors)
-
- where
- -- Key derivation test data
- basepoint = Point $ BS.pack
- [0x03, 0x6d, 0x6c, 0xaa, 0xc2, 0x48, 0xaf, 0x96, 0xf6, 0xaf, 0xa7,
- 0xf9, 0x04, 0xf5, 0x50, 0x25, 0x3a, 0x0f, 0x3e, 0xf3, 0xf5, 0xaa,
- 0x2f, 0xe6, 0x83, 0x8a, 0x95, 0xb2, 0x16, 0x69, 0x14, 0x68, 0xe2]
-
- perCommitmentPoint = PerCommitmentPoint $ Point $ BS.pack
- [0x02, 0x5f, 0x71, 0x17, 0xa7, 0x81, 0x50, 0xfe, 0x2e, 0xf9, 0x7d,
- 0xb7, 0xcf, 0xc8, 0x3b, 0xd5, 0x7b, 0x2e, 0x2c, 0x0d, 0x0d, 0xd2,
- 0x5e, 0xaf, 0x46, 0x7a, 0x4a, 0x1c, 0x2a, 0x45, 0xce, 0x14, 0x86]
-
- revocationBasepoint = RevocationBasepoint $ Point $ BS.pack
- [0x03, 0x6d, 0x6c, 0xaa, 0xc2, 0x48, 0xaf, 0x96, 0xf6, 0xaf, 0xa7,
- 0xf9, 0x04, 0xf5, 0x50, 0x25, 0x3a, 0x0f, 0x3e, 0xf3, 0xf5, 0xaa,
- 0x2f, 0xe6, 0x83, 0x8a, 0x95, 0xb2, 0x16, 0x69, 0x14, 0x68, 0xe2]
-
- samplePcs :: PerCommitmentSecret
- samplePcs =
- PerCommitmentSecret (BS.replicate 32 0x01)
-
- -- Secret generation test data
- seed = BS.replicate 32 0xFF
-
- -- Fee calculation test data
- feerate = FeeratePerKw 5000
- noAnchors = ChannelFeatures { cf_option_anchors = False }
- withAnchors = ChannelFeatures { cf_option_anchors = True }
-
- -- Trimming test data
- dust = DustLimit (Satoshi 546)
-
- htlcNotTrimmed = HTLC
- { htlc_direction = HTLCOffered
- , htlc_amount_msat = MilliSatoshi 5000000
- , htlc_payment_hash = PaymentHash (BS.replicate 32 0)
- , htlc_cltv_expiry = CltvExpiry 500000
- }
-
- htlcTrimmed = HTLC
- { htlc_direction = HTLCOffered
- , htlc_amount_msat = MilliSatoshi 1000000
- , htlc_payment_hash = PaymentHash (BS.replicate 32 0)
- , htlc_cltv_expiry = CltvExpiry 500000
- }
-
- -- Sample pubkeys
- samplePubkey1, samplePubkey2, samplePubkey3 :: Pubkey
- samplePubkey1 = Pubkey $ BS.pack
- [0x03, 0x6d, 0x6c, 0xaa, 0xc2, 0x48, 0xaf, 0x96, 0xf6, 0xaf, 0xa7,
- 0xf9, 0x04, 0xf5, 0x50, 0x25, 0x3a, 0x0f, 0x3e, 0xf3, 0xf5, 0xaa,
- 0x2f, 0xe6, 0x83, 0x8a, 0x95, 0xb2, 0x16, 0x69, 0x14, 0x68, 0xe2]
- samplePubkey2 = Pubkey $ BS.pack
- [0x02, 0x5f, 0x71, 0x17, 0xa7, 0x81, 0x50, 0xfe, 0x2e, 0xf9, 0x7d,
- 0xb7, 0xcf, 0xc8, 0x3b, 0xd5, 0x7b, 0x2e, 0x2c, 0x0d, 0x0d, 0xd2,
- 0x5e, 0xaf, 0x46, 0x7a, 0x4a, 0x1c, 0x2a, 0x45, 0xce, 0x14, 0x86]
- samplePubkey3 = samplePubkey1
-
- -- Helper to encode a commitment tx for decode benchmarks
- encodeTx0 :: [HTLC] -> ChannelFeatures -> BS.ByteString
- encodeTx0 htlcs features =
- case encode_tx (build_commitment_tx
- (mkCommitmentContext htlcs features)) of
- Nothing -> BS.empty
- Just bs -> bs
-
- -- Funding outpoint
- sampleFundingOutpoint :: OutPoint
- sampleFundingOutpoint = OutPoint (TxId $ BS.replicate 32 0x01) 0
-
- -- HTLC builder
- mkHtlc :: HTLCDirection -> Word64 -> Word32 -> HTLC
- mkHtlc dir amtMsat expiry = HTLC
- { htlc_direction = dir
- , htlc_amount_msat = MilliSatoshi amtMsat
- , htlc_payment_hash = PaymentHash (BS.replicate 32 0x00)
- , htlc_cltv_expiry = CltvExpiry expiry
- }
-
- htlcs0, htlcs10, htlcs100 :: [HTLC]
- htlcs0 = []
- htlcs10 = [mkHtlc (if even i then HTLCOffered else HTLCReceived)
- (5000000 + i * 100000) (500000 + fromIntegral i)
- | i <- [0..9]]
- htlcs100 = [mkHtlc (if even i then HTLCOffered else HTLCReceived)
- (5000000 + i * 10000) (500000 + fromIntegral i)
- | i <- [0..99]]
-
- -- CommitmentKeys
- sampleCommitmentKeys :: CommitmentKeys
- sampleCommitmentKeys = CommitmentKeys
- { ck_revocation_pubkey = RevocationPubkey samplePubkey1
- , ck_local_delayed = LocalDelayedPubkey samplePubkey1
- , ck_local_htlc = LocalHtlcPubkey samplePubkey1
- , ck_remote_htlc = RemoteHtlcPubkey samplePubkey2
- , ck_local_payment = LocalPubkey samplePubkey1
- , ck_remote_payment = RemotePubkey samplePubkey2
- , ck_local_funding = FundingPubkey samplePubkey1
- , ck_remote_funding = FundingPubkey samplePubkey2
- }
-
- -- CommitmentContext builder
- mkCommitmentContext :: [HTLC] -> ChannelFeatures -> CommitmentContext
- mkCommitmentContext htlcs features = CommitmentContext
- { cc_funding_outpoint = sampleFundingOutpoint
- , cc_commitment_number = CommitmentNumber 42
- , cc_local_payment_bp = PaymentBasepoint $
- Point $ unPubkey samplePubkey1
- , cc_remote_payment_bp = PaymentBasepoint $
- Point $ unPubkey samplePubkey2
- , cc_to_self_delay = ToSelfDelay 144
- , cc_dust_limit = DustLimit (Satoshi 546)
- , cc_feerate = FeeratePerKw 5000
- , cc_features = features
- , cc_is_funder = True
- , cc_to_local_msat = MilliSatoshi 500000000
- , cc_to_remote_msat = MilliSatoshi 500000000
- , cc_htlcs = htlcs
- , cc_keys = sampleCommitmentKeys
- }
-
- -- HTLC context
- sampleHtlcContext :: HTLCContext
- sampleHtlcContext = HTLCContext
- { hc_commitment_txid = TxId $ BS.replicate 32 0x01
- , hc_output_index = 0
- , hc_htlc = mkHtlc HTLCOffered 5000000 500000
- , hc_to_self_delay = ToSelfDelay 144
- , hc_feerate = FeeratePerKw 5000
- , hc_features = noAnchors
- , hc_revocation_pubkey = RevocationPubkey samplePubkey1
- , hc_local_delayed = LocalDelayedPubkey samplePubkey1
- }
-
- -- Closing context
- sampleClosingContext :: ClosingContext
- sampleClosingContext = ClosingContext
- { clc_funding_outpoint = sampleFundingOutpoint
- , clc_local_amount = Satoshi 500000
- , clc_remote_amount = Satoshi 500000
- , clc_local_script = Script $
- BS.pack [0x00, 0x14] <> BS.replicate 20 0x01
- , clc_remote_script = Script $
- BS.pack [0x00, 0x14] <> BS.replicate 20 0x02
- , clc_local_dust_limit = DustLimit (Satoshi 546)
- , clc_remote_dust_limit = DustLimit (Satoshi 546)
- , clc_fee = Satoshi 1000
- , clc_is_funder = True
- , clc_locktime = Locktime 0
- , clc_funding_script = funding_script (FundingPubkey samplePubkey1)
- (FundingPubkey samplePubkey2)
- }
-
- -- Secret storage for benchmarks
- filledStore :: SecretStore
- filledStore = foldl insertOne empty_store [0..99]
- where
- insertOne store i =
- let idx = 281474976710655 - i
- sec = BS.replicate 32 (fromIntegral i)
- in case insert_secret sec idx store of
- Just s -> s
- Nothing -> store
+main = do
+ fx <- fixtures
+ let (next_idx, next_secret) = fx_store_next fx
+ mainWith $ do
+ wgroup "keys" $ do
+ func "derive_per_commitment_point" derive_per_commitment_point
+ (fx_secret fx)
+ func "derive_per_commitment_point'" (derive_per_commitment_point' tex)
+ (fx_secret fx)
+ func "derive_pubkey" (derive_pubkey (fx_basepoint fx)) (fx_pcp fx)
+ func "derive_revocationpubkey" (derive_revocationpubkey (fx_rbp fx))
+ (fx_pcp fx)
+ func "derive_commitment_keys"
+ (derive_commitment_keys (fx_local_bps fx) (fx_local_fund fx)
+ (fx_remote_bps fx) (fx_remote_fund fx))
+ (fx_pcp fx)
+ func "derive_commitment_keys'"
+ (derive_commitment_keys' tex (fx_local_bps fx) (fx_local_fund fx)
+ (fx_remote_bps fx) (fx_remote_fund fx))
+ (fx_pcp fx)
+ func "derive_privkey" (derive_privkey (fx_seckey fx)) (fx_pcp fx)
+ func "derive_revocationprivkey"
+ (derive_revocationprivkey (fx_seckey fx)) (fx_secret fx)
+ wgroup "secrets" $ do
+ func "generate_from_seed (index 2^48 - 1)"
+ (generate_from_seed (fx_seed fx)) (fx_store_oldest fx)
+ func "insert_secret (14 lower buckets)"
+ (insert_secret next_secret next_idx) (fx_store fx)
+ func "derive_old_secret (index 2^48 - 1)"
+ (derive_old_secret (fx_store_oldest fx)) (fx_store fx)
+ func "secret_store . un_secret_store"
+ (secret_store . un_secret_store) (fx_store fx)
+ wgroup "transactions" $ do
+ func "build_commitment_tx (no htlcs)" build_commitment_tx
+ (fx_ctx_simple fx)
+ func "build_commitment_tx (5 htlcs)" build_commitment_tx
+ (fx_ctx_htlcs fx)
+ func "build_commitment_tx (5 htlcs, anchors)" build_commitment_tx
+ (fx_ctx_anchors fx)
+ func "encode_commitment_tx (5 htlcs)" encode_commitment_tx
+ (fx_commit fx)
+ func "build_htlc_tx" build_htlc_tx (fx_htlc_ctx fx)
+ func "encode_htlc_tx" encode_htlc_tx (fx_htlc_tx fx)
+ func "build_closing_tx" build_closing_tx (fx_closing fx)
+ func "build_legacy_closing_tx" build_legacy_closing_tx (fx_legacy fx)
+ func "encode_closing_tx" encode_closing_tx (fx_closing_tx fx)
diff --git a/ppad-bolt3.cabal b/ppad-bolt3.cabal
@@ -70,32 +70,41 @@ benchmark bolt3-bench
default-language: Haskell2010
hs-source-dirs: bench
main-is: Main.hs
+ other-modules: Fixtures
ghc-options:
- -rtsopts -O2 -Wall -fno-warn-orphans
+ -rtsopts -O2 -Wall
build-depends:
base
, bytestring
, criterion
, deepseq
+ , ppad-base16
+ , ppad-bolt1
, ppad-bolt3
- , ppad-secp256k1 >= 0.5.4 && < 0.6
+ , ppad-secp256k1
+ , ppad-sha256
+ , ppad-tx
benchmark bolt3-weigh
type: exitcode-stdio-1.0
default-language: Haskell2010
hs-source-dirs: bench
main-is: Weight.hs
+ other-modules: Fixtures
ghc-options:
- -rtsopts -O2 -Wall -fno-warn-orphans
+ -rtsopts -O2 -Wall
build-depends:
base
, bytestring
, deepseq
+ , ppad-base16
+ , ppad-bolt1
, ppad-bolt3
- , ppad-secp256k1 >= 0.5.4 && < 0.6
+ , ppad-secp256k1
+ , ppad-sha256
+ , ppad-tx
, weigh
-
