commit 819ad99a6b8bb3d94c1af4f6df6dfeca12a23495
parent 6f3327fe2856fded5511e8f8db21a44361d4c8c5
Author: Jared Tobin <jared@jtobin.io>
Date: Sun, 25 Jan 2026 15:34:29 +0400
ppad-bolt4: implement packet processing (IMPL4)
Add Process module with onion packet processing from the receiver's
perspective. Includes:
- RejectReason type for validation failures
- process function that validates, decrypts, and extracts hop payloads
- Version and ephemeral key validation
- HMAC verification (constant-time)
- Payload decryption and extraction
- Final hop detection (all-zero next HMAC)
- Forward packet preparation with ephemeral key blinding
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
Diffstat:
3 files changed, 370 insertions(+), 0 deletions(-)
diff --git a/lib/Lightning/Protocol/BOLT4/Process.hs b/lib/Lightning/Protocol/BOLT4/Process.hs
@@ -0,0 +1,220 @@
+{-# OPTIONS_HADDOCK prune #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- Module: Lightning.Protocol.BOLT4.Process
+-- Copyright: (c) 2025 Jared Tobin
+-- License: MIT
+-- Maintainer: Jared Tobin <jared@ppad.tech>
+--
+-- Onion packet processing for BOLT4.
+
+module Lightning.Protocol.BOLT4.Process (
+ -- * Processing
+ process
+
+ -- * Rejection reasons
+ , RejectReason(..)
+ ) where
+
+import Data.Bits (xor)
+import qualified Crypto.Curve.Secp256k1 as Secp256k1
+import qualified Data.ByteString as BS
+import Data.Word (Word8)
+import GHC.Generics (Generic)
+import Lightning.Protocol.BOLT4.Codec
+import Lightning.Protocol.BOLT4.Prim
+import Lightning.Protocol.BOLT4.Types
+
+-- | Reasons for rejecting a packet.
+data RejectReason
+ = InvalidVersion !Word8 -- ^ Version byte is not 0x00
+ | InvalidEphemeralKey -- ^ Malformed public key
+ | HmacMismatch -- ^ HMAC verification failed
+ | InvalidPayload !String -- ^ Malformed hop payload
+ deriving (Eq, Show, Generic)
+
+-- | Process an incoming onion packet.
+--
+-- Takes the receiving node's private key, the incoming packet, and
+-- associated data (typically the payment hash).
+--
+-- Returns either a rejection reason or the processing result
+-- (forward to next hop or receive at final destination).
+process
+ :: BS.ByteString -- ^ 32-byte secret key of this node
+ -> OnionPacket -- ^ incoming onion packet
+ -> BS.ByteString -- ^ associated data (payment hash)
+ -> Either RejectReason ProcessResult
+process !secKey !packet !assocData = do
+ -- Step 1: Validate version
+ validateVersion packet
+
+ -- Step 2: Parse ephemeral public key
+ ephemeral <- parseEphemeralKey packet
+
+ -- Step 3: Compute shared secret
+ ss <- case computeSharedSecret secKey ephemeral of
+ Nothing -> Left InvalidEphemeralKey
+ Just s -> Right s
+
+ -- Step 4: Derive keys
+ let !muKey = deriveMu ss
+ !rhoKey = deriveRho ss
+
+ -- Step 5: Verify HMAC
+ if not (verifyPacketHmac muKey packet assocData)
+ then Left HmacMismatch
+ else pure ()
+
+ -- Step 6: Decrypt hop payloads
+ let !decrypted = decryptPayloads rhoKey (opHopPayloads packet)
+
+ -- Step 7: Extract payload
+ (payloadBytes, nextHmac, remaining) <- extractPayload decrypted
+
+ -- Step 8: Parse payload TLV
+ hopPayload <- case decodeHopPayload payloadBytes of
+ Nothing -> Left (InvalidPayload "failed to decode TLV")
+ Just hp -> Right hp
+
+ -- Step 9: Check if final hop
+ let SharedSecret ssBytes = ss
+ if isFinalHop nextHmac
+ then Right $! Receive $! ReceiveInfo
+ { riPayload = hopPayload
+ , riSharedSecret = ssBytes
+ }
+ else do
+ -- Step 10: Prepare forward packet
+ nextPacket <- case prepareForward ephemeral ss remaining nextHmac of
+ Nothing -> Left InvalidEphemeralKey
+ Just np -> Right np
+
+ Right $! Forward $! ForwardInfo
+ { fiNextPacket = nextPacket
+ , fiPayload = hopPayload
+ , fiSharedSecret = ssBytes
+ }
+
+-- | Validate packet version is 0x00.
+validateVersion :: OnionPacket -> Either RejectReason ()
+validateVersion !packet
+ | opVersion packet == versionByte = Right ()
+ | otherwise = Left (InvalidVersion (opVersion packet))
+{-# INLINE validateVersion #-}
+
+-- | Parse and validate ephemeral public key from packet.
+parseEphemeralKey :: OnionPacket -> Either RejectReason Secp256k1.Projective
+parseEphemeralKey !packet =
+ case Secp256k1.parse_point (opEphemeralKey packet) of
+ Nothing -> Left InvalidEphemeralKey
+ Just pub -> Right pub
+{-# INLINE parseEphemeralKey #-}
+
+-- | Decrypt hop payloads by XORing with rho stream.
+--
+-- Generates a stream of 2*1300 bytes and XORs with hop_payloads
+-- extended with 1300 zero bytes.
+decryptPayloads
+ :: DerivedKey -- ^ rho key
+ -> BS.ByteString -- ^ hop_payloads (1300 bytes)
+ -> BS.ByteString -- ^ decrypted (2600 bytes, first 1300 useful)
+decryptPayloads !rhoKey !payloads =
+ let !streamLen = 2 * hopPayloadsSize -- 2600 bytes
+ !stream = generateStream rhoKey streamLen
+ -- Extend payloads with zeros for the shift operation
+ !extended = payloads <> BS.replicate hopPayloadsSize 0
+ in xorBytes stream extended
+{-# INLINE decryptPayloads #-}
+
+-- | XOR two bytestrings of equal length.
+xorBytes :: BS.ByteString -> BS.ByteString -> BS.ByteString
+xorBytes !a !b = BS.pack (BS.zipWith xor a b)
+{-# INLINE xorBytes #-}
+
+-- | Extract payload from decrypted buffer.
+--
+-- Parses BigSize length prefix, extracts payload bytes and next HMAC.
+extractPayload
+ :: BS.ByteString
+ -> Either RejectReason (BS.ByteString, BS.ByteString, BS.ByteString)
+ -- ^ (payload_bytes, next_hmac, remaining_hop_payloads)
+extractPayload !decrypted = do
+ -- Parse length prefix
+ (len, afterLen) <- case decodeBigSize decrypted of
+ Nothing -> Left (InvalidPayload "invalid length prefix")
+ Just (l, r) -> Right (fromIntegral l :: Int, r)
+
+ -- Validate length
+ if len > BS.length afterLen
+ then Left (InvalidPayload "payload length exceeds buffer")
+ else if len == 0
+ then Left (InvalidPayload "zero-length payload")
+ else pure ()
+
+ -- Extract payload bytes
+ let !payloadBytes = BS.take len afterLen
+ !afterPayload = BS.drop len afterLen
+
+ -- Extract next HMAC (32 bytes)
+ if BS.length afterPayload < hmacSize
+ then Left (InvalidPayload "insufficient bytes for HMAC")
+ else do
+ let !nextHmac = BS.take hmacSize afterPayload
+ -- Remaining payloads: skip the HMAC, take first 1300 bytes
+ -- This is already "shifted" by the payload extraction
+ !remaining = BS.drop hmacSize afterPayload
+
+ Right (payloadBytes, nextHmac, remaining)
+
+-- | Verify packet HMAC.
+--
+-- Computes HMAC over (hop_payloads || associated_data) using mu key
+-- and compares with packet's HMAC using constant-time comparison.
+verifyPacketHmac
+ :: DerivedKey -- ^ mu key
+ -> OnionPacket -- ^ packet with HMAC to verify
+ -> BS.ByteString -- ^ associated data
+ -> Bool
+verifyPacketHmac !muKey !packet !assocData =
+ let !computed = computeHmac muKey (opHopPayloads packet) assocData
+ in verifyHmac (opHmac packet) computed
+{-# INLINE verifyPacketHmac #-}
+
+-- | Prepare packet for forwarding to next hop.
+--
+-- Computes blinded ephemeral key and constructs next OnionPacket.
+prepareForward
+ :: Secp256k1.Projective -- ^ current ephemeral key
+ -> SharedSecret -- ^ shared secret (for blinding)
+ -> BS.ByteString -- ^ remaining hop_payloads (after shift)
+ -> BS.ByteString -- ^ next HMAC
+ -> Maybe OnionPacket
+prepareForward !ephemeral !ss !remaining !nextHmac = do
+ -- Compute blinding factor and blind ephemeral key
+ let !bf = computeBlindingFactor ephemeral ss
+ newEphemeral <- blindPubKey ephemeral bf
+
+ -- Serialize new ephemeral key
+ let !newEphBytes = Secp256k1.serialize_point newEphemeral
+
+ -- Truncate remaining to exactly 1300 bytes
+ let !newPayloads = BS.take hopPayloadsSize remaining
+
+ -- Construct next packet
+ pure $! OnionPacket
+ { opVersion = versionByte
+ , opEphemeralKey = newEphBytes
+ , opHopPayloads = newPayloads
+ , opHmac = nextHmac
+ }
+
+-- | Check if this is the final hop.
+--
+-- Final hop is indicated by next_hmac being all zeros.
+isFinalHop :: BS.ByteString -> Bool
+isFinalHop !hmac = hmac == BS.replicate hmacSize 0
+{-# INLINE isFinalHop #-}
diff --git a/ppad-bolt4.cabal b/ppad-bolt4.cabal
@@ -26,6 +26,7 @@ library
Lightning.Protocol.BOLT4
Lightning.Protocol.BOLT4.Codec
Lightning.Protocol.BOLT4.Prim
+ Lightning.Protocol.BOLT4.Process
Lightning.Protocol.BOLT4.Types
build-depends:
base >= 4.9 && < 5
diff --git a/test/Main.hs b/test/Main.hs
@@ -2,11 +2,13 @@
module Main where
+import Data.Bits (xor)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
import qualified Crypto.Curve.Secp256k1 as Secp256k1
import Lightning.Protocol.BOLT4.Codec
import Lightning.Protocol.BOLT4.Prim
+import Lightning.Protocol.BOLT4.Process
import Lightning.Protocol.BOLT4.Types
import Test.Tasty
import Test.Tasty.HUnit
@@ -30,6 +32,9 @@ main = defaultMain $ testGroup "ppad-bolt4" [
, testGroup "OnionPacket" [
onionPacketTests
]
+ , testGroup "Process" [
+ processTests
+ ]
]
-- BigSize tests ------------------------------------------------------------
@@ -321,3 +326,147 @@ testHmacOperations = testGroup "HMAC operations" [
assertBool "verifyHmac should fail"
(not $ verifyHmac "short" "different length")
]
+
+-- Process tests -------------------------------------------------------------
+
+processTests :: TestTree
+processTests = testGroup "packet processing" [
+ testVersionValidation
+ , testEphemeralKeyValidation
+ , testHmacValidation
+ , testProcessBasic
+ ]
+
+testVersionValidation :: TestTree
+testVersionValidation = testGroup "version validation" [
+ testCase "reject invalid version 0x01" $ do
+ let packet = OnionPacket
+ { opVersion = 0x01 -- Invalid, should be 0x00
+ , opEphemeralKey = BS.replicate 33 0x02
+ , opHopPayloads = BS.replicate 1300 0x00
+ , opHmac = BS.replicate 32 0x00
+ }
+ case process sessionKey packet BS.empty of
+ Left (InvalidVersion v) -> v @?= 0x01
+ Left other -> assertFailure $ "expected InvalidVersion, got: " ++ show other
+ Right _ -> assertFailure "expected rejection, got success"
+ , testCase "reject invalid version 0xFF" $ do
+ let packet = OnionPacket
+ { opVersion = 0xFF
+ , opEphemeralKey = BS.replicate 33 0x02
+ , opHopPayloads = BS.replicate 1300 0x00
+ , opHmac = BS.replicate 32 0x00
+ }
+ case process sessionKey packet BS.empty of
+ Left (InvalidVersion v) -> v @?= 0xFF
+ Left other -> assertFailure $ "expected InvalidVersion, got: " ++ show other
+ Right _ -> assertFailure "expected rejection, got success"
+ ]
+
+testEphemeralKeyValidation :: TestTree
+testEphemeralKeyValidation = testGroup "ephemeral key validation" [
+ testCase "reject invalid ephemeral key (all zeros)" $ do
+ let packet = OnionPacket
+ { opVersion = 0x00
+ , opEphemeralKey = BS.replicate 33 0x00 -- Invalid pubkey
+ , opHopPayloads = BS.replicate 1300 0x00
+ , opHmac = BS.replicate 32 0x00
+ }
+ case process sessionKey packet BS.empty of
+ Left InvalidEphemeralKey -> return ()
+ Left other -> assertFailure $ "expected InvalidEphemeralKey, got: "
+ ++ show other
+ Right _ -> assertFailure "expected rejection, got success"
+ , testCase "reject malformed ephemeral key" $ do
+ -- 0x04 prefix is for uncompressed keys, but we only have 33 bytes
+ let packet = OnionPacket
+ { opVersion = 0x00
+ , opEphemeralKey = BS.pack (0x04 : replicate 32 0xAB)
+ , opHopPayloads = BS.replicate 1300 0x00
+ , opHmac = BS.replicate 32 0x00
+ }
+ case process sessionKey packet BS.empty of
+ Left InvalidEphemeralKey -> return ()
+ Left other -> assertFailure $ "expected InvalidEphemeralKey, got: "
+ ++ show other
+ Right _ -> assertFailure "expected rejection, got success"
+ ]
+
+testHmacValidation :: TestTree
+testHmacValidation = testGroup "HMAC validation" [
+ testCase "reject invalid HMAC" $ do
+ -- Use a valid ephemeral key but wrong HMAC
+ let Just hop0PubKey = Secp256k1.parse_point (fromHex hop0PubKeyHex)
+ ephKeyBytes = Secp256k1.serialize_point hop0PubKey
+ packet = OnionPacket
+ { opVersion = 0x00
+ , opEphemeralKey = ephKeyBytes
+ , opHopPayloads = BS.replicate 1300 0x00
+ , opHmac = BS.replicate 32 0xFF -- Wrong HMAC
+ }
+ case process sessionKey packet BS.empty of
+ Left HmacMismatch -> return ()
+ Left other -> assertFailure $ "expected HmacMismatch, got: "
+ ++ show other
+ Right _ -> assertFailure "expected rejection, got success"
+ ]
+
+-- | Test basic packet processing with a properly constructed packet.
+testProcessBasic :: TestTree
+testProcessBasic = testGroup "basic processing" [
+ testCase "process valid packet (final hop, all-zero next HMAC)" $ do
+ -- Construct a valid packet for a final hop
+ -- The hop payload needs to be properly formatted TLV
+ let Just hop0PubKey = Secp256k1.parse_point (fromHex hop0PubKeyHex)
+ ephKeyBytes = Secp256k1.serialize_point hop0PubKey
+
+ -- Create a minimal hop payload TLV
+ -- amt_to_forward (type 2) = 1000 msat
+ -- outgoing_cltv (type 4) = 500000
+ hopPayloadTlv = encodeHopPayload HopPayload
+ { hpAmtToForward = Just 1000
+ , hpOutgoingCltv = Just 500000
+ , hpShortChannelId = Nothing
+ , hpPaymentData = Nothing
+ , hpEncryptedData = Nothing
+ , hpCurrentPathKey = Nothing
+ , hpUnknownTlvs = []
+ }
+
+ -- Length-prefixed payload followed by all-zero HMAC (final hop)
+ payloadLen = BS.length hopPayloadTlv
+ lenPrefix = encodeBigSize (fromIntegral payloadLen)
+ payloadWithHmac = lenPrefix <> hopPayloadTlv
+ <> BS.replicate 32 0x00 -- Zero HMAC = final hop
+
+ -- Pad to 1300 bytes
+ padding = BS.replicate (1300 - BS.length payloadWithHmac) 0x00
+ rawPayloads = payloadWithHmac <> padding
+
+ -- Compute shared secret and encrypt payloads
+ Just ss = computeSharedSecret sessionKey hop0PubKey
+ rhoKey = deriveRho ss
+ muKey = deriveMu ss
+
+ -- Encrypt: XOR with keystream
+ stream = generateStream rhoKey 1300
+ encryptedPayloads = BS.pack (BS.zipWith xor rawPayloads stream)
+
+ -- Compute correct HMAC
+ correctHmac = computeHmac muKey encryptedPayloads BS.empty
+
+ packet = OnionPacket
+ { opVersion = 0x00
+ , opEphemeralKey = ephKeyBytes
+ , opHopPayloads = encryptedPayloads
+ , opHmac = correctHmac
+ }
+
+ case process sessionKey packet BS.empty of
+ Left err -> assertFailure $ "expected success, got: " ++ show err
+ Right (Receive ri) -> do
+ -- Verify we got the payload back
+ hpAmtToForward (riPayload ri) @?= Just 1000
+ hpOutgoingCltv (riPayload ri) @?= Just 500000
+ Right (Forward _) -> assertFailure "expected Receive, got Forward"
+ ]
