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