Main.hs (10700B)
1 {-# LANGUAGE BangPatterns #-} 2 {-# LANGUAGE OverloadedStrings #-} 3 4 -- | 5 -- Module: Main 6 -- Copyright: (c) 2025 Jared Tobin 7 -- License: MIT 8 -- Maintainer: Jared Tobin <jared@ppad.tech> 9 -- 10 -- Criterion timing benchmarks for BOLT #2 message codecs. 11 12 module Main where 13 14 import Criterion.Main 15 import qualified Data.ByteString as BS 16 import Lightning.Protocol.BOLT1 (TlvStream, unsafeTlvStream) 17 import Lightning.Protocol.BOLT2 18 19 -- Test data construction ------------------------------------------------------ 20 21 -- | 32 zero bytes for channel IDs, chain hashes, etc. 22 zeroBytes32 :: BS.ByteString 23 zeroBytes32 = BS.replicate 32 0x00 24 {-# NOINLINE zeroBytes32 #-} 25 26 -- | 33-byte compressed public key (02 prefix + 32 zero bytes). 27 testPoint :: Point 28 testPoint = case point (BS.cons 0x02 zeroBytes32) of 29 Just p -> p 30 Nothing -> error "testPoint: invalid" 31 {-# NOINLINE testPoint #-} 32 33 -- | 64-byte signature. 34 testSignature :: Signature 35 testSignature = case signature (BS.replicate 64 0x01) of 36 Just s -> s 37 Nothing -> error "testSignature: invalid" 38 {-# NOINLINE testSignature #-} 39 40 -- | 32-byte channel ID. 41 testChannelId :: ChannelId 42 testChannelId = case channelId zeroBytes32 of 43 Just c -> c 44 Nothing -> error "testChannelId: invalid" 45 {-# NOINLINE testChannelId #-} 46 47 -- | 32-byte chain hash. 48 testChainHash :: ChainHash 49 testChainHash = case chainHash zeroBytes32 of 50 Just h -> h 51 Nothing -> error "testChainHash: invalid" 52 {-# NOINLINE testChainHash #-} 53 54 -- | 32-byte txid. 55 testTxId :: TxId 56 testTxId = case mkTxId zeroBytes32 of 57 Just t -> t 58 Nothing -> error "testTxId: invalid" 59 {-# NOINLINE testTxId #-} 60 61 -- | 32-byte payment hash. 62 testPaymentHash :: PaymentHash 63 testPaymentHash = case paymentHash zeroBytes32 of 64 Just h -> h 65 Nothing -> error "testPaymentHash: invalid" 66 {-# NOINLINE testPaymentHash #-} 67 68 -- | 1366-byte onion packet. 69 testOnionPacket :: OnionPacket 70 testOnionPacket = case onionPacket (BS.replicate 1366 0x00) of 71 Just o -> o 72 Nothing -> error "testOnionPacket: invalid" 73 {-# NOINLINE testOnionPacket #-} 74 75 -- | Empty TLV stream. 76 emptyTlvs :: TlvStream 77 emptyTlvs = unsafeTlvStream [] 78 {-# NOINLINE emptyTlvs #-} 79 80 -- V1 messages ----------------------------------------------------------------- 81 82 -- | Test OpenChannel message. 83 testOpenChannel :: OpenChannel 84 testOpenChannel = OpenChannel 85 { openChannelChainHash = testChainHash 86 , openChannelTempChannelId = testChannelId 87 , openChannelFundingSatoshis = Satoshis 1000000 88 , openChannelPushMsat = MilliSatoshis 0 89 , openChannelDustLimitSatoshis = Satoshis 546 90 , openChannelMaxHtlcValueInFlight = MilliSatoshis 1000000000 91 , openChannelChannelReserveSat = Satoshis 10000 92 , openChannelHtlcMinimumMsat = MilliSatoshis 1000 93 , openChannelFeeratePerKw = 250 94 , openChannelToSelfDelay = 144 95 , openChannelMaxAcceptedHtlcs = 30 96 , openChannelFundingPubkey = testPoint 97 , openChannelRevocationBasepoint = testPoint 98 , openChannelPaymentBasepoint = testPoint 99 , openChannelDelayedPaymentBase = testPoint 100 , openChannelHtlcBasepoint = testPoint 101 , openChannelFirstPerCommitPoint = testPoint 102 , openChannelChannelFlags = 0x00 103 , openChannelTlvs = emptyTlvs 104 } 105 {-# NOINLINE testOpenChannel #-} 106 107 -- | Encoded OpenChannel for decode benchmarks. 108 encodedOpenChannel :: BS.ByteString 109 encodedOpenChannel = encodeOpenChannel testOpenChannel 110 {-# NOINLINE encodedOpenChannel #-} 111 112 -- V2 messages ----------------------------------------------------------------- 113 114 -- | Test OpenChannel2 message. 115 testOpenChannel2 :: OpenChannel2 116 testOpenChannel2 = OpenChannel2 117 { openChannel2ChainHash = testChainHash 118 , openChannel2TempChannelId = testChannelId 119 , openChannel2FundingFeeratePerkw = 2500 120 , openChannel2CommitFeeratePerkw = 250 121 , openChannel2FundingSatoshis = Satoshis 1000000 122 , openChannel2DustLimitSatoshis = Satoshis 546 123 , openChannel2MaxHtlcValueInFlight = MilliSatoshis 1000000000 124 , openChannel2HtlcMinimumMsat = MilliSatoshis 1000 125 , openChannel2ToSelfDelay = 144 126 , openChannel2MaxAcceptedHtlcs = 30 127 , openChannel2Locktime = 0 128 , openChannel2FundingPubkey = testPoint 129 , openChannel2RevocationBasepoint = testPoint 130 , openChannel2PaymentBasepoint = testPoint 131 , openChannel2DelayedPaymentBase = testPoint 132 , openChannel2HtlcBasepoint = testPoint 133 , openChannel2FirstPerCommitPoint = testPoint 134 , openChannel2SecondPerCommitPoint = testPoint 135 , openChannel2ChannelFlags = 0x00 136 , openChannel2Tlvs = emptyTlvs 137 } 138 {-# NOINLINE testOpenChannel2 #-} 139 140 -- | Encoded OpenChannel2 for decode benchmarks. 141 encodedOpenChannel2 :: BS.ByteString 142 encodedOpenChannel2 = encodeOpenChannel2 testOpenChannel2 143 {-# NOINLINE encodedOpenChannel2 #-} 144 145 -- | Test witness data (simulated P2WPKH signature + pubkey). 146 testWitness :: Witness 147 testWitness = Witness (BS.replicate 107 0xab) 148 {-# NOINLINE testWitness #-} 149 150 -- | TxSignatures with multiple witnesses. 151 testTxSignatures :: TxSignatures 152 testTxSignatures = TxSignatures 153 { txSignaturesChannelId = testChannelId 154 , txSignaturesTxid = testTxId 155 , txSignaturesWitnesses = replicate 5 testWitness 156 } 157 {-# NOINLINE testTxSignatures #-} 158 159 -- | Encoded TxSignatures for decode benchmarks. 160 encodedTxSignatures :: BS.ByteString 161 encodedTxSignatures = case encodeTxSignatures testTxSignatures of 162 Right bs -> bs 163 Left e -> error $ "encodedTxSignatures: " ++ show e 164 {-# NOINLINE encodedTxSignatures #-} 165 166 -- Close messages -------------------------------------------------------------- 167 168 -- | Test ClosingSigned message. 169 testClosingSigned :: ClosingSigned 170 testClosingSigned = ClosingSigned 171 { closingSignedChannelId = testChannelId 172 , closingSignedFeeSatoshis = Satoshis 1000 173 , closingSignedSignature = testSignature 174 , closingSignedTlvs = emptyTlvs 175 } 176 {-# NOINLINE testClosingSigned #-} 177 178 -- | Encoded ClosingSigned for decode benchmarks. 179 encodedClosingSigned :: BS.ByteString 180 encodedClosingSigned = encodeClosingSigned testClosingSigned 181 {-# NOINLINE encodedClosingSigned #-} 182 183 -- Normal operation messages --------------------------------------------------- 184 185 -- | Test UpdateAddHtlc message. 186 testUpdateAddHtlc :: UpdateAddHtlc 187 testUpdateAddHtlc = UpdateAddHtlc 188 { updateAddHtlcChannelId = testChannelId 189 , updateAddHtlcId = 0 190 , updateAddHtlcAmountMsat = MilliSatoshis 10000000 191 , updateAddHtlcPaymentHash = testPaymentHash 192 , updateAddHtlcCltvExpiry = 800000 193 , updateAddHtlcOnionPacket = testOnionPacket 194 , updateAddHtlcTlvs = emptyTlvs 195 } 196 {-# NOINLINE testUpdateAddHtlc #-} 197 198 -- | Encoded UpdateAddHtlc for decode benchmarks. 199 encodedUpdateAddHtlc :: BS.ByteString 200 encodedUpdateAddHtlc = encodeUpdateAddHtlc testUpdateAddHtlc 201 {-# NOINLINE encodedUpdateAddHtlc #-} 202 203 -- | Test CommitmentSigned message with HTLC signatures (10 sigs). 204 testCommitmentSigned :: CommitmentSigned 205 testCommitmentSigned = CommitmentSigned 206 { commitmentSignedChannelId = testChannelId 207 , commitmentSignedSignature = testSignature 208 , commitmentSignedHtlcSignatures = replicate 10 testSignature 209 } 210 {-# NOINLINE testCommitmentSigned #-} 211 212 -- | Encoded CommitmentSigned for decode benchmarks. 213 encodedCommitmentSigned :: BS.ByteString 214 encodedCommitmentSigned = case encodeCommitmentSigned testCommitmentSigned of 215 Right bs -> bs 216 Left e -> error $ "encodedCommitmentSigned: " ++ show e 217 {-# NOINLINE encodedCommitmentSigned #-} 218 219 -- | Test CommitmentSigned with many HTLC signatures (100 sigs). 220 testCommitmentSignedLarge :: CommitmentSigned 221 testCommitmentSignedLarge = CommitmentSigned 222 { commitmentSignedChannelId = testChannelId 223 , commitmentSignedSignature = testSignature 224 , commitmentSignedHtlcSignatures = replicate 100 testSignature 225 } 226 {-# NOINLINE testCommitmentSignedLarge #-} 227 228 -- | Encoded large CommitmentSigned for decode benchmarks. 229 encodedCommitmentSignedLarge :: BS.ByteString 230 encodedCommitmentSignedLarge = 231 case encodeCommitmentSigned testCommitmentSignedLarge of 232 Right bs -> bs 233 Left e -> error $ "encodedCommitmentSignedLarge: " ++ show e 234 {-# NOINLINE encodedCommitmentSignedLarge #-} 235 236 -- | Test CommitmentSigned with max HTLC signatures (483 sigs). 237 testCommitmentSignedMax :: CommitmentSigned 238 testCommitmentSignedMax = CommitmentSigned 239 { commitmentSignedChannelId = testChannelId 240 , commitmentSignedSignature = testSignature 241 , commitmentSignedHtlcSignatures = replicate 483 testSignature 242 } 243 {-# NOINLINE testCommitmentSignedMax #-} 244 245 -- | Encoded max CommitmentSigned for decode benchmarks. 246 encodedCommitmentSignedMax :: BS.ByteString 247 encodedCommitmentSignedMax = 248 case encodeCommitmentSigned testCommitmentSignedMax of 249 Right bs -> bs 250 Left e -> error $ "encodedCommitmentSignedMax: " ++ show e 251 {-# NOINLINE encodedCommitmentSignedMax #-} 252 253 -- Benchmark groups ------------------------------------------------------------ 254 255 main :: IO () 256 main = defaultMain 257 [ bgroup "v1" 258 [ bgroup "open_channel" 259 [ bench "encode" $ nf encodeOpenChannel testOpenChannel 260 , bench "decode" $ nf decodeOpenChannel encodedOpenChannel 261 ] 262 ] 263 , bgroup "v2" 264 [ bgroup "open_channel2" 265 [ bench "encode" $ nf encodeOpenChannel2 testOpenChannel2 266 , bench "decode" $ nf decodeOpenChannel2 encodedOpenChannel2 267 ] 268 , bgroup "tx_signatures" 269 [ bench "encode" $ nf encodeTxSignatures testTxSignatures 270 , bench "decode" $ nf decodeTxSignatures encodedTxSignatures 271 ] 272 ] 273 , bgroup "close" 274 [ bgroup "closing_signed" 275 [ bench "encode" $ nf encodeClosingSigned testClosingSigned 276 , bench "decode" $ nf decodeClosingSigned encodedClosingSigned 277 ] 278 ] 279 , bgroup "normal" 280 [ bgroup "update_add_htlc" 281 [ bench "encode" $ nf encodeUpdateAddHtlc testUpdateAddHtlc 282 , bench "decode" $ nf decodeUpdateAddHtlc encodedUpdateAddHtlc 283 ] 284 , bgroup "commitment_signed" 285 [ bench "encode" $ nf encodeCommitmentSigned testCommitmentSigned 286 , bench "decode" $ nf decodeCommitmentSigned encodedCommitmentSigned 287 ] 288 , bgroup "commitment_signed_100" 289 [ bench "encode" $ 290 nf encodeCommitmentSigned testCommitmentSignedLarge 291 , bench "decode" $ 292 nf decodeCommitmentSigned encodedCommitmentSignedLarge 293 ] 294 , bgroup "commitment_signed_483" 295 [ bench "encode" $ 296 nf encodeCommitmentSigned testCommitmentSignedMax 297 , bench "decode" $ 298 nf decodeCommitmentSigned encodedCommitmentSignedMax 299 ] 300 ] 301 ]