ppad-bolt8 (empty) → 0.0.1
raw patch · 7 files changed
+1632/−0 lines, 7 filesdep +QuickCheckdep +basedep +bytestring
Dependencies added: QuickCheck, base, bytestring, criterion, deepseq, ppad-aead, ppad-base16, ppad-bolt8, ppad-hkdf, ppad-secp256k1, ppad-sha256, tasty, tasty-hunit, tasty-quickcheck, weigh
Files
- CHANGELOG +0/−0
- LICENSE +20/−0
- bench/Main.hs +85/−0
- bench/Weight.hs +75/−0
- lib/Lightning/Protocol/BOLT8.hs +709/−0
- ppad-bolt8.cabal +86/−0
- test/Main.hs +657/−0
+ CHANGELOG view
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2025 Jared Tobin++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ bench/Main.hs view
@@ -0,0 +1,85 @@+{-# 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.Handshake++main :: IO ()+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, msg1, i_hs,+ msg2, r_hs, msg3) ->+ bgroup "handshake" [+ bench "act1" $ nf (BOLT8.act1 i_s_sec i_s_pub r_s_pub) i_e_ent+ , bench "act2" $ nf (BOLT8.act2 r_s_sec r_s_pub r_e_ent) msg1+ , bench "act3" $ nf (BOLT8.act3 i_hs) msg2+ , bench "finalize" $ nf (BOLT8.finalize r_hs) msg3+ ]+ 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 (!msg1, !i_hs) = BOLT8.act1 i_s_sec i_s_pub r_s_pub i_e_ent+ Right (!msg2, !r_hs) = BOLT8.act2 r_s_sec r_s_pub r_e_ent msg1+ Right (!msg3, _) = BOLT8.act3 i_hs msg2+ pure (i_s_sec, i_s_pub, r_s_sec, r_s_pub, msg1, i_hs, msg2, r_hs, msg3)++messages :: Benchmark+messages = env setup $ \ ~(i_sess, r_sess, ct_small, ct_large) ->+ bgroup "messages" [+ bench "encrypt (32B)" $ nf (BOLT8.encrypt i_sess) small_msg+ , bench "encrypt (1KB)" $ nf (BOLT8.encrypt i_sess) large_msg+ , bench "decrypt (32B)" $ nf (BOLT8.decrypt r_sess) ct_small+ , bench "decrypt (1KB)" $ nf (BOLT8.decrypt 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 (msg1, i_hs) = BOLT8.act1 i_s_sec i_s_pub r_s_pub i_e_ent+ Right (msg2, r_hs) = BOLT8.act2 r_s_sec r_s_pub r_e_ent msg1+ Right (msg3, i_result) = BOLT8.act3 i_hs msg2+ Right r_result = BOLT8.finalize r_hs msg3+ !i_sess = BOLT8.session i_result+ !r_sess = BOLT8.session r_result+ Right (!ct_small, _) = BOLT8.encrypt i_sess small_msg+ Right (!ct_large, _) = BOLT8.encrypt i_sess large_msg+ pure (i_sess, r_sess, ct_small, ct_large)
+ bench/Weight.hs view
@@ -0,0 +1,75 @@+{-# 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.Handshake++-- 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 (!msg1, !i_hs) = BOLT8.act1 i_s_sec i_s_pub r_s_pub i_e_ent+ Right (!msg2, !r_hs) = BOLT8.act2 r_s_sec r_s_pub r_e_ent msg1+ Right (!msg3, _) = BOLT8.act3 i_hs msg2+ in wgroup "handshake" $ do+ func "act1" (BOLT8.act1 i_s_sec i_s_pub r_s_pub) i_e_ent+ func "act2" (BOLT8.act2 r_s_sec r_s_pub r_e_ent) msg1+ func "act3" (BOLT8.act3 i_hs) msg2+ func "finalize" (BOLT8.finalize r_hs) msg3++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 (msg1, i_hs) = BOLT8.act1 i_s_sec i_s_pub r_s_pub i_e_ent+ Right (msg2, r_hs) = BOLT8.act2 r_s_sec r_s_pub r_e_ent msg1+ Right (msg3, i_result) = BOLT8.act3 i_hs msg2+ Right r_result = BOLT8.finalize r_hs msg3+ !i_sess = BOLT8.session i_result+ !r_sess = BOLT8.session r_result+ !small_msg = BS.replicate 32 0x00+ !large_msg = BS.replicate 1024 0x00+ Right (!ct_small, _) = BOLT8.encrypt i_sess small_msg+ Right (!ct_large, _) = BOLT8.encrypt i_sess large_msg+ in wgroup "messages" $ do+ func "encrypt (32B)" (BOLT8.encrypt i_sess) small_msg+ func "encrypt (1KB)" (BOLT8.encrypt i_sess) large_msg+ func "decrypt (32B)" (BOLT8.decrypt r_sess) ct_small+ func "decrypt (1KB)" (BOLT8.decrypt r_sess) ct_large
+ lib/Lightning/Protocol/BOLT8.hs view
@@ -0,0 +1,709 @@+{-# OPTIONS_HADDOCK prune #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}++-- |+-- Module: Lightning.Protocol.BOLT8+-- Copyright: (c) 2025 Jared Tobin+-- License: MIT+-- Maintainer: Jared Tobin <jared@ppad.tech>+--+-- Encrypted and authenticated transport for the Lightning Network, per+-- [BOLT #8](https://github.com/lightning/bolts/blob/master/08-transport.md).+--+-- This module implements the Noise_XK_secp256k1_ChaChaPoly_SHA256+-- handshake and subsequent encrypted message transport.+--+-- = Handshake+--+-- A BOLT #8 handshake consists of three acts. The /initiator/ knows the+-- responder's static public key in advance and initiates the connection:+--+-- @+-- (msg1, state) <- act1 i_sec i_pub r_pub entropy+-- -- send msg1 (50 bytes) to responder+-- -- receive msg2 (50 bytes) from responder+-- (msg3, result) <- act3 state msg2+-- -- send msg3 (66 bytes) to responder+-- let session = 'session' result+-- @+--+-- The /responder/ receives the connection and authenticates the initiator:+--+-- @+-- -- receive msg1 (50 bytes) from initiator+-- (msg2, state) <- act2 r_sec r_pub entropy msg1+-- -- send msg2 (50 bytes) to initiator+-- -- receive msg3 (66 bytes) from initiator+-- result <- finalize state msg3+-- let session = 'session' result+-- @+--+-- = Message Transport+--+-- After a successful handshake, use 'encrypt' and 'decrypt' to exchange+-- messages. Each returns an updated 'Session' that must be used for the+-- next operation (keys rotate every 1000 messages):+--+-- @+-- -- sender+-- (ciphertext, session') <- 'encrypt' session plaintext+--+-- -- receiver+-- (plaintext, session') <- 'decrypt' session ciphertext+-- @+--+-- = Message Framing+--+-- BOLT #8 runs over a byte stream, so callers often need to deal with+-- partial buffers. Use 'decrypt_frame' when you have exactly one frame,+-- or 'decrypt_frame_partial' to handle incremental reads and return how+-- many bytes are still needed.+--+-- Maximum plaintext size is 65535 bytes.++module Lightning.Protocol.BOLT8 (+ -- * Keys+ Sec+ , Pub+ , keypair+ , parse_pub+ , serialize_pub++ -- * Handshake (initiator)+ , act1+ , act3++ -- * Handshake (responder)+ , act2+ , finalize++ -- * Session+ , Session+ , HandshakeState+ , Handshake(..)+ , encrypt+ , decrypt+ , decrypt_frame+ , decrypt_frame_partial+ , FrameResult(..)++ -- * Errors+ , Error(..)+ ) where++import Control.Monad (guard, unless)+import qualified Crypto.AEAD.ChaCha20Poly1305 as AEAD+import qualified Crypto.Curve.Secp256k1 as Secp256k1+import qualified Crypto.Hash.SHA256 as SHA256+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, Generic)++-- | Compressed public key.+newtype Pub = Pub Secp256k1.Projective++instance Eq Pub where+ (Pub a) == (Pub b) =+ Secp256k1.serialize_point a == Secp256k1.serialize_point b++instance Show Pub where+ show (Pub p) = "Pub " ++ show (Secp256k1.serialize_point p)++-- | Handshake errors.+data Error =+ InvalidKey+ | InvalidPub+ | InvalidMAC+ | InvalidVersion+ | InvalidLength+ | DecryptionFailed+ deriving (Eq, Show, Generic)++-- | Result of attempting to decrypt a frame from a partial buffer.+data FrameResult =+ NeedMore {-# UNPACK #-} !Int+ -- ^ More bytes needed; the 'Int' is the minimum additional bytes required.+ | FrameOk !BS.ByteString !BS.ByteString !Session+ -- ^ Successfully decrypted: plaintext, remainder, updated session.+ | FrameError !Error+ -- ^ Decryption failed with the given error.+ deriving Generic++-- | Post-handshake session state.+data Session = Session {+ sess_sk :: {-# UNPACK #-} !BS.ByteString -- ^ send key (32 bytes)+ , sess_sn :: {-# UNPACK #-} !Word64 -- ^ send nonce+ , sess_sck :: {-# UNPACK #-} !BS.ByteString -- ^ send chaining key+ , sess_rk :: {-# UNPACK #-} !BS.ByteString -- ^ receive key (32 bytes)+ , sess_rn :: {-# UNPACK #-} !Word64 -- ^ receive nonce+ , sess_rck :: {-# UNPACK #-} !BS.ByteString -- ^ receive chaining key+ }+ deriving Generic++-- | Result of a successful handshake.+data Handshake = Handshake {+ session :: !Session -- ^ session state+ , remote_static :: !Pub -- ^ authenticated remote static pubkey+ }+ deriving Generic++-- | 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)+ , hs_temp_k :: {-# UNPACK #-} !BS.ByteString -- temp key (32 bytes)+ , hs_e_sec :: !Sec -- ephemeral secret+ , hs_e_pub :: !Pub -- ephemeral public+ , hs_s_sec :: !Sec -- static secret+ , hs_s_pub :: !Pub -- static public+ , hs_re :: !(Maybe Pub) -- remote ephemeral+ , hs_rs :: !(Maybe Pub) -- remote static+ }+ deriving Generic++-- protocol constants --------------------------------------------------------++_PROTOCOL_NAME :: BS.ByteString+_PROTOCOL_NAME = "Noise_XK_secp256k1_ChaChaPoly_SHA256"++_PROLOGUE :: BS.ByteString+_PROLOGUE = "lightning"++-- key operations ------------------------------------------------------------++-- | Derive a keypair from 32 bytes of entropy.+--+-- Returns Nothing if the entropy is invalid (zero or >= curve order).+--+-- >>> let ent = BS.replicate 32 0x11+-- >>> case keypair ent of { Just _ -> "ok"; Nothing -> "fail" }+-- "ok"+-- >>> keypair (BS.replicate 31 0x11) -- wrong length+-- Nothing+keypair :: BS.ByteString -> Maybe (Sec, Pub)+keypair ent = do+ guard (BS.length ent == 32)+ k <- Secp256k1.parse_int256 ent+ p <- Secp256k1.derive_pub k+ pure (Sec ent, Pub p)++-- | Parse a 33-byte compressed public key.+--+-- >>> let Just (_, pub) = keypair (BS.replicate 32 0x11)+-- >>> let bytes = serialize_pub pub+-- >>> case parse_pub bytes of { Just _ -> "ok"; Nothing -> "fail" }+-- "ok"+-- >>> parse_pub (BS.replicate 32 0x00) -- wrong length+-- Nothing+parse_pub :: BS.ByteString -> Maybe Pub+parse_pub bs = do+ guard (BS.length bs == 33)+ p <- Secp256k1.parse_point bs+ pure (Pub p)++-- | Serialize a public key to 33-byte compressed form.+--+-- >>> let Just (_, pub) = keypair (BS.replicate 32 0x11)+-- >>> BS.length (serialize_pub pub)+-- 33+serialize_pub :: Pub -> BS.ByteString+serialize_pub (Pub p) = Secp256k1.serialize_point p++-- cryptographic primitives --------------------------------------------------++-- bolt8-style ECDH+ecdh :: Sec -> Pub -> Maybe BS.ByteString+ecdh (Sec sec) (Pub pub) = do+ k <- Secp256k1.parse_int256 sec+ pt <- Secp256k1.mul pub k+ let compressed = Secp256k1.serialize_point pt+ pure (SHA256.hash compressed)++-- h' = SHA256(h || data)+mix_hash :: BS.ByteString -> BS.ByteString -> BS.ByteString+mix_hash h dat = SHA256.hash (h <> dat)++-- Mix key: (ck', k) = HKDF(ck, input_key_material)+--+-- NB HKDF limits output to 255 * hashlen bytes. For SHA256 that's 8160,+-- well above the 64 bytes requested here, so 'Nothing' is impossible.+mix_key :: BS.ByteString -> BS.ByteString -> (BS.ByteString, BS.ByteString)+mix_key ck ikm = case HKDF.derive hmac ck mempty 64 ikm of+ Nothing -> error "ppad-bolt8: internal error, please report a bug!"+ Just output -> BS.splitAt 32 output+ where+ hmac k b = case SHA256.hmac k b of+ SHA256.MAC mac -> mac++-- Encrypt with associated data using ChaCha20-Poly1305+encrypt_with_ad+ :: BS.ByteString -- ^ key (32 bytes)+ -> Word64 -- ^ nonce+ -> BS.ByteString -- ^ associated data+ -> BS.ByteString -- ^ plaintext+ -> Maybe BS.ByteString -- ^ ciphertext || mac (16 bytes)+encrypt_with_ad key n ad pt =+ case AEAD.encrypt ad key (encode_nonce n) pt of+ Left _ -> Nothing+ Right (ct, mac) -> Just (ct <> mac)++-- Decrypt with associated data using ChaCha20-Poly1305+decrypt_with_ad+ :: BS.ByteString -- ^ key (32 bytes)+ -> Word64 -- ^ nonce+ -> BS.ByteString -- ^ associated data+ -> BS.ByteString -- ^ ciphertext || mac+ -> Maybe BS.ByteString -- ^ plaintext+decrypt_with_ad key n ad ctmac+ | BS.length ctmac < 16 = Nothing+ | otherwise =+ let (ct, mac) = BS.splitAt (BS.length ctmac - 16) ctmac+ in case AEAD.decrypt ad key (encode_nonce n) (ct, mac) of+ Left _ -> Nothing+ Right pt -> Just pt++-- Encode nonce as 96-bit value: 4 zero bytes + 8-byte little-endian+encode_nonce :: Word64 -> BS.ByteString+encode_nonce n = BS.replicate 4 0x00 <> encode_le64 n++-- Little-endian 64-bit encoding+encode_le64 :: Word64 -> BS.ByteString+encode_le64 n = BS.pack [+ fi (n .&. 0xff)+ , fi (unsafeShiftR n 8 .&. 0xff)+ , fi (unsafeShiftR n 16 .&. 0xff)+ , fi (unsafeShiftR n 24 .&. 0xff)+ , fi (unsafeShiftR n 32 .&. 0xff)+ , fi (unsafeShiftR n 40 .&. 0xff)+ , fi (unsafeShiftR n 48 .&. 0xff)+ , fi (unsafeShiftR n 56 .&. 0xff)+ ]++-- Big-endian 16-bit encoding+encode_be16 :: Word16 -> BS.ByteString+encode_be16 n = BS.pack [fi (unsafeShiftR n 8), fi (n .&. 0xff)]++-- Big-endian 16-bit decoding+decode_be16 :: BS.ByteString -> Maybe Word16+decode_be16 bs+ | BS.length bs /= 2 = Nothing+ | otherwise =+ let !b0 = BS.index bs 0+ !b1 = BS.index bs 1+ in Just (fi b0 * 0x100 + fi b1)++-- handshake -----------------------------------------------------------------++-- Initialize handshake state+--+-- h = SHA256(protocol_name)+-- ck = h+-- h = SHA256(h || prologue)+-- h = SHA256(h || responder_static_pubkey)+init_handshake+ :: Sec -- ^ local static secret+ -> Pub -- ^ local static public+ -> Sec -- ^ ephemeral secret+ -> Pub -- ^ ephemeral public+ -> Maybe Pub -- ^ remote static (initiator knows, responder doesn't)+ -> Bool -- ^ True if initiator+ -> HandshakeState+init_handshake s_sec s_pub e_sec e_pub m_rs is_initiator =+ let !h0 = SHA256.hash _PROTOCOL_NAME+ !ck = h0+ !h1 = mix_hash h0 _PROLOGUE+ -- Mix in responder's static pubkey+ !h2 = case (is_initiator, m_rs) of+ (True, Just rs) -> mix_hash h1 (serialize_pub rs)+ (False, Nothing) -> mix_hash h1 (serialize_pub s_pub)+ _ -> h1 -- shouldn't happen+ in HandshakeState {+ hs_h = h2+ , hs_ck = ck+ , hs_temp_k = BS.replicate 32 0x00+ , hs_e_sec = e_sec+ , hs_e_pub = e_pub+ , hs_s_sec = s_sec+ , hs_s_pub = s_pub+ , hs_re = Nothing+ , hs_rs = m_rs+ }++-- | Initiator: generate Act 1 message (50 bytes).+--+-- Takes local static key, remote static pubkey, and 32 bytes of+-- entropy for ephemeral key generation.+--+-- Returns the 50-byte Act 1 message and handshake state for Act 3.+--+-- >>> let Just (i_sec, i_pub) = keypair (BS.replicate 32 0x11)+-- >>> let Just (r_sec, r_pub) = keypair (BS.replicate 32 0x21)+-- >>> let eph_ent = BS.replicate 32 0x12+-- >>> case act1 i_sec i_pub r_pub eph_ent of { Right (msg, _) -> BS.length msg; Left _ -> 0 }+-- 50+act1+ :: Sec -- ^ local static secret+ -> Pub -- ^ local static public+ -> Pub -- ^ remote static public (responder's)+ -> BS.ByteString -- ^ 32 bytes entropy for ephemeral+ -> Either Error (BS.ByteString, HandshakeState)+act1 s_sec s_pub rs ent = do+ (e_sec, e_pub) <- note InvalidKey (keypair ent)+ let !hs0 = init_handshake s_sec s_pub e_sec e_pub (Just rs) True+ !e_pub_bytes = serialize_pub e_pub+ !h1 = mix_hash (hs_h hs0) e_pub_bytes+ es <- note InvalidKey (ecdh e_sec rs)+ let !(ck1, temp_k1) = mix_key (hs_ck hs0) es+ c <- note InvalidMAC (encrypt_with_ad temp_k1 0 h1 BS.empty)+ let !h2 = mix_hash h1 c+ !msg = BS.singleton 0x00 <> e_pub_bytes <> c+ !hs1 = hs0 {+ hs_h = h2+ , hs_ck = ck1+ , hs_temp_k = temp_k1+ }+ pure (msg, hs1)++-- | Responder: process Act 1 and generate Act 2 message (50 bytes).+--+-- Takes local static key and 32 bytes of entropy for ephemeral key,+-- plus the 50-byte Act 1 message from initiator.+--+-- Returns the 50-byte Act 2 message and handshake state for finalize.+--+-- >>> let Just (i_sec, i_pub) = keypair (BS.replicate 32 0x11)+-- >>> let Just (r_sec, r_pub) = keypair (BS.replicate 32 0x21)+-- >>> let Right (msg1, _) = act1 i_sec i_pub r_pub (BS.replicate 32 0x12)+-- >>> case act2 r_sec r_pub (BS.replicate 32 0x22) msg1 of { Right (msg, _) -> BS.length msg; Left _ -> 0 }+-- 50+act2+ :: Sec -- ^ local static secret+ -> Pub -- ^ local static public+ -> BS.ByteString -- ^ 32 bytes entropy for ephemeral+ -> BS.ByteString -- ^ Act 1 message (50 bytes)+ -> Either Error (BS.ByteString, HandshakeState)+act2 s_sec s_pub ent msg1 = do+ require (BS.length msg1 == 50) InvalidLength+ let !version = BS.index msg1 0+ !re_bytes = BS.take 33 (BS.drop 1 msg1)+ !c = BS.drop 34 msg1+ require (version == 0x00) InvalidVersion+ re <- note InvalidPub (parse_pub re_bytes)+ (e_sec, e_pub) <- note InvalidKey (keypair ent)+ let !hs0 = init_handshake s_sec s_pub e_sec e_pub Nothing False+ !h1 = mix_hash (hs_h hs0) re_bytes+ es <- note InvalidKey (ecdh s_sec re)+ let !(ck1, temp_k1) = mix_key (hs_ck hs0) es+ _ <- note InvalidMAC (decrypt_with_ad temp_k1 0 h1 c)+ let !h2 = mix_hash h1 c+ !e_pub_bytes = serialize_pub e_pub+ !h3 = mix_hash h2 e_pub_bytes+ ee <- note InvalidKey (ecdh e_sec re)+ let !(ck2, temp_k2) = mix_key ck1 ee+ c2 <- note InvalidMAC (encrypt_with_ad temp_k2 0 h3 BS.empty)+ let !h4 = mix_hash h3 c2+ !msg = BS.singleton 0x00 <> e_pub_bytes <> c2+ !hs1 = hs0 {+ hs_h = h4+ , hs_ck = ck2+ , hs_temp_k = temp_k2+ , hs_re = Just re+ }+ pure (msg, hs1)++-- | Initiator: process Act 2 and generate Act 3 (66 bytes), completing+-- the handshake.+--+-- Returns the 66-byte Act 3 message and the handshake result.+--+-- >>> let Just (i_sec, i_pub) = keypair (BS.replicate 32 0x11)+-- >>> let Just (r_sec, r_pub) = keypair (BS.replicate 32 0x21)+-- >>> let Right (msg1, i_hs) = act1 i_sec i_pub r_pub (BS.replicate 32 0x12)+-- >>> let Right (msg2, _) = act2 r_sec r_pub (BS.replicate 32 0x22) msg1+-- >>> case act3 i_hs msg2 of { Right (msg, _) -> BS.length msg; Left _ -> 0 }+-- 66+act3+ :: HandshakeState -- ^ state after Act 1+ -> BS.ByteString -- ^ Act 2 message (50 bytes)+ -> Either Error (BS.ByteString, Handshake)+act3 hs msg2 = do+ require (BS.length msg2 == 50) InvalidLength+ let !version = BS.index msg2 0+ !re_bytes = BS.take 33 (BS.drop 1 msg2)+ !c = BS.drop 34 msg2+ require (version == 0x00) InvalidVersion+ re <- note InvalidPub (parse_pub re_bytes)+ let !h1 = mix_hash (hs_h hs) re_bytes+ ee <- note InvalidKey (ecdh (hs_e_sec hs) re)+ let !(ck1, temp_k2) = mix_key (hs_ck hs) ee+ _ <- note InvalidMAC (decrypt_with_ad temp_k2 0 h1 c)+ let !h2 = mix_hash h1 c+ !s_pub_bytes = serialize_pub (hs_s_pub hs)+ c3 <- note InvalidMAC (encrypt_with_ad temp_k2 1 h2 s_pub_bytes)+ let !h3 = mix_hash h2 c3+ se <- note InvalidKey (ecdh (hs_s_sec hs) re)+ let !(ck2, temp_k3) = mix_key ck1 se+ t <- note InvalidMAC (encrypt_with_ad temp_k3 0 h3 BS.empty)+ let !(sk, rk) = mix_key ck2 BS.empty+ !msg = BS.singleton 0x00 <> c3 <> t+ !sess = Session {+ sess_sk = sk+ , sess_sn = 0+ , sess_sck = ck2+ , sess_rk = rk+ , sess_rn = 0+ , sess_rck = ck2+ }+ rs <- note InvalidPub (hs_rs hs)+ let !result = Handshake {+ session = sess+ , remote_static = rs+ }+ pure (msg, result)++-- | Responder: process Act 3 (66 bytes) and complete the handshake.+--+-- Returns the handshake result with authenticated remote static pubkey.+--+-- >>> let Just (i_sec, i_pub) = keypair (BS.replicate 32 0x11)+-- >>> let Just (r_sec, r_pub) = keypair (BS.replicate 32 0x21)+-- >>> let Right (msg1, i_hs) = act1 i_sec i_pub r_pub (BS.replicate 32 0x12)+-- >>> let Right (msg2, r_hs) = act2 r_sec r_pub (BS.replicate 32 0x22) msg1+-- >>> let Right (msg3, _) = act3 i_hs msg2+-- >>> case finalize r_hs msg3 of { Right _ -> "ok"; Left e -> show e }+-- "ok"+finalize+ :: HandshakeState -- ^ state after Act 2+ -> BS.ByteString -- ^ Act 3 message (66 bytes)+ -> Either Error Handshake+finalize hs msg3 = do+ require (BS.length msg3 == 66) InvalidLength+ let !version = BS.index msg3 0+ !c = BS.take 49 (BS.drop 1 msg3)+ !t = BS.drop 50 msg3+ require (version == 0x00) InvalidVersion+ rs_bytes <- note InvalidMAC (decrypt_with_ad (hs_temp_k hs) 1 (hs_h hs) c)+ rs <- note InvalidPub (parse_pub rs_bytes)+ let !h1 = mix_hash (hs_h hs) c+ se <- note InvalidKey (ecdh (hs_e_sec hs) rs)+ let !(ck1, temp_k3) = mix_key (hs_ck hs) se+ _ <- note InvalidMAC (decrypt_with_ad temp_k3 0 h1 t)+ -- responder swaps order (receives what initiator sends)+ let !(rk, sk) = mix_key ck1 BS.empty+ !sess = Session {+ sess_sk = sk+ , sess_sn = 0+ , sess_sck = ck1+ , sess_rk = rk+ , sess_rn = 0+ , sess_rck = ck1+ }+ !result = Handshake {+ session = sess+ , remote_static = rs+ }+ pure result++-- message encryption --------------------------------------------------------++-- | Encrypt a message (max 65535 bytes).+--+-- Returns the encrypted packet and updated session. Key rotation+-- is handled automatically at nonce 1000.+--+-- Wire format: encrypted_length (2) || MAC (16) || encrypted_body || MAC (16)+--+-- >>> let Just (i_sec, i_pub) = keypair (BS.replicate 32 0x11)+-- >>> let Just (r_sec, r_pub) = keypair (BS.replicate 32 0x21)+-- >>> let Right (msg1, i_hs) = act1 i_sec i_pub r_pub (BS.replicate 32 0x12)+-- >>> let Right (msg2, _) = act2 r_sec r_pub (BS.replicate 32 0x22) msg1+-- >>> let Right (_, i_result) = act3 i_hs msg2+-- >>> let sess = session i_result+-- >>> case encrypt sess "hello" of { Right (ct, _) -> BS.length ct; Left _ -> 0 }+-- 39+encrypt+ :: Session+ -> BS.ByteString -- ^ plaintext (max 65535 bytes)+ -> Either Error (BS.ByteString, Session)+encrypt sess pt = do+ let !len = BS.length pt+ require (len <= 65535) InvalidLength+ let !len_bytes = encode_be16 (fi len)+ lc <- note InvalidMAC (encrypt_with_ad (sess_sk sess) (sess_sn sess)+ BS.empty len_bytes)+ let !(sn1, sck1, sk1) = step_nonce (sess_sn sess) (sess_sck sess) (sess_sk sess)+ bc <- note InvalidMAC (encrypt_with_ad sk1 sn1 BS.empty pt)+ let !(sn2, sck2, sk2) = step_nonce sn1 sck1 sk1+ !packet = lc <> bc+ !sess' = sess {+ sess_sk = sk2+ , sess_sn = sn2+ , sess_sck = sck2+ }+ pure (packet, sess')++-- | Decrypt a message, requiring an exact packet with no trailing bytes.+--+-- Returns the plaintext and updated session. Key rotation+-- is handled automatically at nonce 1000.+--+-- This is a strict variant that rejects any trailing data. For+-- streaming use cases where you need to handle multiple frames in a+-- buffer, use 'decrypt_frame' instead.+--+-- >>> let Just (i_sec, i_pub) = keypair (BS.replicate 32 0x11)+-- >>> let Just (r_sec, r_pub) = keypair (BS.replicate 32 0x21)+-- >>> let Right (msg1, i_hs) = act1 i_sec i_pub r_pub (BS.replicate 32 0x12)+-- >>> let Right (msg2, r_hs) = act2 r_sec r_pub (BS.replicate 32 0x22) msg1+-- >>> let Right (msg3, i_result) = act3 i_hs msg2+-- >>> let Right r_result = finalize r_hs msg3+-- >>> let Right (ct, _) = encrypt (session i_result) "hello"+-- >>> case decrypt (session r_result) ct of { Right (pt, _) -> pt; Left _ -> "fail" }+-- "hello"+decrypt+ :: Session+ -> BS.ByteString -- ^ encrypted packet (exact length required)+ -> Either Error (BS.ByteString, Session)+decrypt sess packet = do+ (pt, remainder, sess') <- decrypt_frame sess packet+ require (BS.null remainder) InvalidLength+ pure (pt, sess')++-- | Decrypt a single frame from a buffer, returning the remainder.+--+-- Returns the plaintext, any unconsumed bytes, and the updated session.+-- Key rotation is handled automatically every 1000 messages.+--+-- This is useful for streaming scenarios where multiple messages may+-- be buffered together. The remainder can be passed to the next call+-- to 'decrypt_frame'.+--+-- Wire format consumed: encrypted_length (18) || encrypted_body (len + 16)+--+-- >>> let Just (i_sec, i_pub) = keypair (BS.replicate 32 0x11)+-- >>> let Just (r_sec, r_pub) = keypair (BS.replicate 32 0x21)+-- >>> let Right (msg1, i_hs) = act1 i_sec i_pub r_pub (BS.replicate 32 0x12)+-- >>> let Right (msg2, r_hs) = act2 r_sec r_pub (BS.replicate 32 0x22) msg1+-- >>> let Right (msg3, i_result) = act3 i_hs msg2+-- >>> let Right r_result = finalize r_hs msg3+-- >>> let Right (ct, _) = encrypt (session i_result) "hello"+-- >>> case decrypt_frame (session r_result) ct of { Right (pt, rem, _) -> (pt, BS.null rem); Left _ -> ("fail", False) }+-- ("hello",True)+decrypt_frame+ :: Session+ -> BS.ByteString -- ^ buffer containing at least one encrypted frame+ -> Either Error (BS.ByteString, BS.ByteString, Session)+decrypt_frame sess packet = do+ require (BS.length packet >= 34) InvalidLength+ let !lc = BS.take 18 packet+ !rest = BS.drop 18 packet+ len_bytes <- note InvalidMAC (decrypt_with_ad (sess_rk sess) (sess_rn sess)+ BS.empty lc)+ len <- note InvalidLength (decode_be16 len_bytes)+ let !(rn1, rck1, rk1) = step_nonce (sess_rn sess) (sess_rck sess) (sess_rk sess)+ !body_len = fi len + 16+ require (BS.length rest >= body_len) InvalidLength+ let !bc = BS.take body_len rest+ !remainder = BS.drop body_len rest+ pt <- note InvalidMAC (decrypt_with_ad rk1 rn1 BS.empty bc)+ let !(rn2, rck2, rk2) = step_nonce rn1 rck1 rk1+ !sess' = sess {+ sess_rk = rk2+ , sess_rn = rn2+ , sess_rck = rck2+ }+ pure (pt, remainder, sess')++-- | Decrypt a frame from a partial buffer, indicating when more data needed.+--+-- Unlike 'decrypt_frame', this function handles incomplete buffers+-- gracefully by returning 'NeedMore' with the number of additional+-- bytes required to make progress.+--+-- * If the buffer has fewer than 18 bytes (encrypted length + MAC),+-- returns @'NeedMore' n@ where @n@ is the bytes still needed.+-- * If the length header is complete but the body is incomplete,+-- returns @'NeedMore' n@ with bytes needed for the full frame.+-- * MAC or decryption failures return 'FrameError'.+-- * A complete, valid frame returns 'FrameOk' with plaintext,+-- remainder, and updated session.+--+-- This is useful for non-blocking I/O where data arrives incrementally.+decrypt_frame_partial+ :: Session+ -> BS.ByteString -- ^ buffer (possibly incomplete)+ -> FrameResult+decrypt_frame_partial sess buf+ | buflen < 18 = NeedMore (18 - buflen)+ | otherwise =+ let !lc = BS.take 18 buf+ !rest = BS.drop 18 buf+ in case decrypt_with_ad (sess_rk sess) (sess_rn sess) BS.empty lc of+ Nothing -> FrameError InvalidMAC+ Just len_bytes -> case decode_be16 len_bytes of+ Nothing -> FrameError InvalidLength+ Just len ->+ let !body_len = fi len + 16+ !(rn1, rck1, rk1) = step_nonce (sess_rn sess)+ (sess_rck sess) (sess_rk sess)+ in if BS.length rest < body_len+ then NeedMore (body_len - BS.length rest)+ else+ let !bc = BS.take body_len rest+ !remainder = BS.drop body_len rest+ in case decrypt_with_ad rk1 rn1 BS.empty bc of+ Nothing -> FrameError InvalidMAC+ Just pt ->+ let !(rn2, rck2, rk2) = step_nonce rn1 rck1 rk1+ !sess' = sess {+ sess_rk = rk2+ , sess_rn = rn2+ , sess_rck = rck2+ }+ in FrameOk pt remainder sess'+ where+ !buflen = BS.length buf++-- key rotation --------------------------------------------------------------++-- Key rotation occurs after nonce reaches 1000 (i.e., before using 1000)+-- (ck', k') = HKDF(ck, k), reset nonce to 0+step_nonce+ :: Word64+ -> BS.ByteString+ -> BS.ByteString+ -> (Word64, BS.ByteString, BS.ByteString)+step_nonce n ck k+ | n + 1 == 1000 =+ let !(ck', k') = mix_key ck k+ in (0, ck', k')+ | otherwise = (n + 1, ck, k)++-- utilities -----------------------------------------------------------------++-- Lift Maybe to Either+note :: e -> Maybe a -> Either e a+note e = maybe (Left e) Right+{-# INLINE note #-}++-- Require condition or fail+require :: Bool -> e -> Either e ()+require cond e = unless cond (Left e)+{-# INLINE require #-}++fi :: (Integral a, Num b) => a -> b+fi = fromIntegral+{-# INLINE fi #-}
+ ppad-bolt8.cabal view
@@ -0,0 +1,86 @@+cabal-version: 3.0+name: ppad-bolt8+version: 0.0.1+synopsis: Encrypted and authenticated transport per BOLT #8+license: MIT+license-file: LICENSE+author: Jared Tobin+maintainer: jared@ppad.tech+category: Cryptography+build-type: Simple+tested-with: GHC == 9.10.3+extra-doc-files: CHANGELOG+description:+ Encrypted and authenticated transport, per+ [BOLT #8](https://github.com/lightning/bolts/blob/master/08-transport.md).++source-repository head+ type: git+ location: git.ppad.tech/bolt8.git++library+ default-language: Haskell2010+ hs-source-dirs: lib+ ghc-options:+ -Wall+ exposed-modules:+ Lightning.Protocol.BOLT8+ build-depends:+ base >= 4.9 && < 5+ , bytestring >= 0.9 && < 0.13+ , ppad-aead >= 0.3 && < 0.4+ , ppad-hkdf >= 0.3.2 && < 0.4+ , ppad-secp256k1 >= 0.5.3 && < 0.6+ , ppad-sha256 >= 0.3 && < 0.4++test-suite bolt8-tests+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: test+ main-is: Main.hs++ ghc-options:+ -rtsopts -Wall -O2++ build-depends:+ base+ , bytestring+ , ppad-base16+ , ppad-bolt8+ , QuickCheck+ , tasty+ , tasty-hunit+ , tasty-quickcheck++benchmark bolt8-bench+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: bench+ main-is: Main.hs++ ghc-options:+ -rtsopts -O2 -Wall -fno-warn-orphans++ build-depends:+ base+ , bytestring+ , criterion+ , 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+
+ test/Main.hs view
@@ -0,0 +1,657 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Data.Bits (xor)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base16 as B16+import qualified Lightning.Protocol.BOLT8 as BOLT8+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck (Gen, Property, choose, forAll, testProperty,+ vectorOf)++-- test helpers ----------------------------------------------------------------++-- | Extract a Just value or fail the test.+expectJust :: String -> Maybe a -> IO a+expectJust msg = \case+ Nothing -> assertFailure msg >> error "unreachable"+ Just a -> pure a++-- | Extract a Right value or fail the test.+expectRight :: Show e => String -> Either e a -> IO a+expectRight msg = \case+ Left e -> assertFailure (msg ++ ": " ++ show e) >> error "unreachable"+ Right a -> pure a++main :: IO ()+main = defaultMain $ testGroup "ppad-bolt8" [+ handshake_tests+ , message_tests+ , framing_tests+ , partial_framing_tests+ , negative_tests+ , property_tests+ ]++-- test vectors from BOLT #8 specification -----------------------------------++-- initiator static private key+initiator_s_priv :: BS.ByteString+initiator_s_priv = hex+ "1111111111111111111111111111111111111111111111111111111111111111"++-- initiator ephemeral private key+initiator_e_priv :: BS.ByteString+initiator_e_priv = hex+ "1212121212121212121212121212121212121212121212121212121212121212"++-- responder static private key+responder_s_priv :: BS.ByteString+responder_s_priv = hex+ "2121212121212121212121212121212121212121212121212121212121212121"++-- responder static public key (known to initiator)+responder_s_pub :: BS.ByteString+responder_s_pub = hex+ "028d7500dd4c12685d1f568b4c2b5048e8534b873319f3a8daa612b469132ec7f7"++-- responder ephemeral private key+responder_e_priv :: BS.ByteString+responder_e_priv = hex+ "2222222222222222222222222222222222222222222222222222222222222222"++-- expected act 1 message+expected_act1 :: BS.ByteString+expected_act1 = hex+ "00036360e856310ce5d294e8be33fc807077dc56ac80d95d9cd4ddbd21325eff73f7\+ \0df6086551151f58b8afe6c195782c6a"++-- expected act 2 message+expected_act2 :: BS.ByteString+expected_act2 = hex+ "0002466d7fcae563e5cb09a0d1870bb580344804617879a14949cf22285f1bae3f27\+ \6e2470b93aac583c9ef6eafca3f730ae"++-- expected act 3 message+expected_act3 :: BS.ByteString+expected_act3 = hex+ "00b9e3a702e93e3a9948c2ed6e5fd7590a6e1c3a0344cfc9d5b57357049aa22355\+ \361aa02e55a8fc28fef5bd6d71ad0c38228dc68b1c466263b47fdf31e560e139ba"++-- handshake tests -----------------------------------------------------------++handshake_tests :: TestTree+handshake_tests = testGroup "Handshake" [+ testCase "act1 matches spec vector" test_act1+ , testCase "act2 matches spec vector" test_act2+ , testCase "act3 matches spec vector" test_act3+ , testCase "full handshake round-trip" test_full_handshake+ ]++test_act1 :: Assertion+test_act1 = do+ (i_s_sec, i_s_pub) <- expectJust "initiator keypair"+ (BOLT8.keypair initiator_s_priv)+ rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)+ (act1_msg, _) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs+ initiator_e_priv)+ act1_msg @?= expected_act1++test_act2 :: Assertion+test_act2 = do+ (i_s_sec, i_s_pub) <- expectJust "initiator keypair"+ (BOLT8.keypair initiator_s_priv)+ (r_s_sec, r_s_pub) <- expectJust "responder keypair"+ (BOLT8.keypair responder_s_priv)+ rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)+ (msg1, _) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs+ initiator_e_priv)+ (msg2, _) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv+ msg1)+ msg2 @?= expected_act2++test_act3 :: Assertion+test_act3 = do+ (i_s_sec, i_s_pub) <- expectJust "initiator keypair"+ (BOLT8.keypair initiator_s_priv)+ (r_s_sec, r_s_pub) <- expectJust "responder keypair"+ (BOLT8.keypair responder_s_priv)+ rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)+ (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs+ initiator_e_priv)+ (msg2, _) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv+ msg1)+ (msg3, _) <- expectRight "act3" (BOLT8.act3 i_hs msg2)+ msg3 @?= expected_act3++test_full_handshake :: Assertion+test_full_handshake = do+ (i_s_sec, i_s_pub) <- expectJust "initiator keypair"+ (BOLT8.keypair initiator_s_priv)+ (r_s_sec, r_s_pub) <- expectJust "responder keypair"+ (BOLT8.keypair responder_s_priv)+ rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)+ (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs+ initiator_e_priv)+ (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv+ msg1)+ (msg3, i_result) <- expectRight "act3" (BOLT8.act3 i_hs msg2)+ r_result <- expectRight "finalize" (BOLT8.finalize r_hs msg3)+ BOLT8.remote_static i_result @?= r_s_pub+ BOLT8.remote_static r_result @?= i_s_pub++-- message encryption tests --------------------------------------------------++message_tests :: TestTree+message_tests = testGroup "Message Encryption" [+ testCase "message 0 matches spec" test_message_0+ , testCase "message 1 matches spec" test_message_1+ , testCase "message 500 matches spec" test_message_500+ , testCase "message 501 matches spec" test_message_501+ , testCase "message 1000 matches spec" test_message_1000+ , testCase "message 1001 matches spec" test_message_1001+ , testCase "decrypt round-trip" test_decrypt_roundtrip+ ]++-- "hello" = 0x68656c6c6f+hello :: BS.ByteString+hello = "hello"++-- expected encrypted messages+expected_msg_0 :: BS.ByteString+expected_msg_0 = hex+ "cf2b30ddf0cf3f80e7c35a6e6730b59fe802473180f396d88a8fb0db8cbcf25d\+ \2f214cf9ea1d95"++expected_msg_1 :: BS.ByteString+expected_msg_1 = hex+ "72887022101f0b6753e0c7de21657d35a4cb2a1f5cde2650528bbc8f837d0f0d\+ \7ad833b1a256a1"++expected_msg_500 :: BS.ByteString+expected_msg_500 = hex+ "178cb9d7387190fa34db9c2d50027d21793c9bc2d40b1e14dcf30ebeeeb220f4\+ \8364f7a4c68bf8"++expected_msg_501 :: BS.ByteString+expected_msg_501 = hex+ "1b186c57d44eb6de4c057c49940d79bb838a145cb528d6e8fd26dbe50a60ca2c\+ \104b56b60e45bd"++expected_msg_1000 :: BS.ByteString+expected_msg_1000 = hex+ "4a2f3cc3b5e78ddb83dcb426d9863d9d9a723b0337c89dd0b005d89f8d3c05c5\+ \2b76b29b740f09"++expected_msg_1001 :: BS.ByteString+expected_msg_1001 = hex+ "2ecd8c8a5629d0d02ab457a0fdd0f7b90a192cd46be5ecb6ca570bfc5e268338\+ \b1a16cf4ef2d36"++-- helper to get initiator session after handshake+get_initiator_session :: IO BOLT8.Session+get_initiator_session = do+ (i_s_sec, i_s_pub) <- expectJust "initiator keypair"+ (BOLT8.keypair initiator_s_priv)+ (r_s_sec, r_s_pub) <- expectJust "responder keypair"+ (BOLT8.keypair responder_s_priv)+ rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)+ (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs+ initiator_e_priv)+ (msg2, _) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv+ msg1)+ (_, result) <- expectRight "act3" (BOLT8.act3 i_hs msg2)+ pure (BOLT8.session result)++-- encrypt N messages, return Nth ciphertext+encrypt_n :: Int -> BOLT8.Session -> IO BS.ByteString+encrypt_n n sess0 = go 0 sess0+ where+ go i sess+ | i == n = case BOLT8.encrypt sess hello of+ Left err -> fail $ "encrypt failed at " ++ show i ++ ": " ++ show err+ Right (ct, _) -> pure ct+ | otherwise = case BOLT8.encrypt sess hello of+ Left err -> fail $ "encrypt failed at " ++ show i ++ ": " ++ show err+ Right (_, sess') -> go (i + 1) sess'++test_message_0 :: Assertion+test_message_0 = do+ sess <- get_initiator_session+ ct <- encrypt_n 0 sess+ ct @?= expected_msg_0++test_message_1 :: Assertion+test_message_1 = do+ sess <- get_initiator_session+ ct <- encrypt_n 1 sess+ ct @?= expected_msg_1++test_message_500 :: Assertion+test_message_500 = do+ sess <- get_initiator_session+ ct <- encrypt_n 500 sess+ ct @?= expected_msg_500++test_message_501 :: Assertion+test_message_501 = do+ sess <- get_initiator_session+ ct <- encrypt_n 501 sess+ ct @?= expected_msg_501++test_message_1000 :: Assertion+test_message_1000 = do+ sess <- get_initiator_session+ ct <- encrypt_n 1000 sess+ ct @?= expected_msg_1000++test_message_1001 :: Assertion+test_message_1001 = do+ sess <- get_initiator_session+ ct <- encrypt_n 1001 sess+ ct @?= expected_msg_1001++test_decrypt_roundtrip :: Assertion+test_decrypt_roundtrip = do+ (i_s_sec, i_s_pub) <- expectJust "initiator keypair"+ (BOLT8.keypair initiator_s_priv)+ (r_s_sec, r_s_pub) <- expectJust "responder keypair"+ (BOLT8.keypair responder_s_priv)+ rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)+ (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs+ initiator_e_priv)+ (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv+ msg1)+ (msg3, i_result) <- expectRight "act3" (BOLT8.act3 i_hs msg2)+ r_result <- expectRight "finalize" (BOLT8.finalize r_hs msg3)+ let i_sess = BOLT8.session i_result+ r_sess = BOLT8.session r_result+ (ct, _) <- expectRight "encrypt" (BOLT8.encrypt i_sess hello)+ (pt, _) <- expectRight "decrypt" (BOLT8.decrypt r_sess ct)+ pt @?= hello++-- framing tests -------------------------------------------------------------++framing_tests :: TestTree+framing_tests = testGroup "Packet Framing" [+ testCase "decrypt rejects trailing bytes" test_decrypt_trailing+ , testCase "decrypt_frame returns remainder" test_decrypt_frame_remainder+ , testCase "decrypt_frame handles multiple frames" test_decrypt_frame_multi+ ]++test_decrypt_trailing :: Assertion+test_decrypt_trailing = do+ (i_s_sec, i_s_pub) <- expectJust "initiator keypair"+ (BOLT8.keypair initiator_s_priv)+ (r_s_sec, r_s_pub) <- expectJust "responder keypair"+ (BOLT8.keypair responder_s_priv)+ rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)+ (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs+ initiator_e_priv)+ (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv+ msg1)+ (msg3, i_result) <- expectRight "act3" (BOLT8.act3 i_hs msg2)+ r_result <- expectRight "finalize" (BOLT8.finalize r_hs msg3)+ let i_sess = BOLT8.session i_result+ r_sess = BOLT8.session r_result+ (ct, _) <- expectRight "encrypt" (BOLT8.encrypt i_sess hello)+ -- append trailing bytes+ let ct_with_trailing = ct <> "extra"+ case BOLT8.decrypt r_sess ct_with_trailing of+ Left BOLT8.InvalidLength -> pure ()+ Left err -> assertFailure $ "expected InvalidLength, got: " ++ show err+ Right _ -> assertFailure "decrypt should reject trailing bytes"++test_decrypt_frame_remainder :: Assertion+test_decrypt_frame_remainder = do+ (i_s_sec, i_s_pub) <- expectJust "initiator keypair"+ (BOLT8.keypair initiator_s_priv)+ (r_s_sec, r_s_pub) <- expectJust "responder keypair"+ (BOLT8.keypair responder_s_priv)+ rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)+ (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs+ initiator_e_priv)+ (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv+ msg1)+ (msg3, i_result) <- expectRight "act3" (BOLT8.act3 i_hs msg2)+ r_result <- expectRight "finalize" (BOLT8.finalize r_hs msg3)+ let i_sess = BOLT8.session i_result+ r_sess = BOLT8.session r_result+ (ct, _) <- expectRight "encrypt" (BOLT8.encrypt i_sess hello)+ let trailing = "remainder"+ ct_with_trailing = ct <> trailing+ (pt, remainder, _) <- expectRight "decrypt_frame"+ (BOLT8.decrypt_frame r_sess ct_with_trailing)+ pt @?= hello+ remainder @?= trailing++test_decrypt_frame_multi :: Assertion+test_decrypt_frame_multi = do+ (i_s_sec, i_s_pub) <- expectJust "initiator keypair"+ (BOLT8.keypair initiator_s_priv)+ (r_s_sec, r_s_pub) <- expectJust "responder keypair"+ (BOLT8.keypair responder_s_priv)+ rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)+ (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs+ initiator_e_priv)+ (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv+ msg1)+ (msg3, i_result) <- expectRight "act3" (BOLT8.act3 i_hs msg2)+ r_result <- expectRight "finalize" (BOLT8.finalize r_hs msg3)+ let i_sess = BOLT8.session i_result+ r_sess = BOLT8.session r_result+ -- encrypt two messages+ (ct1, i_sess') <- expectRight "encrypt 1" (BOLT8.encrypt i_sess "first")+ (ct2, _) <- expectRight "encrypt 2" (BOLT8.encrypt i_sess' "second")+ -- concatenate frames+ let buffer = ct1 <> ct2+ -- decrypt first frame+ (pt1, rest, r_sess') <- expectRight "frame 1"+ (BOLT8.decrypt_frame r_sess buffer)+ pt1 @?= "first"+ -- decrypt second frame from remainder+ (pt2, rest2, _) <- expectRight "frame 2" (BOLT8.decrypt_frame r_sess' rest)+ pt2 @?= "second"+ rest2 @?= BS.empty++-- partial framing tests -----------------------------------------------------++partial_framing_tests :: TestTree+partial_framing_tests = testGroup "Partial Framing" [+ testCase "short buffer returns NeedMore" test_partial_short_buffer+ , testCase "partial body returns NeedMore" test_partial_body+ , testCase "full frame returns FrameOk" test_partial_full_frame+ ]++test_partial_short_buffer :: Assertion+test_partial_short_buffer = do+ (i_s_sec, i_s_pub) <- expectJust "initiator keypair"+ (BOLT8.keypair initiator_s_priv)+ (r_s_sec, r_s_pub) <- expectJust "responder keypair"+ (BOLT8.keypair responder_s_priv)+ rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)+ (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs+ initiator_e_priv)+ (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv+ msg1)+ (msg3, _) <- expectRight "act3" (BOLT8.act3 i_hs msg2)+ r_result <- expectRight "finalize" (BOLT8.finalize r_hs msg3)+ let r_sess = BOLT8.session r_result+ short_buf = BS.replicate 10 0x00+ case BOLT8.decrypt_frame_partial r_sess short_buf of+ BOLT8.NeedMore n -> n @?= 8+ BOLT8.FrameOk {} -> assertFailure "expected NeedMore, got FrameOk"+ BOLT8.FrameError err ->+ assertFailure $ "expected NeedMore, got: " ++ show err++test_partial_body :: Assertion+test_partial_body = do+ (i_s_sec, i_s_pub) <- expectJust "initiator keypair"+ (BOLT8.keypair initiator_s_priv)+ (r_s_sec, r_s_pub) <- expectJust "responder keypair"+ (BOLT8.keypair responder_s_priv)+ rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)+ (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs+ initiator_e_priv)+ (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv+ msg1)+ (msg3, i_result) <- expectRight "act3" (BOLT8.act3 i_hs msg2)+ r_result <- expectRight "finalize" (BOLT8.finalize r_hs msg3)+ let i_sess = BOLT8.session i_result+ r_sess = BOLT8.session r_result+ (ct, _) <- expectRight "encrypt" (BOLT8.encrypt i_sess hello)+ -- take only length header (18 bytes) + 5 bytes of body+ let partial = BS.take 23 ct+ case BOLT8.decrypt_frame_partial r_sess partial of+ BOLT8.NeedMore n -> do+ -- "hello" = 5 bytes, so body = 5 + 16 = 21+ -- we have 5 bytes of body, need 16 more+ n @?= 16+ BOLT8.FrameOk {} -> assertFailure "expected NeedMore, got FrameOk"+ BOLT8.FrameError err ->+ assertFailure $ "expected NeedMore, got: " ++ show err++test_partial_full_frame :: Assertion+test_partial_full_frame = do+ (i_s_sec, i_s_pub) <- expectJust "initiator keypair"+ (BOLT8.keypair initiator_s_priv)+ (r_s_sec, r_s_pub) <- expectJust "responder keypair"+ (BOLT8.keypair responder_s_priv)+ rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)+ (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs+ initiator_e_priv)+ (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv+ msg1)+ (msg3, i_result) <- expectRight "act3" (BOLT8.act3 i_hs msg2)+ r_result <- expectRight "finalize" (BOLT8.finalize r_hs msg3)+ let i_sess = BOLT8.session i_result+ r_sess = BOLT8.session r_result+ (ct, _) <- expectRight "encrypt" (BOLT8.encrypt i_sess hello)+ let trailing = "extra"+ buf = ct <> trailing+ case BOLT8.decrypt_frame_partial r_sess buf of+ BOLT8.FrameOk pt remainder _ -> do+ pt @?= hello+ remainder @?= trailing+ BOLT8.NeedMore n ->+ assertFailure $ "expected FrameOk, got NeedMore " ++ show n+ BOLT8.FrameError err ->+ assertFailure $ "expected FrameOk, got: " ++ show err++-- negative tests ------------------------------------------------------------++negative_tests :: TestTree+negative_tests = testGroup "Negative Tests" [+ testCase "act2 rejects wrong version" test_act2_wrong_version+ , testCase "act2 rejects wrong length" test_act2_wrong_length+ , testCase "act3 rejects invalid MAC" test_act3_invalid_mac+ , testCase "finalize rejects invalid MAC" test_finalize_invalid_mac+ , testCase "decrypt rejects short packet" test_decrypt_short_packet+ ]++test_act2_wrong_version :: Assertion+test_act2_wrong_version = do+ (i_s_sec, i_s_pub) <- expectJust "initiator keypair"+ (BOLT8.keypair initiator_s_priv)+ (r_s_sec, r_s_pub) <- expectJust "responder keypair"+ (BOLT8.keypair responder_s_priv)+ rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)+ (msg1, _) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs initiator_e_priv)+ let bad_msg1 = BS.cons 0x01 (BS.drop 1 msg1)+ case BOLT8.act2 r_s_sec r_s_pub responder_e_priv bad_msg1 of+ Left BOLT8.InvalidVersion -> pure ()+ Left err -> assertFailure $ "expected InvalidVersion, got: " ++ show err+ Right _ -> assertFailure "expected rejection, got success"++test_act2_wrong_length :: Assertion+test_act2_wrong_length = do+ (r_s_sec, r_s_pub) <- expectJust "responder keypair"+ (BOLT8.keypair responder_s_priv)+ let short_msg = BS.replicate 49 0x00+ case BOLT8.act2 r_s_sec r_s_pub responder_e_priv short_msg of+ Left BOLT8.InvalidLength -> pure ()+ Left err -> assertFailure $ "expected InvalidLength, got: " ++ show err+ Right _ -> assertFailure "expected rejection, got success"++test_act3_invalid_mac :: Assertion+test_act3_invalid_mac = do+ (i_s_sec, i_s_pub) <- expectJust "initiator keypair"+ (BOLT8.keypair initiator_s_priv)+ (r_s_sec, r_s_pub) <- expectJust "responder keypair"+ (BOLT8.keypair responder_s_priv)+ rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)+ (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs+ initiator_e_priv)+ (msg2, _) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv+ msg1)+ bad_msg2 <- flip_byte 40 msg2+ case BOLT8.act3 i_hs bad_msg2 of+ Left BOLT8.InvalidMAC -> pure ()+ Left err -> assertFailure $ "expected InvalidMAC, got: " ++ show err+ Right _ -> assertFailure "expected rejection, got success"++test_finalize_invalid_mac :: Assertion+test_finalize_invalid_mac = do+ (i_s_sec, i_s_pub) <- expectJust "initiator keypair"+ (BOLT8.keypair initiator_s_priv)+ (r_s_sec, r_s_pub) <- expectJust "responder keypair"+ (BOLT8.keypair responder_s_priv)+ rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)+ (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs+ initiator_e_priv)+ (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv+ msg1)+ (msg3, _) <- expectRight "act3" (BOLT8.act3 i_hs msg2)+ bad_msg3 <- flip_byte 20 msg3+ case BOLT8.finalize r_hs bad_msg3 of+ Left BOLT8.InvalidMAC -> pure ()+ Left err -> assertFailure $ "expected InvalidMAC, got: " ++ show err+ Right _ -> assertFailure "expected rejection, got success"++test_decrypt_short_packet :: Assertion+test_decrypt_short_packet = do+ (i_s_sec, i_s_pub) <- expectJust "initiator keypair"+ (BOLT8.keypair initiator_s_priv)+ (r_s_sec, r_s_pub) <- expectJust "responder keypair"+ (BOLT8.keypair responder_s_priv)+ rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)+ (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs+ initiator_e_priv)+ (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv+ msg1)+ (msg3, _) <- expectRight "act3" (BOLT8.act3 i_hs msg2)+ r_result <- expectRight "finalize" (BOLT8.finalize r_hs msg3)+ let r_sess = BOLT8.session r_result+ short_packet = BS.replicate 17 0x00+ case BOLT8.decrypt r_sess short_packet of+ Left BOLT8.InvalidLength -> pure ()+ Left err -> assertFailure $ "expected InvalidLength, got: " ++ show err+ Right _ -> assertFailure "expected rejection, got success"++-- flip one byte in a bytestring at given index+flip_byte :: Int -> BS.ByteString -> IO BS.ByteString+flip_byte i bs+ | i < 0 || i >= BS.length bs =+ assertFailure "flip_byte: index out of bounds" >> pure bs+ | otherwise =+ let (pre, post) = BS.splitAt i bs+ b = BS.index post 0+ in pure (pre <> BS.cons (b `xor` 0xff) (BS.drop 1 post))++-- utilities -----------------------------------------------------------------++-- Safe hex decode for test vectors (only called at top level with known-good+-- literals). This uses error since it's for compile-time constants, not runtime+-- input; wrapping in IO would break the test vector declarations.+hex :: BS.ByteString -> BS.ByteString+hex bs = case B16.decode bs of+ Nothing -> error "hex: invalid test vector literal"+ Just r -> r++-- property tests --------------------------------------------------------------++property_tests :: TestTree+property_tests = testGroup "Properties" [+ testProperty "handshake round-trip" prop_handshake_roundtrip+ , testProperty "encrypt/decrypt round-trip" prop_encrypt_decrypt_roundtrip+ , testProperty "decrypt_frame consumes one frame" prop_frame_consumes_one+ , testProperty "decrypt_frame_partial NeedMore on short"+ prop_partial_needmore_short+ ]++-- generators ------------------------------------------------------------------++-- | Generate 32 bytes of entropy that yields a valid keypair.+genValidEntropy :: Gen BS.ByteString+genValidEntropy = do+ bytes <- BS.pack <$> vectorOf 32 (choose (0, 255))+ case BOLT8.keypair bytes of+ Just _ -> pure bytes+ Nothing -> genValidEntropy++-- | Generate a payload of 0..256 bytes.+genPayload :: Gen BS.ByteString+genPayload = do+ len <- choose (0, 256)+ BS.pack <$> vectorOf len (choose (0, 255))++-- | Perform a full handshake with given static key entropy.+-- Uses fixed ephemeral keys for determinism.+doHandshake+ :: BS.ByteString+ -> BS.ByteString+ -> Maybe (BOLT8.Session, BOLT8.Session)+doHandshake i_entropy r_entropy = do+ (i_s_sec, i_s_pub) <- BOLT8.keypair i_entropy+ (r_s_sec, r_s_pub) <- BOLT8.keypair r_entropy+ let i_e = BS.replicate 32 0x12+ r_e = BS.replicate 32 0x22+ (msg1, i_hs) <- either (const Nothing) Just $+ BOLT8.act1 i_s_sec i_s_pub r_s_pub i_e+ (msg2, r_hs) <- either (const Nothing) Just $+ BOLT8.act2 r_s_sec r_s_pub r_e msg1+ (msg3, i_res) <- either (const Nothing) Just $+ BOLT8.act3 i_hs msg2+ r_res <- either (const Nothing) Just $+ BOLT8.finalize r_hs msg3+ pure (BOLT8.session i_res, BOLT8.session r_res)++-- properties ------------------------------------------------------------------++-- | Handshake succeeds for valid keys and sessions are consistent.+prop_handshake_roundtrip :: Property+prop_handshake_roundtrip = forAll genValidEntropy $ \i_ent ->+ forAll genValidEntropy $ \r_ent ->+ case doHandshake i_ent r_ent of+ Nothing -> False+ Just _ -> True++-- | Encrypt then decrypt yields original payload.+prop_encrypt_decrypt_roundtrip :: Property+prop_encrypt_decrypt_roundtrip = forAll genPayload $ \payload ->+ case doHandshake initiator_s_priv responder_s_priv of+ Nothing -> False+ Just (i_sess, r_sess) ->+ case BOLT8.encrypt i_sess payload of+ Left _ -> False+ Right (ct, _) ->+ case BOLT8.decrypt r_sess ct of+ Left _ -> False+ Right (pt, _) -> pt == payload++-- | decrypt_frame consumes exactly one frame and returns remainder.+prop_frame_consumes_one :: Property+prop_frame_consumes_one = forAll genPayload $ \p1 ->+ forAll genPayload $ \p2 ->+ case doHandshake initiator_s_priv responder_s_priv of+ Nothing -> False+ Just (i_sess, r_sess) ->+ case BOLT8.encrypt i_sess p1 of+ Left _ -> False+ Right (ct1, i_sess') ->+ case BOLT8.encrypt i_sess' p2 of+ Left _ -> False+ Right (ct2, _) ->+ let buf = ct1 <> ct2+ in case BOLT8.decrypt_frame r_sess buf of+ Left _ -> False+ Right (pt1, rest, r_sess') ->+ pt1 == p1 &&+ case BOLT8.decrypt_frame r_sess' rest of+ Left _ -> False+ Right (pt2, rest2, _) ->+ pt2 == p2 && BS.null rest2++-- | decrypt_frame_partial returns NeedMore when buffer < 18 bytes.+prop_partial_needmore_short :: Property+prop_partial_needmore_short = forAll (choose (0, 17)) $ \len ->+ case doHandshake initiator_s_priv responder_s_priv of+ Nothing -> False+ Just (_, r_sess) ->+ let buf = BS.replicate len 0x00+ in case BOLT8.decrypt_frame_partial r_sess buf of+ BOLT8.NeedMore n -> n == 18 - len+ _ -> False