commit a2df1e41a98a39eea2adbd5253932ed187769416
parent 29d72235097657273919adcf73f4030d6d7a9b7d
Author: Jared Tobin <jared@jtobin.io>
Date: Sun, 11 Jan 2026 14:16:52 +0400
bench: skeleton
Diffstat:
4 files changed, 201 insertions(+), 5 deletions(-)
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -1,4 +1,97 @@
+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
module Main where
+import Control.DeepSeq
+import Criterion.Main
+import qualified Data.ByteString as BS
+import qualified Lightning.Protocol.BOLT8 as BOLT8
+
+instance NFData BOLT8.Pub where
+ rnf p = rnf (BOLT8.serialize_pub p)
+
+instance NFData BOLT8.Sec
+instance NFData BOLT8.Error
+instance NFData BOLT8.Session
+instance NFData BOLT8.HandshakeState
+instance NFData BOLT8.HandshakeResult
+
main :: IO ()
-main = pure ()
+main = defaultMain [
+ keys
+ , handshake
+ , messages
+ ]
+
+-- test keys (from BOLT #8 spec)
+i_s_ent, i_e_ent, r_s_ent, r_e_ent :: BS.ByteString
+i_s_ent = BS.replicate 32 0x11
+i_e_ent = BS.replicate 32 0x12
+r_s_ent = BS.replicate 32 0x21
+r_e_ent = BS.replicate 32 0x22
+
+keys :: Benchmark
+keys = bgroup "keys" [
+ bench "keypair" $ nf BOLT8.keypair i_s_ent
+ , bench "parse_pub" $ nf BOLT8.parse_pub r_s_pub_bs
+ , bench "serialize_pub" $ nf BOLT8.serialize_pub r_s_pub
+ ]
+ where
+ Just (_, r_s_pub) = BOLT8.keypair r_s_ent
+ r_s_pub_bs = BOLT8.serialize_pub r_s_pub
+
+handshake :: Benchmark
+handshake = env setup $ \ ~(i_s_sec, i_s_pub, r_s_sec, r_s_pub, act1, i_hs,
+ act2, r_hs, act3) ->
+ bgroup "handshake" [
+ bench "initiator_act1" $
+ nf (BOLT8.initiator_act1 i_s_sec i_s_pub r_s_pub) i_e_ent
+ , bench "responder_act2" $
+ nf (BOLT8.responder_act2 r_s_sec r_s_pub r_e_ent) act1
+ , bench "initiator_act3" $
+ nf (BOLT8.initiator_act3 i_hs) act2
+ , bench "responder_finalize" $
+ nf (BOLT8.responder_finalize r_hs) act3
+ ]
+ where
+ setup = do
+ let Just (!i_s_sec, !i_s_pub) = BOLT8.keypair i_s_ent
+ Just (!r_s_sec, !r_s_pub) = BOLT8.keypair r_s_ent
+ Right (!act1, !i_hs) =
+ BOLT8.initiator_act1 i_s_sec i_s_pub r_s_pub i_e_ent
+ Right (!act2, !r_hs) =
+ BOLT8.responder_act2 r_s_sec r_s_pub r_e_ent act1
+ Right (!act3, _) = BOLT8.initiator_act3 i_hs act2
+ pure (i_s_sec, i_s_pub, r_s_sec, r_s_pub, act1, i_hs, act2, r_hs, act3)
+
+messages :: Benchmark
+messages = env setup $ \ ~(i_sess, r_sess, ct_small, ct_large) ->
+ bgroup "messages" [
+ bench "encrypt (32B)" $
+ nf (BOLT8.encrypt_message i_sess) small_msg
+ , bench "encrypt (1KB)" $
+ nf (BOLT8.encrypt_message i_sess) large_msg
+ , bench "decrypt (32B)" $
+ nf (BOLT8.decrypt_message r_sess) ct_small
+ , bench "decrypt (1KB)" $
+ nf (BOLT8.decrypt_message r_sess) ct_large
+ ]
+ where
+ small_msg = BS.replicate 32 0x00
+ large_msg = BS.replicate 1024 0x00
+ setup = do
+ let Just (!i_s_sec, !i_s_pub) = BOLT8.keypair i_s_ent
+ Just (!r_s_sec, !r_s_pub) = BOLT8.keypair r_s_ent
+ Right (act1, i_hs) =
+ BOLT8.initiator_act1 i_s_sec i_s_pub r_s_pub i_e_ent
+ Right (act2, r_hs) =
+ BOLT8.responder_act2 r_s_sec r_s_pub r_e_ent act1
+ Right (act3, i_result) = BOLT8.initiator_act3 i_hs act2
+ Right r_result = BOLT8.responder_finalize r_hs act3
+ !i_sess = BOLT8.hr_session i_result
+ !r_sess = BOLT8.hr_session r_result
+ Right (!ct_small, _) = BOLT8.encrypt_message i_sess small_msg
+ Right (!ct_large, _) = BOLT8.encrypt_message i_sess large_msg
+ pure (i_sess, r_sess, ct_small, ct_large)
diff --git a/bench/Weight.hs b/bench/Weight.hs
@@ -0,0 +1,81 @@
+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import Control.DeepSeq
+import qualified Data.ByteString as BS
+import qualified Lightning.Protocol.BOLT8 as BOLT8
+import Weigh
+
+instance NFData BOLT8.Pub where
+ rnf p = rnf (BOLT8.serialize_pub p)
+
+instance NFData BOLT8.Sec
+instance NFData BOLT8.Error
+instance NFData BOLT8.Session
+instance NFData BOLT8.HandshakeState
+instance NFData BOLT8.HandshakeResult
+
+-- note that 'weigh' doesn't work properly in a repl
+main :: IO ()
+main = mainWith $ do
+ keys
+ handshake
+ messages
+
+-- test keys (from BOLT #8 spec)
+i_s_ent, i_e_ent, r_s_ent, r_e_ent :: BS.ByteString
+i_s_ent = BS.replicate 32 0x11
+i_e_ent = BS.replicate 32 0x12
+r_s_ent = BS.replicate 32 0x21
+r_e_ent = BS.replicate 32 0x22
+
+keys :: Weigh ()
+keys =
+ let Just (_, !r_s_pub) = BOLT8.keypair r_s_ent
+ !r_s_pub_bs = BOLT8.serialize_pub r_s_pub
+ in wgroup "keys" $ do
+ func "keypair" BOLT8.keypair i_s_ent
+ func "parse_pub" BOLT8.parse_pub r_s_pub_bs
+ func "serialize_pub" BOLT8.serialize_pub r_s_pub
+
+handshake :: Weigh ()
+handshake =
+ let Just (!i_s_sec, !i_s_pub) = BOLT8.keypair i_s_ent
+ Just (!r_s_sec, !r_s_pub) = BOLT8.keypair r_s_ent
+ Right (!act1, !i_hs) =
+ BOLT8.initiator_act1 i_s_sec i_s_pub r_s_pub i_e_ent
+ Right (!act2, !r_hs) =
+ BOLT8.responder_act2 r_s_sec r_s_pub r_e_ent act1
+ Right (!act3, _) = BOLT8.initiator_act3 i_hs act2
+ in wgroup "handshake" $ do
+ func "initiator_act1"
+ (BOLT8.initiator_act1 i_s_sec i_s_pub r_s_pub) i_e_ent
+ func "responder_act2"
+ (BOLT8.responder_act2 r_s_sec r_s_pub r_e_ent) act1
+ func "initiator_act3" (BOLT8.initiator_act3 i_hs) act2
+ func "responder_finalize" (BOLT8.responder_finalize r_hs) act3
+
+messages :: Weigh ()
+messages =
+ let Just (!i_s_sec, !i_s_pub) = BOLT8.keypair i_s_ent
+ Just (!r_s_sec, !r_s_pub) = BOLT8.keypair r_s_ent
+ Right (act1, i_hs) =
+ BOLT8.initiator_act1 i_s_sec i_s_pub r_s_pub i_e_ent
+ Right (act2, r_hs) =
+ BOLT8.responder_act2 r_s_sec r_s_pub r_e_ent act1
+ Right (act3, i_result) = BOLT8.initiator_act3 i_hs act2
+ Right r_result = BOLT8.responder_finalize r_hs act3
+ !i_sess = BOLT8.hr_session i_result
+ !r_sess = BOLT8.hr_session r_result
+ !small_msg = BS.replicate 32 0x00
+ !large_msg = BS.replicate 1024 0x00
+ Right (!ct_small, _) = BOLT8.encrypt_message i_sess small_msg
+ Right (!ct_large, _) = BOLT8.encrypt_message i_sess large_msg
+ in wgroup "messages" $ do
+ func "encrypt (32B)" (BOLT8.encrypt_message i_sess) small_msg
+ func "encrypt (1KB)" (BOLT8.encrypt_message i_sess) large_msg
+ func "decrypt (32B)" (BOLT8.decrypt_message r_sess) ct_small
+ func "decrypt (1KB)" (BOLT8.decrypt_message r_sess) ct_large
diff --git a/lib/Lightning/Protocol/BOLT8.hs b/lib/Lightning/Protocol/BOLT8.hs
@@ -1,5 +1,6 @@
{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
@@ -35,6 +36,7 @@ module Lightning.Protocol.BOLT8 (
-- * Session
, Session
+ , HandshakeState
, HandshakeResult(..)
, encrypt_message
, decrypt_message
@@ -51,12 +53,13 @@ import qualified Crypto.KDF.HMAC as HKDF
import Data.Bits (unsafeShiftR, (.&.))
import qualified Data.ByteString as BS
import Data.Word (Word16, Word64)
+import GHC.Generics (Generic)
-- types ---------------------------------------------------------------------
-- | Secret key (32 bytes).
newtype Sec = Sec BS.ByteString
- deriving Eq
+ deriving (Eq, Generic)
-- | Compressed public key.
newtype Pub = Pub Secp256k1.Projective
@@ -76,7 +79,7 @@ data Error =
| InvalidVersion
| InvalidLength
| DecryptionFailed
- deriving (Eq, Show)
+ deriving (Eq, Show, Generic)
-- | Post-handshake session state.
data Session = Session {
@@ -87,14 +90,16 @@ data Session = Session {
, sess_rn :: {-# UNPACK #-} !Word64 -- ^ receive nonce
, sess_rck :: {-# UNPACK #-} !BS.ByteString -- ^ receive chaining key
}
+ deriving Generic
-- | Result of a successful handshake.
data HandshakeResult = HandshakeResult {
hr_session :: !Session -- ^ session state
, hr_remote_pk :: !Pub -- ^ authenticated remote static pubkey
}
+ deriving Generic
--- internal handshake state
+-- | Internal handshake state (exported for benchmarking).
data HandshakeState = HandshakeState {
hs_h :: {-# UNPACK #-} !BS.ByteString -- handshake hash (32 bytes)
, hs_ck :: {-# UNPACK #-} !BS.ByteString -- chaining key (32 bytes)
@@ -106,6 +111,7 @@ data HandshakeState = HandshakeState {
, hs_re :: !(Maybe Pub) -- remote ephemeral
, hs_rs :: !(Maybe Pub) -- remote static
}
+ deriving Generic
-- protocol constants --------------------------------------------------------
diff --git a/ppad-bolt8.cabal b/ppad-bolt8.cabal
@@ -57,7 +57,7 @@ benchmark bolt8-bench
main-is: Main.hs
ghc-options:
- -rtsopts -O2 -Wall
+ -rtsopts -O2 -Wall -fno-warn-orphans
build-depends:
base
@@ -66,3 +66,19 @@ benchmark bolt8-bench
, deepseq
, ppad-bolt8
+benchmark bolt8-weigh
+ type: exitcode-stdio-1.0
+ default-language: Haskell2010
+ hs-source-dirs: bench
+ main-is: Weight.hs
+
+ ghc-options:
+ -rtsopts -O2 -Wall -fno-warn-orphans
+
+ build-depends:
+ base
+ , bytestring
+ , deepseq
+ , ppad-bolt8
+ , weigh
+