commit 2a3373657b7ba5c0b137ca0781657f4110569171
parent f829f581231d810fa0ca8e9c2121f757b986171e
Author: Jared Tobin <jared@jtobin.io>
Date: Sun, 25 Jan 2026 15:00:38 +0400
Merge branch 'impl/criterion' - comprehensive criterion benchmarks
Add wall-clock timing benchmarks covering:
- Primitive encoding/decoding (u16/u32/u64, s8/s16/s32/s64)
- Truncated unsigned integers at boundary values
- Minimal signed integers at boundary cases
- BigSize encoding/decoding across all size thresholds
- TLV operations (encode/decode for 1/5/20 records)
- All BOLT#1 message types with variants
- Envelope operations with/without extension TLVs
- Round-trip benchmarks for each message type
Diffstat:
| M | bench/Main.hs | | | 518 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++- |
1 file changed, 517 insertions(+), 1 deletion(-)
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -4,7 +4,523 @@
module Main where
import Criterion.Main
+import qualified Data.ByteString as BS
+import Data.Word (Word16, Word32, Word64)
+import Data.Int (Int8, Int16, Int32, Int64)
+import Lightning.Protocol.BOLT1
+import Lightning.Protocol.BOLT1.Codec
+import Lightning.Protocol.BOLT1.TLV (encodeInitTlvs, encodeTlvRecord, parseInitTlvs)
+
+-- Fixtures --------------------------------------------------------------------
+
+-- Prevent constant folding by marking fixtures as NOINLINE.
+
+{-# NOINLINE u16Val #-}
+u16Val :: Word16
+u16Val = 0x1234
+
+{-# NOINLINE u32Val #-}
+u32Val :: Word32
+u32Val = 0x12345678
+
+{-# NOINLINE u64Val #-}
+u64Val :: Word64
+u64Val = 0x123456789ABCDEF0
+
+{-# NOINLINE s8Val #-}
+s8Val :: Int8
+s8Val = -42
+
+{-# NOINLINE s16Val #-}
+s16Val :: Int16
+s16Val = -1234
+
+{-# NOINLINE s32Val #-}
+s32Val :: Int32
+s32Val = -12345678
+
+{-# NOINLINE s64Val #-}
+s64Val :: Int64
+s64Val = -123456789012345
+
+-- Truncated values
+
+{-# NOINLINE tu16Zero #-}
+tu16Zero :: Word16
+tu16Zero = 0
+
+{-# NOINLINE tu16Small #-}
+tu16Small :: Word16
+tu16Small = 0x42
+
+{-# NOINLINE tu16Max #-}
+tu16Max :: Word16
+tu16Max = 0xFFFF
+
+{-# NOINLINE tu32Zero #-}
+tu32Zero :: Word32
+tu32Zero = 0
+
+{-# NOINLINE tu32Small #-}
+tu32Small :: Word32
+tu32Small = 0x42
+
+{-# NOINLINE tu32Max #-}
+tu32Max :: Word32
+tu32Max = 0xFFFFFFFF
+
+{-# NOINLINE tu64Zero #-}
+tu64Zero :: Word64
+tu64Zero = 0
+
+{-# NOINLINE tu64Small #-}
+tu64Small :: Word64
+tu64Small = 0x42
+
+{-# NOINLINE tu64Max #-}
+tu64Max :: Word64
+tu64Max = 0xFFFFFFFFFFFFFFFF
+
+-- MinSigned values
+
+{-# NOINLINE ms0 #-}
+ms0 :: Int64
+ms0 = 0
+
+{-# NOINLINE ms127 #-}
+ms127 :: Int64
+ms127 = 127
+
+{-# NOINLINE ms128 #-}
+ms128 :: Int64
+ms128 = 128
+
+{-# NOINLINE msNeg128 #-}
+msNeg128 :: Int64
+msNeg128 = -128
+
+{-# NOINLINE msNeg129 #-}
+msNeg129 :: Int64
+msNeg129 = -129
+
+-- BigSize values
+
+{-# NOINLINE bs0 #-}
+bs0 :: Word64
+bs0 = 0
+
+{-# NOINLINE bs252 #-}
+bs252 :: Word64
+bs252 = 252
+
+{-# NOINLINE bs253 #-}
+bs253 :: Word64
+bs253 = 253
+
+{-# NOINLINE bs65535 #-}
+bs65535 :: Word64
+bs65535 = 65535
+
+{-# NOINLINE bs65536 #-}
+bs65536 :: Word64
+bs65536 = 65536
+
+{-# NOINLINE bsLarge #-}
+bsLarge :: Word64
+bsLarge = 0x100000000
+
+-- Encoded bytes for decode benchmarks
+
+{-# NOINLINE encodedU16 #-}
+encodedU16 :: BS.ByteString
+encodedU16 = encodeU16 u16Val
+
+{-# NOINLINE encodedU32 #-}
+encodedU32 :: BS.ByteString
+encodedU32 = encodeU32 u32Val
+
+{-# NOINLINE encodedU64 #-}
+encodedU64 :: BS.ByteString
+encodedU64 = encodeU64 u64Val
+
+{-# NOINLINE encodedS8 #-}
+encodedS8 :: BS.ByteString
+encodedS8 = encodeS8 s8Val
+
+{-# NOINLINE encodedS16 #-}
+encodedS16 :: BS.ByteString
+encodedS16 = encodeS16 s16Val
+
+{-# NOINLINE encodedS32 #-}
+encodedS32 :: BS.ByteString
+encodedS32 = encodeS32 s32Val
+
+{-# NOINLINE encodedS64 #-}
+encodedS64 :: BS.ByteString
+encodedS64 = encodeS64 s64Val
+
+{-# NOINLINE encodedTu16Small #-}
+encodedTu16Small :: BS.ByteString
+encodedTu16Small = encodeTu16 tu16Small
+
+{-# NOINLINE encodedTu32Small #-}
+encodedTu32Small :: BS.ByteString
+encodedTu32Small = encodeTu32 tu32Small
+
+{-# NOINLINE encodedTu64Small #-}
+encodedTu64Small :: BS.ByteString
+encodedTu64Small = encodeTu64 tu64Small
+
+{-# NOINLINE encodedMs127 #-}
+encodedMs127 :: BS.ByteString
+encodedMs127 = encodeMinSigned ms127
+
+{-# NOINLINE encodedMsNeg129 #-}
+encodedMsNeg129 :: BS.ByteString
+encodedMsNeg129 = encodeMinSigned msNeg129
+
+{-# NOINLINE encodedBs0 #-}
+encodedBs0 :: BS.ByteString
+encodedBs0 = encodeBigSize bs0
+
+{-# NOINLINE encodedBs253 #-}
+encodedBs253 :: BS.ByteString
+encodedBs253 = encodeBigSize bs253
+
+{-# NOINLINE encodedBs65536 #-}
+encodedBs65536 :: BS.ByteString
+encodedBs65536 = encodeBigSize bs65536
+
+{-# NOINLINE encodedBsLarge #-}
+encodedBsLarge :: BS.ByteString
+encodedBsLarge = encodeBigSize bsLarge
+
+-- TLV fixtures
+
+{-# NOINLINE tlvRec1 #-}
+tlvRec1 :: TlvRecord
+tlvRec1 = TlvRecord 1 "test"
+
+{-# NOINLINE tlvRec3 #-}
+tlvRec3 :: TlvRecord
+tlvRec3 = TlvRecord 3 "addr"
+
+{-# NOINLINE tlvRec5 #-}
+tlvRec5 :: TlvRecord
+tlvRec5 = TlvRecord 5 "value"
+
+{-# NOINLINE tlvStream1 #-}
+tlvStream1 :: TlvStream
+tlvStream1 = unsafeTlvStream [tlvRec1]
+
+{-# NOINLINE tlvStream5 #-}
+tlvStream5 :: TlvStream
+tlvStream5 = unsafeTlvStream
+ [ TlvRecord 1 "one"
+ , TlvRecord 3 "three"
+ , TlvRecord 5 "five"
+ , TlvRecord 7 "seven"
+ , TlvRecord 9 "nine"
+ ]
+
+{-# NOINLINE tlvStream20 #-}
+tlvStream20 :: TlvStream
+tlvStream20 = unsafeTlvStream
+ [ TlvRecord (2*i + 1) (BS.replicate 10 (fromIntegral i))
+ | i <- [0..19]
+ ]
+
+{-# NOINLINE encodedTlvStream1 #-}
+encodedTlvStream1 :: BS.ByteString
+encodedTlvStream1 = encodeTlvStream tlvStream1
+
+{-# NOINLINE encodedTlvStream5 #-}
+encodedTlvStream5 :: BS.ByteString
+encodedTlvStream5 = encodeTlvStream tlvStream5
+
+{-# NOINLINE encodedTlvStream20 #-}
+encodedTlvStream20 :: BS.ByteString
+encodedTlvStream20 = encodeTlvStream tlvStream20
+
+-- Init TLV fixtures
+
+{-# NOINLINE chainHash1 #-}
+chainHash1 :: ChainHash
+chainHash1 = case chainHash (BS.replicate 32 0x01) of
+ Just ch -> ch
+ Nothing -> error "impossible"
+
+{-# NOINLINE initTlvNetworks #-}
+initTlvNetworks :: [InitTlv]
+initTlvNetworks = [InitNetworks [chainHash1]]
+
+{-# NOINLINE initTlvRemoteAddr #-}
+initTlvRemoteAddr :: [InitTlv]
+initTlvRemoteAddr = [InitRemoteAddr "127.0.0.1"]
+
+{-# NOINLINE encodedInitTlvs #-}
+encodedInitTlvs :: BS.ByteString
+encodedInitTlvs = encodeTlvStream (encodeInitTlvs initTlvNetworks)
+
+-- Message fixtures
+
+{-# NOINLINE initMinimal #-}
+initMinimal :: Init
+initMinimal = Init BS.empty BS.empty []
+
+{-# NOINLINE initWithTlvs #-}
+initWithTlvs :: Init
+initWithTlvs = Init (BS.pack [0x00, 0x01]) (BS.pack [0x02, 0x03]) initTlvNetworks
+
+{-# NOINLINE errorMinimal #-}
+errorMinimal :: Error
+errorMinimal = Error allChannels BS.empty
+
+{-# NOINLINE errorWithData #-}
+errorWithData :: Error
+errorWithData = Error allChannels "Connection reset by peer"
+
+{-# NOINLINE warningMsg #-}
+warningMsg :: Warning
+warningMsg = Warning allChannels "Low disk space"
+
+{-# NOINLINE pingMinimal #-}
+pingMinimal :: Ping
+pingMinimal = Ping 64 BS.empty
+
+{-# NOINLINE pingWithPadding #-}
+pingWithPadding :: Ping
+pingWithPadding = Ping 64 (BS.replicate 64 0x00)
+
+{-# NOINLINE pongMsg #-}
+pongMsg :: Pong
+pongMsg = Pong (BS.replicate 64 0x00)
+
+{-# NOINLINE peerStorageMsg #-}
+peerStorageMsg :: PeerStorage
+peerStorageMsg = PeerStorage (BS.replicate 100 0xAB)
+
+{-# NOINLINE peerStorageRetMsg #-}
+peerStorageRetMsg :: PeerStorageRetrieval
+peerStorageRetMsg = PeerStorageRetrieval (BS.replicate 100 0xCD)
+
+-- Encoded messages for decode benchmarks
+
+{-# NOINLINE encodedInitMinimal #-}
+encodedInitMinimal :: BS.ByteString
+encodedInitMinimal = case encodeInit initMinimal of
+ Right bs -> bs
+ Left _ -> error "impossible"
+
+{-# NOINLINE encodedInitWithTlvs #-}
+encodedInitWithTlvs :: BS.ByteString
+encodedInitWithTlvs = case encodeInit initWithTlvs of
+ Right bs -> bs
+ Left _ -> error "impossible"
+
+{-# NOINLINE encodedErrorMinimal #-}
+encodedErrorMinimal :: BS.ByteString
+encodedErrorMinimal = case encodeError errorMinimal of
+ Right bs -> bs
+ Left _ -> error "impossible"
+
+{-# NOINLINE encodedErrorWithData #-}
+encodedErrorWithData :: BS.ByteString
+encodedErrorWithData = case encodeError errorWithData of
+ Right bs -> bs
+ Left _ -> error "impossible"
+
+{-# NOINLINE encodedWarning #-}
+encodedWarning :: BS.ByteString
+encodedWarning = case encodeWarning warningMsg of
+ Right bs -> bs
+ Left _ -> error "impossible"
+
+{-# NOINLINE encodedPingMinimal #-}
+encodedPingMinimal :: BS.ByteString
+encodedPingMinimal = case encodePing pingMinimal of
+ Right bs -> bs
+ Left _ -> error "impossible"
+
+{-# NOINLINE encodedPingWithPadding #-}
+encodedPingWithPadding :: BS.ByteString
+encodedPingWithPadding = case encodePing pingWithPadding of
+ Right bs -> bs
+ Left _ -> error "impossible"
+
+{-# NOINLINE encodedPong #-}
+encodedPong :: BS.ByteString
+encodedPong = case encodePong pongMsg of
+ Right bs -> bs
+ Left _ -> error "impossible"
+
+{-# NOINLINE encodedPeerStorage #-}
+encodedPeerStorage :: BS.ByteString
+encodedPeerStorage = case encodePeerStorage peerStorageMsg of
+ Right bs -> bs
+ Left _ -> error "impossible"
+
+{-# NOINLINE encodedPeerStorageRet #-}
+encodedPeerStorageRet :: BS.ByteString
+encodedPeerStorageRet = case encodePeerStorageRetrieval peerStorageRetMsg of
+ Right bs -> bs
+ Left _ -> error "impossible"
+
+-- Envelope fixtures
+
+{-# NOINLINE msgInit #-}
+msgInit :: Message
+msgInit = MsgInitVal initMinimal
+
+{-# NOINLINE msgPing #-}
+msgPing :: Message
+msgPing = MsgPingVal pingMinimal
+
+{-# NOINLINE encodedEnvelopeNoExt #-}
+encodedEnvelopeNoExt :: BS.ByteString
+encodedEnvelopeNoExt = case encodeEnvelope msgPing Nothing of
+ Right bs -> bs
+ Left _ -> error "impossible"
+
+{-# NOINLINE encodedEnvelopeWithExt #-}
+encodedEnvelopeWithExt :: BS.ByteString
+encodedEnvelopeWithExt = case encodeEnvelope msgPing (Just tlvStream5) of
+ Right bs -> bs
+ Left _ -> error "impossible"
+
+-- Main ------------------------------------------------------------------------
main :: IO ()
-main = defaultMain [
+main = defaultMain
+ [ bgroup "prim/encode"
+ [ bench "encodeU16" $ whnf encodeU16 u16Val
+ , bench "encodeU32" $ whnf encodeU32 u32Val
+ , bench "encodeU64" $ whnf encodeU64 u64Val
+ , bench "encodeS8" $ whnf encodeS8 s8Val
+ , bench "encodeS16" $ whnf encodeS16 s16Val
+ , bench "encodeS32" $ whnf encodeS32 s32Val
+ , bench "encodeS64" $ whnf encodeS64 s64Val
+ , bench "encodeTu16/0" $ whnf encodeTu16 tu16Zero
+ , bench "encodeTu16/small" $ whnf encodeTu16 tu16Small
+ , bench "encodeTu16/max" $ whnf encodeTu16 tu16Max
+ , bench "encodeTu32/0" $ whnf encodeTu32 tu32Zero
+ , bench "encodeTu32/small" $ whnf encodeTu32 tu32Small
+ , bench "encodeTu32/max" $ whnf encodeTu32 tu32Max
+ , bench "encodeTu64/0" $ whnf encodeTu64 tu64Zero
+ , bench "encodeTu64/small" $ whnf encodeTu64 tu64Small
+ , bench "encodeTu64/max" $ whnf encodeTu64 tu64Max
+ , bench "encodeMinSigned/0" $ whnf encodeMinSigned ms0
+ , bench "encodeMinSigned/127" $ whnf encodeMinSigned ms127
+ , bench "encodeMinSigned/128" $ whnf encodeMinSigned ms128
+ , bench "encodeMinSigned/-128" $ whnf encodeMinSigned msNeg128
+ , bench "encodeMinSigned/-129" $ whnf encodeMinSigned msNeg129
+ , bench "encodeBigSize/0" $ whnf encodeBigSize bs0
+ , bench "encodeBigSize/252" $ whnf encodeBigSize bs252
+ , bench "encodeBigSize/253" $ whnf encodeBigSize bs253
+ , bench "encodeBigSize/65535" $ whnf encodeBigSize bs65535
+ , bench "encodeBigSize/65536" $ whnf encodeBigSize bs65536
+ , bench "encodeBigSize/large" $ whnf encodeBigSize bsLarge
+ ]
+
+ , bgroup "prim/decode"
+ [ bench "decodeU16" $ nf decodeU16 encodedU16
+ , bench "decodeU32" $ nf decodeU32 encodedU32
+ , bench "decodeU64" $ nf decodeU64 encodedU64
+ , bench "decodeS8" $ nf decodeS8 encodedS8
+ , bench "decodeS16" $ nf decodeS16 encodedS16
+ , bench "decodeS32" $ nf decodeS32 encodedS32
+ , bench "decodeS64" $ nf decodeS64 encodedS64
+ , bench "decodeTu16" $ nf (decodeTu16 1) encodedTu16Small
+ , bench "decodeTu32" $ nf (decodeTu32 1) encodedTu32Small
+ , bench "decodeTu64" $ nf (decodeTu64 1) encodedTu64Small
+ , bench "decodeMinSigned/1" $ nf (decodeMinSigned 1) encodedMs127
+ , bench "decodeMinSigned/2" $ nf (decodeMinSigned 2) encodedMsNeg129
+ , bench "decodeBigSize/0" $ nf decodeBigSize encodedBs0
+ , bench "decodeBigSize/253" $ nf decodeBigSize encodedBs253
+ , bench "decodeBigSize/65536" $ nf decodeBigSize encodedBs65536
+ , bench "decodeBigSize/large" $ nf decodeBigSize encodedBsLarge
+ ]
+
+ , bgroup "tlv/encode"
+ [ bench "encodeTlvRecord" $ whnf encodeTlvRecord tlvRec1
+ , bench "encodeTlvStream/1" $ whnf encodeTlvStream tlvStream1
+ , bench "encodeTlvStream/5" $ whnf encodeTlvStream tlvStream5
+ , bench "encodeTlvStream/20" $ whnf encodeTlvStream tlvStream20
+ , bench "encodeInitTlvs" $ nf encodeInitTlvs initTlvNetworks
+ ]
+
+ , bgroup "tlv/decode"
+ [ bench "decodeTlvStreamRaw/1" $ nf decodeTlvStreamRaw encodedTlvStream1
+ , bench "decodeTlvStreamRaw/5" $ nf decodeTlvStreamRaw encodedTlvStream5
+ , bench "decodeTlvStreamRaw/20" $ nf decodeTlvStreamRaw encodedTlvStream20
+ , bench "decodeTlvStream" $ nf decodeTlvStream encodedInitTlvs
+ , bench "decodeTlvStreamWith" $
+ nf (decodeTlvStreamWith (const True)) encodedTlvStream5
+ , bench "parseInitTlvs" $
+ nf parseInitTlvs (encodeInitTlvs initTlvNetworks)
+ ]
+
+ , bgroup "message/encode"
+ [ bench "encodeInit/minimal" $ nf encodeInit initMinimal
+ , bench "encodeInit/with-tlvs" $ nf encodeInit initWithTlvs
+ , bench "encodeError/minimal" $ nf encodeError errorMinimal
+ , bench "encodeError/with-data" $ nf encodeError errorWithData
+ , bench "encodeWarning" $ nf encodeWarning warningMsg
+ , bench "encodePing/minimal" $ nf encodePing pingMinimal
+ , bench "encodePing/with-padding" $ nf encodePing pingWithPadding
+ , bench "encodePong" $ nf encodePong pongMsg
+ , bench "encodePeerStorage" $ nf encodePeerStorage peerStorageMsg
+ , bench "encodePeerStorageRetrieval" $
+ nf encodePeerStorageRetrieval peerStorageRetMsg
+ ]
+
+ , bgroup "message/decode"
+ [ bench "decodeInit/minimal" $ nf decodeInit encodedInitMinimal
+ , bench "decodeInit/with-tlvs" $ nf decodeInit encodedInitWithTlvs
+ , bench "decodeError/minimal" $ nf decodeError encodedErrorMinimal
+ , bench "decodeError/with-data" $ nf decodeError encodedErrorWithData
+ , bench "decodeWarning" $ nf decodeWarning encodedWarning
+ , bench "decodePing/minimal" $ nf decodePing encodedPingMinimal
+ , bench "decodePing/with-padding" $ nf decodePing encodedPingWithPadding
+ , bench "decodePong" $ nf decodePong encodedPong
+ , bench "decodePeerStorage" $ nf decodePeerStorage encodedPeerStorage
+ , bench "decodePeerStorageRetrieval" $
+ nf decodePeerStorageRetrieval encodedPeerStorageRet
+ ]
+
+ , bgroup "envelope"
+ [ bench "encodeEnvelope/no-ext" $ nf (encodeEnvelope msgPing) Nothing
+ , bench "encodeEnvelope/with-ext" $
+ nf (encodeEnvelope msgPing) (Just tlvStream5)
+ , bench "decodeEnvelope/no-ext" $ nf decodeEnvelope encodedEnvelopeNoExt
+ , bench "decodeEnvelope/with-ext" $
+ nf decodeEnvelope encodedEnvelopeWithExt
+ , bench "decodeEnvelopeWith" $
+ nf (decodeEnvelopeWith (const True)) encodedEnvelopeWithExt
+ ]
+
+ , bgroup "roundtrip"
+ [ bench "init/minimal" $ nf (decodeInit . forceRight . encodeInit)
+ initMinimal
+ , bench "init/with-tlvs" $ nf (decodeInit . forceRight . encodeInit)
+ initWithTlvs
+ , bench "error" $ nf (decodeError . forceRight . encodeError) errorWithData
+ , bench "warning" $ nf (decodeWarning . forceRight . encodeWarning)
+ warningMsg
+ , bench "ping" $ nf (decodePing . forceRight . encodePing) pingWithPadding
+ , bench "pong" $ nf (decodePong . forceRight . encodePong) pongMsg
+ , bench "peer-storage" $
+ nf (decodePeerStorage . forceRight . encodePeerStorage) peerStorageMsg
+ , bench "peer-storage-retrieval" $
+ nf (decodePeerStorageRetrieval . forceRight . encodePeerStorageRetrieval)
+ peerStorageRetMsg
+ , bench "envelope" $ nf
+ (decodeEnvelope . forceRight . encodeEnvelope msgPing) (Just tlvStream5)
+ ]
]
+
+-- Helper for roundtrip benchmarks
+forceRight :: Either a b -> b
+forceRight (Right b) = b
+forceRight (Left _) = error "forceRight: Left"
+{-# INLINE forceRight #-}
