commit e4b21c67885bebe6168b5ab374bbac76feeece68
parent 5e84a235ed9ceb051653fba1fd2d09661a70839d
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 10 Oct 2026 14:57:30 +0400
bench: add criterion and weigh suites
Benchmark onion construction (1, 5 and 20 hops), processing (forward,
receive and blinded forward), error construction, wrapping and
attribution, blinded path creation and decryption, and the packet and
payload codecs, forcing results fully.
Diffstat:
4 files changed, 233 insertions(+), 7 deletions(-)
diff --git a/bench/Fixtures.hs b/bench/Fixtures.hs
@@ -0,0 +1,150 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Fixtures (
+ Fixtures(..)
+ , fixtures
+ ) where
+
+import Control.DeepSeq (NFData(..))
+import qualified Data.ByteString as BS
+import qualified Lightning.Protocol.BOLT1 as BOLT1
+import Lightning.Protocol.BOLT4
+
+data Fixtures = Fixtures {
+ fx_session :: !SecretKey
+ , fx_ad :: !BS.ByteString
+ , fx_route_1 :: ![Hop]
+ , fx_route_5 :: ![Hop]
+ , fx_route_20 :: ![Hop]
+ , fx_first_node :: !SecretKey
+ , fx_onion_5 :: !OnionPacket
+ , fx_onion_1 :: !OnionPacket
+ , fx_secrets_5 :: ![SharedSecret]
+ , fx_secret :: !SharedSecret
+ , fx_blinded_node :: !SecretKey
+ , fx_blinded_onion :: !OnionPacket
+ , fx_path_key :: !BOLT1.Point
+ , fx_path_seed :: !SecretKey
+ , fx_path_nodes :: ![(BOLT1.Point, BlindedHopData)]
+ , fx_encrypted :: !BS.ByteString
+ , fx_failure :: !FailureMessage
+ , fx_error :: !ErrorPacket
+ , fx_returned :: !ErrorPacket
+ , fx_onion_bytes :: !BS.ByteString
+ , fx_payload :: !HopPayload
+ , fx_payload_bytes :: !BS.ByteString
+ }
+
+instance NFData Fixtures where
+ rnf (Fixtures a b c d e f g h i j k l m n o p q r s t u v) =
+ rnf a `seq` rnf b `seq` rnf c `seq` rnf d `seq` rnf e `seq` rnf f
+ `seq` rnf g `seq` rnf h `seq` rnf i `seq` rnf j `seq` rnf k
+ `seq` rnf l `seq` rnf m `seq` rnf n `seq` rnf o `seq` rnf p
+ `seq` rnf q `seq` rnf r `seq` rnf s `seq` rnf t `seq` rnf u
+ `seq` rnf v
+
+demand :: String -> Maybe a -> IO a
+demand msg = maybe (ioError (userError msg)) pure
+
+right :: Show e => String -> Either e a -> IO a
+right msg = either (ioError . userError . (msg ++) . (": " ++) . show) pure
+
+fixtures :: IO Fixtures
+fixtures = do
+ let key b = demand "secret_key" (secret_key (BS.replicate 32 b))
+ ad = BS.replicate 32 0x42
+ session <- key 0x41
+ nodes <- mapM key [1 .. 20]
+ amt <- demand "milli_satoshi" (BOLT1.milli_satoshi 100000)
+ scid <- demand "short_channel_id" (BOLT1.short_channel_id 800000 1 0)
+ ps <- demand "payment_secret" (payment_secret (BS.replicate 32 0xaa))
+ let fwd = empty_hop_payload
+ { hp_amt_to_forward = Just amt
+ , hp_outgoing_cltv_value = Just 800000
+ , hp_short_channel_id = Just scid
+ }
+ final = empty_hop_payload
+ { hp_amt_to_forward = Just amt
+ , hp_outgoing_cltv_value = Just 800000
+ , hp_payment_data = Just (PaymentData ps amt)
+ }
+ route n = [ Hop (public_key k) fwd | k <- take (n - 1) nodes ]
+ ++ [ Hop (public_key k) final
+ | k <- take 1 (drop (n - 1) nodes) ]
+ first_node <- demand "node" (safe_head nodes)
+ (onion_5, secrets_5) <- right "construct" (construct session (route 5) ad)
+ (onion_1, _) <- right "construct" (construct session (route 1) ad)
+
+ -- a blinded route through nodes 1 to 3, entered at node 0
+ seed <- key 0x55
+ let relay = empty_blinded_hop_data
+ { bhd_short_channel_id = Just scid
+ , bhd_payment_relay = Just (PaymentRelay 40 100 1000)
+ }
+ path_nodes = [ (public_key k, relay) | k <- take 2 (drop 1 nodes) ]
+ ++ [ (public_key k, empty_blinded_hop_data
+ { bhd_path_id = Just (BS.replicate 32 1) })
+ | k <- take 1 (drop 3 nodes) ]
+ path <- right "create_blinded_path" (create_blinded_path seed path_nodes)
+ hops <- case bp_hops path of
+ [h1, h2, h3] -> pure (h1, h2, h3)
+ _ -> ioError (userError "expected 3 blinded hops")
+ let (h1, h2, h3) = hops
+ bhop h pl = Hop (bh_blinded_node_id h)
+ pl { hp_encrypted_data = Just (bh_encrypted_data h) }
+ entry = Hop (public_key first_node) fwd
+ broute = [ entry
+ , Hop (bp_first_node_id path) empty_hop_payload
+ { hp_encrypted_data = Just (bh_encrypted_data h1)
+ , hp_current_path_key = Just (bp_first_path_key path) }
+ , bhop h2 empty_hop_payload
+ , bhop h3 empty_hop_payload
+ { hp_amt_to_forward = Just amt
+ , hp_outgoing_cltv_value = Just 800000
+ , hp_total_amount_msat = Just amt } ]
+ (bonion, _) <- right "construct" (construct session broute ad)
+ -- the onion received, with a path_key, by node 2
+ node1 <- demand "node" (safe_head (drop 1 nodes))
+ node2 <- demand "node" (safe_head (drop 2 nodes))
+ f0 <- forwarded (process first_node bonion ad Nothing)
+ f1 <- forwarded (process node1 (fwd_next_packet f0) ad Nothing)
+ b1 <- demand "blinded" (fwd_blinded f1)
+
+ -- node 4 fails a 5-hop payment
+ ss4 <- demand "secret" (safe_head (drop 4 secrets_5))
+ let failure = FailureMessage TemporaryNodeFailure BOLT1.empty_tlv_stream
+ err <- right "construct_error" (construct_error ss4 failure)
+ let returned = foldr wrap_error err (take 4 secrets_5)
+
+ payload_bytes <- right "encode_hop_payload" (encode_hop_payload final)
+ pure Fixtures {
+ fx_session = session
+ , fx_ad = ad
+ , fx_route_1 = route 1
+ , fx_route_5 = route 5
+ , fx_route_20 = route 20
+ , fx_first_node = first_node
+ , fx_onion_5 = onion_5
+ , fx_onion_1 = onion_1
+ , fx_secrets_5 = secrets_5
+ , fx_secret = ss4
+ , fx_blinded_node = node2
+ , fx_blinded_onion = fwd_next_packet f1
+ , fx_path_key = bi_next_path_key b1
+ , fx_path_seed = seed
+ , fx_path_nodes = path_nodes
+ , fx_encrypted = bh_encrypted_data h2
+ , fx_failure = failure
+ , fx_error = err
+ , fx_returned = returned
+ , fx_onion_bytes = encode_onion_packet onion_5
+ , fx_payload = final
+ , fx_payload_bytes = payload_bytes
+ }
+ where
+ safe_head xs = case xs of
+ x : _ -> Just x
+ [] -> Nothing
+ forwarded r = case r of
+ Right (Forward f) -> pure f
+ _ -> ioError (userError ("expected Forward: " ++ show r))
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -1,10 +1,55 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE OverloadedStrings #-}
-
module Main where
import Criterion.Main
+import Fixtures
+import Lightning.Protocol.BOLT4
main :: IO ()
main = defaultMain [
+ env fixtures $ \fx -> bgroup "ppad-bolt4" [
+ bgroup "construct" [
+ bench "1 hop" $
+ nf (construct (fx_session fx) (fx_route_1 fx)) (fx_ad fx)
+ , bench "5 hops" $
+ nf (construct (fx_session fx) (fx_route_5 fx)) (fx_ad fx)
+ , bench "20 hops" $
+ nf (construct (fx_session fx) (fx_route_20 fx)) (fx_ad fx)
+ ]
+ , bgroup "process" [
+ bench "forward" $
+ nf (process (fx_first_node fx) (fx_onion_5 fx) (fx_ad fx))
+ Nothing
+ , bench "receive" $
+ nf (process (fx_first_node fx) (fx_onion_1 fx) (fx_ad fx))
+ Nothing
+ , bench "forward (blinded)" $
+ nf (process (fx_blinded_node fx) (fx_blinded_onion fx) (fx_ad fx))
+ (Just (fx_path_key fx))
+ ]
+ , bgroup "returning errors" [
+ bench "construct_error" $
+ nf (construct_error (fx_secret fx)) (fx_failure fx)
+ , bench "wrap_error" $
+ nf (wrap_error (fx_secret fx)) (fx_error fx)
+ , bench "unwrap_error (hop 4 of 5)" $
+ nf (unwrap_error (fx_secrets_5 fx)) (fx_returned fx)
+ ]
+ , bgroup "route blinding" [
+ bench "create_blinded_path (3 hops)" $
+ nf (create_blinded_path (fx_path_seed fx)) (fx_path_nodes fx)
+ , bench "decrypt_recipient_data" $
+ nf (decrypt_recipient_data (fx_blinded_node fx) (fx_path_key fx))
+ (fx_encrypted fx)
+ ]
+ , bgroup "codecs" [
+ bench "encode_onion_packet" $
+ nf encode_onion_packet (fx_onion_5 fx)
+ , bench "decode_onion_packet" $
+ nf decode_onion_packet (fx_onion_bytes fx)
+ , bench "encode_hop_payload" $
+ nf encode_hop_payload (fx_payload fx)
+ , bench "decode_hop_payload" $
+ nf decode_hop_payload (fx_payload_bytes fx)
+ ]
+ ]
]
diff --git a/bench/Weight.hs b/bench/Weight.hs
@@ -1,9 +1,38 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE OverloadedStrings #-}
-
module Main where
+import Fixtures
+import Lightning.Protocol.BOLT4
import Weigh
main :: IO ()
-main = mainWith (pure ())
+main = do
+ fx <- fixtures
+ mainWith $ do
+ wgroup "construct" $ do
+ func "1 hop" (construct (fx_session fx) (fx_route_1 fx)) (fx_ad fx)
+ func "5 hops" (construct (fx_session fx) (fx_route_5 fx)) (fx_ad fx)
+ func "20 hops" (construct (fx_session fx) (fx_route_20 fx)) (fx_ad fx)
+ wgroup "process" $ do
+ func "forward"
+ (process (fx_first_node fx) (fx_onion_5 fx) (fx_ad fx)) Nothing
+ func "receive"
+ (process (fx_first_node fx) (fx_onion_1 fx) (fx_ad fx)) Nothing
+ func "forward (blinded)"
+ (process (fx_blinded_node fx) (fx_blinded_onion fx) (fx_ad fx))
+ (Just (fx_path_key fx))
+ wgroup "returning errors" $ do
+ func "construct_error" (construct_error (fx_secret fx)) (fx_failure fx)
+ func "wrap_error" (wrap_error (fx_secret fx)) (fx_error fx)
+ func "unwrap_error (hop 4 of 5)"
+ (unwrap_error (fx_secrets_5 fx)) (fx_returned fx)
+ wgroup "route blinding" $ do
+ func "create_blinded_path (3 hops)"
+ (create_blinded_path (fx_path_seed fx)) (fx_path_nodes fx)
+ func "decrypt_recipient_data"
+ (decrypt_recipient_data (fx_blinded_node fx) (fx_path_key fx))
+ (fx_encrypted fx)
+ wgroup "codecs" $ do
+ func "encode_onion_packet" encode_onion_packet (fx_onion_5 fx)
+ func "decode_onion_packet" decode_onion_packet (fx_onion_bytes fx)
+ func "encode_hop_payload" encode_hop_payload (fx_payload fx)
+ func "decode_hop_payload" decode_hop_payload (fx_payload_bytes fx)
diff --git a/ppad-bolt4.cabal b/ppad-bolt4.cabal
@@ -74,6 +74,7 @@ benchmark bolt4-bench
default-language: Haskell2010
hs-source-dirs: bench
main-is: Main.hs
+ other-modules: Fixtures
ghc-options:
-rtsopts -O2 -Wall
build-depends:
@@ -89,6 +90,7 @@ benchmark bolt4-weigh
default-language: Haskell2010
hs-source-dirs: bench
main-is: Weight.hs
+ other-modules: Fixtures
ghc-options:
-rtsopts -O2 -Wall
build-depends:
