commit f6c4a17746f0c33df65ee8cc0f24f29de3afcbff
parent 200b300da902bc91e2ed8345dda3099854e1ef5a
Author: Jared Tobin <jared@jtobin.io>
Date: Sun, 25 Jan 2026 15:53:44 +0400
merge: impl6 route blinding
Diffstat:
6 files changed, 1013 insertions(+), 26 deletions(-)
diff --git a/flake.lock b/flake.lock
@@ -34,9 +34,75 @@
"type": "github"
}
},
+ "ppad-aead": {
+ "inputs": {
+ "flake-utils": [
+ "ppad-aead",
+ "ppad-nixpkgs",
+ "flake-utils"
+ ],
+ "nixpkgs": [
+ "ppad-aead",
+ "ppad-nixpkgs",
+ "nixpkgs"
+ ],
+ "ppad-base16": "ppad-base16",
+ "ppad-chacha": [
+ "ppad-chacha"
+ ],
+ "ppad-nixpkgs": [
+ "ppad-nixpkgs"
+ ],
+ "ppad-poly1305": "ppad-poly1305"
+ },
+ "locked": {
+ "lastModified": 1768109840,
+ "narHash": "sha256-U9fN8/HK+8wqfHaOCXC4+VjsZiOmSQbn7qkwlFOIif4=",
+ "path": "/Users/jtobin/src/ppad/aead",
+ "type": "path"
+ },
+ "original": {
+ "path": "/Users/jtobin/src/ppad/aead",
+ "type": "path"
+ }
+ },
"ppad-base16": {
"inputs": {
"flake-utils": [
+ "ppad-aead",
+ "ppad-base16",
+ "ppad-nixpkgs",
+ "flake-utils"
+ ],
+ "nixpkgs": [
+ "ppad-aead",
+ "ppad-base16",
+ "ppad-nixpkgs",
+ "nixpkgs"
+ ],
+ "ppad-nixpkgs": [
+ "ppad-aead",
+ "ppad-nixpkgs"
+ ]
+ },
+ "locked": {
+ "lastModified": 1766934151,
+ "narHash": "sha256-BUFpuLfrGXE2xi3Wa9TYCEhhRhFp175Ghxnr0JRbG2I=",
+ "ref": "master",
+ "rev": "58dfb7922401a60d5de76825fcd5f6ecbcd7afe0",
+ "revCount": 26,
+ "type": "git",
+ "url": "git://git.ppad.tech/base16.git"
+ },
+ "original": {
+ "ref": "master",
+ "type": "git",
+ "url": "git://git.ppad.tech/base16.git"
+ }
+ },
+ "ppad-base16_2": {
+ "inputs": {
+ "flake-utils": [
"ppad-base16",
"ppad-nixpkgs",
"flake-utils"
@@ -61,7 +127,7 @@
"type": "path"
}
},
- "ppad-base16_2": {
+ "ppad-base16_3": {
"inputs": {
"flake-utils": [
"ppad-chacha",
@@ -95,7 +161,7 @@
"url": "git://git.ppad.tech/base16.git"
}
},
- "ppad-base16_3": {
+ "ppad-base16_4": {
"inputs": {
"flake-utils": [
"ppad-secp256k1",
@@ -129,7 +195,7 @@
"url": "git://git.ppad.tech/base16.git"
}
},
- "ppad-base16_4": {
+ "ppad-base16_5": {
"inputs": {
"flake-utils": [
"ppad-sha256",
@@ -175,7 +241,7 @@
"ppad-nixpkgs",
"nixpkgs"
],
- "ppad-base16": "ppad-base16_2",
+ "ppad-base16": "ppad-base16_3",
"ppad-nixpkgs": [
"ppad-nixpkgs"
]
@@ -194,6 +260,43 @@
"ppad-fixed": {
"inputs": {
"flake-utils": [
+ "ppad-aead",
+ "ppad-poly1305",
+ "ppad-fixed",
+ "ppad-nixpkgs",
+ "flake-utils"
+ ],
+ "nixpkgs": [
+ "ppad-aead",
+ "ppad-poly1305",
+ "ppad-fixed",
+ "ppad-nixpkgs",
+ "nixpkgs"
+ ],
+ "ppad-nixpkgs": [
+ "ppad-aead",
+ "ppad-poly1305",
+ "ppad-nixpkgs"
+ ]
+ },
+ "locked": {
+ "lastModified": 1766933347,
+ "narHash": "sha256-hwBsY4vyefW9qSj0MK0+wr9hIc0OcFuhQD11XGGcO/o=",
+ "ref": "master",
+ "rev": "d7b03362f9d075c505b8c293524f577f7186a647",
+ "revCount": 289,
+ "type": "git",
+ "url": "git://git.ppad.tech/fixed.git"
+ },
+ "original": {
+ "ref": "master",
+ "type": "git",
+ "url": "git://git.ppad.tech/fixed.git"
+ }
+ },
+ "ppad-fixed_2": {
+ "inputs": {
+ "flake-utils": [
"ppad-secp256k1",
"ppad-fixed",
"ppad-nixpkgs",
@@ -286,6 +389,45 @@
"type": "path"
}
},
+ "ppad-poly1305": {
+ "inputs": {
+ "flake-utils": [
+ "ppad-aead",
+ "ppad-poly1305",
+ "ppad-nixpkgs",
+ "flake-utils"
+ ],
+ "nixpkgs": [
+ "ppad-aead",
+ "ppad-poly1305",
+ "ppad-nixpkgs",
+ "nixpkgs"
+ ],
+ "ppad-base16": [
+ "ppad-aead",
+ "ppad-base16"
+ ],
+ "ppad-fixed": "ppad-fixed",
+ "ppad-nixpkgs": [
+ "ppad-aead",
+ "ppad-nixpkgs"
+ ]
+ },
+ "locked": {
+ "lastModified": 1766951654,
+ "narHash": "sha256-Q+xcIJCOEZ6UgkY62+MOkxUsxL/4ZeQHVjZqVQRxvVA=",
+ "ref": "master",
+ "rev": "1c50a555ab3e4077236aa4d480e4fb3e251e60e0",
+ "revCount": 24,
+ "type": "git",
+ "url": "git://git.ppad.tech/poly1305.git"
+ },
+ "original": {
+ "ref": "master",
+ "type": "git",
+ "url": "git://git.ppad.tech/poly1305.git"
+ }
+ },
"ppad-secp256k1": {
"inputs": {
"flake-utils": [
@@ -298,8 +440,8 @@
"ppad-nixpkgs",
"nixpkgs"
],
- "ppad-base16": "ppad-base16_3",
- "ppad-fixed": "ppad-fixed",
+ "ppad-base16": "ppad-base16_4",
+ "ppad-fixed": "ppad-fixed_2",
"ppad-hmac-drbg": "ppad-hmac-drbg",
"ppad-nixpkgs": [
"ppad-nixpkgs"
@@ -332,7 +474,7 @@
"ppad-nixpkgs",
"nixpkgs"
],
- "ppad-base16": "ppad-base16_4",
+ "ppad-base16": "ppad-base16_5",
"ppad-nixpkgs": [
"ppad-nixpkgs"
]
@@ -396,7 +538,8 @@
"ppad-nixpkgs",
"nixpkgs"
],
- "ppad-base16": "ppad-base16",
+ "ppad-aead": "ppad-aead",
+ "ppad-base16": "ppad-base16_2",
"ppad-chacha": "ppad-chacha",
"ppad-nixpkgs": "ppad-nixpkgs",
"ppad-secp256k1": "ppad-secp256k1",
diff --git a/flake.nix b/flake.nix
@@ -2,6 +2,10 @@
description = "A Haskell implementation of BOLT4 (onion routing).";
inputs = {
+ ppad-aead.url = "path:/Users/jtobin/src/ppad/aead";
+ ppad-aead.inputs.ppad-nixpkgs.follows = "ppad-nixpkgs";
+ ppad-aead.inputs.ppad-chacha.follows = "ppad-chacha";
+
ppad-base16.url = "path:/Users/jtobin/src/ppad/base16";
ppad-base16.inputs.ppad-nixpkgs.follows = "ppad-nixpkgs";
@@ -22,7 +26,7 @@
};
outputs = { self, nixpkgs, flake-utils, ppad-nixpkgs
- , ppad-base16, ppad-chacha
+ , ppad-aead, ppad-base16, ppad-chacha
, ppad-secp256k1, ppad-sha256
}:
flake-utils.lib.eachDefaultSystem (system:
@@ -34,6 +38,12 @@
llvm = pkgs.llvmPackages_19.llvm;
clang = pkgs.llvmPackages_19.clang;
+ aead = ppad-aead.packages.${system}.default;
+ aead-llvm =
+ hlib.addBuildTools
+ (hlib.enableCabalFlag aead "llvm")
+ [ llvm clang ];
+
base16 = ppad-base16.packages.${system}.default;
base16-llvm =
hlib.addBuildTools
@@ -59,11 +69,13 @@
[ llvm clang ];
hpkgs = pkgs.haskell.packages.ghc910.extend (new: old: {
+ ppad-aead = aead-llvm;
ppad-base16 = base16-llvm;
ppad-chacha = chacha-llvm;
ppad-secp256k1 = secp256k1-llvm;
ppad-sha256 = sha256-llvm;
${lib} = new.callCabal2nix lib ./. {
+ ppad-aead = new.ppad-aead;
ppad-base16 = new.ppad-base16;
ppad-chacha = new.ppad-chacha;
ppad-secp256k1 = new.ppad-secp256k1;
diff --git a/lib/Lightning/Protocol/BOLT4.hs b/lib/Lightning/Protocol/BOLT4.hs
@@ -1,8 +1,4 @@
{-# OPTIONS_HADDOCK prune #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-- |
-- Module: Lightning.Protocol.BOLT4
@@ -11,13 +7,18 @@
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
-- BOLT4 onion routing for the Lightning Network.
+--
+-- This module re-exports the public interface from submodules.
module Lightning.Protocol.BOLT4 (
- -- placeholder exports
+ -- * Re-exports
+ module Lightning.Protocol.BOLT4.Blinding
+ , module Lightning.Protocol.BOLT4.Codec
+ , module Lightning.Protocol.BOLT4.Prim
+ , module Lightning.Protocol.BOLT4.Types
) where
-import qualified Data.ByteString as BS
-
--- XX placeholder
-_placeholder :: BS.ByteString -> BS.ByteString
-_placeholder = id
+import Lightning.Protocol.BOLT4.Blinding
+import Lightning.Protocol.BOLT4.Codec
+import Lightning.Protocol.BOLT4.Prim
+import Lightning.Protocol.BOLT4.Types
diff --git a/lib/Lightning/Protocol/BOLT4/Blinding.hs b/lib/Lightning/Protocol/BOLT4/Blinding.hs
@@ -0,0 +1,465 @@
+{-# OPTIONS_HADDOCK prune #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- Module: Lightning.Protocol.BOLT4.Blinding
+-- Copyright: (c) 2025 Jared Tobin
+-- License: MIT
+-- Maintainer: Jared Tobin <jared@ppad.tech>
+--
+-- Route blinding for BOLT4 onion routing.
+
+module Lightning.Protocol.BOLT4.Blinding (
+ -- * Types
+ BlindedPath(..)
+ , BlindedHop(..)
+ , BlindedHopData(..)
+ , PaymentRelay(..)
+ , PaymentConstraints(..)
+ , BlindingError(..)
+
+ -- * Path creation
+ , createBlindedPath
+
+ -- * Hop processing
+ , processBlindedHop
+
+ -- * Key derivation (exported for testing)
+ , deriveBlindingRho
+ , deriveBlindedNodeId
+ , nextEphemeral
+
+ -- * TLV encoding (exported for testing)
+ , encodeBlindedHopData
+ , decodeBlindedHopData
+
+ -- * Encryption (exported for testing)
+ , encryptHopData
+ , decryptHopData
+ ) where
+
+import qualified Crypto.AEAD.ChaCha20Poly1305 as AEAD
+import qualified Crypto.Curve.Secp256k1 as Secp256k1
+import qualified Crypto.Hash.SHA256 as SHA256
+import Data.Bits (shiftL)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Builder as B
+import qualified Data.ByteString.Lazy as BL
+import Data.Word (Word8, Word16, Word32, Word64)
+import Lightning.Protocol.BOLT4.Codec
+ ( encodeShortChannelId, decodeShortChannelId
+ , encodeTlvStream, decodeTlvStream
+ )
+import Lightning.Protocol.BOLT4.Prim (SharedSecret(..), DerivedKey(..))
+import Lightning.Protocol.BOLT4.Types (ShortChannelId(..), TlvRecord(..))
+
+-- Types ---------------------------------------------------------------------
+
+-- | A blinded route provided by recipient.
+data BlindedPath = BlindedPath
+ { bpIntroductionNode :: !Secp256k1.Projective -- ^ First node (unblinded)
+ , bpBlindingKey :: !Secp256k1.Projective -- ^ E_0, initial ephemeral
+ , bpBlindedHops :: ![BlindedHop]
+ } deriving (Eq, Show)
+
+-- | A single hop in a blinded path.
+data BlindedHop = BlindedHop
+ { bhBlindedNodeId :: !BS.ByteString -- ^ 33 bytes, blinded pubkey
+ , bhEncryptedData :: !BS.ByteString -- ^ Encrypted routing data
+ } deriving (Eq, Show)
+
+-- | Data encrypted for each blinded hop (before encryption).
+data BlindedHopData = BlindedHopData
+ { bhdPadding :: !(Maybe BS.ByteString) -- ^ TLV 1
+ , bhdShortChannelId :: !(Maybe ShortChannelId) -- ^ TLV 2
+ , bhdNextNodeId :: !(Maybe BS.ByteString) -- ^ TLV 4, 33-byte pubkey
+ , bhdPathId :: !(Maybe BS.ByteString) -- ^ TLV 6
+ , bhdNextPathKeyOverride :: !(Maybe BS.ByteString) -- ^ TLV 8
+ , bhdPaymentRelay :: !(Maybe PaymentRelay) -- ^ TLV 10
+ , bhdPaymentConstraints :: !(Maybe PaymentConstraints) -- ^ TLV 12
+ , bhdAllowedFeatures :: !(Maybe BS.ByteString) -- ^ TLV 14
+ } deriving (Eq, Show)
+
+-- | Payment relay parameters (TLV 10).
+data PaymentRelay = PaymentRelay
+ { prCltvExpiryDelta :: {-# UNPACK #-} !Word16
+ , prFeeProportional :: {-# UNPACK #-} !Word32 -- ^ Fee in millionths
+ , prFeeBaseMsat :: {-# UNPACK #-} !Word32
+ } deriving (Eq, Show)
+
+-- | Payment constraints (TLV 12).
+data PaymentConstraints = PaymentConstraints
+ { pcMaxCltvExpiry :: {-# UNPACK #-} !Word32
+ , pcHtlcMinimumMsat :: {-# UNPACK #-} !Word64
+ } deriving (Eq, Show)
+
+-- | Errors during blinding operations.
+data BlindingError
+ = InvalidSeed
+ | EmptyPath
+ | InvalidNodeKey Int
+ | DecryptionFailed
+ | InvalidPathKey
+ deriving (Eq, Show)
+
+-- Key derivation ------------------------------------------------------------
+
+-- | Derive rho key for encrypting hop data.
+--
+-- @rho = HMAC-SHA256(key="blinded_node_id", data=shared_secret)@
+deriveBlindingRho :: SharedSecret -> DerivedKey
+deriveBlindingRho (SharedSecret !ss) =
+ let SHA256.MAC !result = SHA256.hmac "blinded_node_id" ss
+ in DerivedKey result
+{-# INLINE deriveBlindingRho #-}
+
+-- | Derive blinded node ID from shared secret and node pubkey.
+--
+-- @B_i = HMAC256("blinded_node_id", ss_i) * N_i@
+deriveBlindedNodeId
+ :: SharedSecret
+ -> Secp256k1.Projective
+ -> Maybe BS.ByteString
+deriveBlindedNodeId (SharedSecret !ss) !nodePub = do
+ let SHA256.MAC !hmacResult = SHA256.hmac "blinded_node_id" ss
+ sk <- Secp256k1.roll32 hmacResult
+ blindedPub <- Secp256k1.mul nodePub sk
+ pure $! Secp256k1.serialize_point blindedPub
+{-# INLINE deriveBlindedNodeId #-}
+
+-- | Compute next ephemeral key pair.
+--
+-- @e_{i+1} = SHA256(E_i || ss_i) * e_i@
+-- @E_{i+1} = SHA256(E_i || ss_i) * E_i@
+nextEphemeral
+ :: BS.ByteString -- ^ e_i (32-byte secret key)
+ -> Secp256k1.Projective -- ^ E_i
+ -> SharedSecret -- ^ ss_i
+ -> Maybe (BS.ByteString, Secp256k1.Projective) -- ^ (e_{i+1}, E_{i+1})
+nextEphemeral !secKey !pubKey (SharedSecret !ss) = do
+ let !pubBytes = Secp256k1.serialize_point pubKey
+ !blindingFactor = SHA256.hash (pubBytes <> ss)
+ bfInt <- Secp256k1.roll32 blindingFactor
+ -- Compute e_{i+1} = e_i * blindingFactor (mod q)
+ let !newSecKey = mulSecKey secKey blindingFactor
+ -- Compute E_{i+1} = E_i * blindingFactor
+ newPubKey <- Secp256k1.mul pubKey bfInt
+ pure (newSecKey, newPubKey)
+{-# INLINE nextEphemeral #-}
+
+-- | Compute blinding factor for next path key (public key only).
+nextPathKey
+ :: Secp256k1.Projective -- ^ E_i
+ -> SharedSecret -- ^ ss_i
+ -> Maybe Secp256k1.Projective -- ^ E_{i+1}
+nextPathKey !pubKey (SharedSecret !ss) = do
+ let !pubBytes = Secp256k1.serialize_point pubKey
+ !blindingFactor = SHA256.hash (pubBytes <> ss)
+ bfInt <- Secp256k1.roll32 blindingFactor
+ Secp256k1.mul pubKey bfInt
+{-# INLINE nextPathKey #-}
+
+-- Encryption/Decryption -----------------------------------------------------
+
+-- | Encrypt hop data with ChaCha20-Poly1305.
+--
+-- Uses rho key and 12-byte zero nonce, empty AAD.
+encryptHopData :: DerivedKey -> BlindedHopData -> BS.ByteString
+encryptHopData (DerivedKey !rho) !hopData =
+ let !plaintext = encodeBlindedHopData hopData
+ !nonce = BS.replicate 12 0
+ in case AEAD.encrypt BS.empty rho nonce plaintext of
+ Left _ -> BS.empty -- Should not happen with valid key
+ Right (!ciphertext, !mac) -> ciphertext <> mac
+{-# INLINE encryptHopData #-}
+
+-- | Decrypt hop data with ChaCha20-Poly1305.
+decryptHopData :: DerivedKey -> BS.ByteString -> Maybe BlindedHopData
+decryptHopData (DerivedKey !rho) !encData
+ | BS.length encData < 16 = Nothing
+ | otherwise = do
+ let !ciphertext = BS.take (BS.length encData - 16) encData
+ !mac = BS.drop (BS.length encData - 16) encData
+ !nonce = BS.replicate 12 0
+ case AEAD.decrypt BS.empty rho nonce (ciphertext, mac) of
+ Left _ -> Nothing
+ Right !plaintext -> decodeBlindedHopData plaintext
+{-# INLINE decryptHopData #-}
+
+-- TLV Encoding/Decoding -----------------------------------------------------
+
+-- | Encode BlindedHopData to TLV stream.
+encodeBlindedHopData :: BlindedHopData -> BS.ByteString
+encodeBlindedHopData !bhd = encodeTlvStream (buildTlvs bhd)
+ where
+ buildTlvs :: BlindedHopData -> [TlvRecord]
+ buildTlvs (BlindedHopData pad sci nid pid pko pr pc af) =
+ let pad' = maybe [] (\p -> [TlvRecord 1 p]) pad
+ sci' = maybe [] (\s -> [TlvRecord 2 (encodeShortChannelId s)]) sci
+ nid' = maybe [] (\n -> [TlvRecord 4 n]) nid
+ pid' = maybe [] (\p -> [TlvRecord 6 p]) pid
+ pko' = maybe [] (\k -> [TlvRecord 8 k]) pko
+ pr' = maybe [] (\r -> [TlvRecord 10 (encodePaymentRelay r)]) pr
+ pc' = maybe [] (\c -> [TlvRecord 12 (encodePaymentConstraints c)]) pc
+ af' = maybe [] (\f -> [TlvRecord 14 f]) af
+ in pad' ++ sci' ++ nid' ++ pid' ++ pko' ++ pr' ++ pc' ++ af'
+{-# INLINE encodeBlindedHopData #-}
+
+-- | Decode TLV stream to BlindedHopData.
+decodeBlindedHopData :: BS.ByteString -> Maybe BlindedHopData
+decodeBlindedHopData !bs = do
+ tlvs <- decodeTlvStream bs
+ parseBlindedHopData tlvs
+
+parseBlindedHopData :: [TlvRecord] -> Maybe BlindedHopData
+parseBlindedHopData = go emptyHopData
+ where
+ emptyHopData :: BlindedHopData
+ emptyHopData = BlindedHopData
+ Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+
+ go :: BlindedHopData -> [TlvRecord] -> Maybe BlindedHopData
+ go !bhd [] = Just bhd
+ go !bhd (TlvRecord typ val : rest) = case typ of
+ 1 -> go bhd { bhdPadding = Just val } rest
+ 2 -> do
+ sci <- decodeShortChannelId val
+ go bhd { bhdShortChannelId = Just sci } rest
+ 4 -> go bhd { bhdNextNodeId = Just val } rest
+ 6 -> go bhd { bhdPathId = Just val } rest
+ 8 -> go bhd { bhdNextPathKeyOverride = Just val } rest
+ 10 -> do
+ pr <- decodePaymentRelay val
+ go bhd { bhdPaymentRelay = Just pr } rest
+ 12 -> do
+ pc <- decodePaymentConstraints val
+ go bhd { bhdPaymentConstraints = Just pc } rest
+ 14 -> go bhd { bhdAllowedFeatures = Just val } rest
+ _ -> go bhd rest -- Skip unknown TLVs
+
+-- PaymentRelay encoding/decoding --------------------------------------------
+
+-- | Encode PaymentRelay.
+--
+-- Format: 2-byte cltv_delta BE, 4-byte fee_prop BE, tu32 fee_base
+encodePaymentRelay :: PaymentRelay -> BS.ByteString
+encodePaymentRelay (PaymentRelay !cltv !feeProp !feeBase) = toStrict $
+ B.word16BE cltv <>
+ B.word32BE feeProp <>
+ B.byteString (encodeWord32TU feeBase)
+{-# INLINE encodePaymentRelay #-}
+
+-- | Decode PaymentRelay.
+decodePaymentRelay :: BS.ByteString -> Maybe PaymentRelay
+decodePaymentRelay !bs
+ | BS.length bs < 6 = Nothing
+ | otherwise = do
+ let !cltv = word16BE (BS.take 2 bs)
+ !feeProp = word32BE (BS.take 4 (BS.drop 2 bs))
+ !feeBaseBytes = BS.drop 6 bs
+ feeBase <- decodeWord32TU feeBaseBytes
+ Just (PaymentRelay cltv feeProp feeBase)
+{-# INLINE decodePaymentRelay #-}
+
+-- PaymentConstraints encoding/decoding --------------------------------------
+
+-- | Encode PaymentConstraints.
+--
+-- Format: 4-byte max_cltv BE, tu64 htlc_min
+encodePaymentConstraints :: PaymentConstraints -> BS.ByteString
+encodePaymentConstraints (PaymentConstraints !maxCltv !htlcMin) = toStrict $
+ B.word32BE maxCltv <>
+ B.byteString (encodeWord64TU htlcMin)
+{-# INLINE encodePaymentConstraints #-}
+
+-- | Decode PaymentConstraints.
+decodePaymentConstraints :: BS.ByteString -> Maybe PaymentConstraints
+decodePaymentConstraints !bs
+ | BS.length bs < 4 = Nothing
+ | otherwise = do
+ let !maxCltv = word32BE (BS.take 4 bs)
+ !htlcMinBytes = BS.drop 4 bs
+ htlcMin <- decodeWord64TU htlcMinBytes
+ Just (PaymentConstraints maxCltv htlcMin)
+{-# INLINE decodePaymentConstraints #-}
+
+-- Shared secret computation -------------------------------------------------
+
+-- | Compute shared secret from ECDH.
+computeSharedSecret
+ :: BS.ByteString -- ^ 32-byte secret key
+ -> Secp256k1.Projective -- ^ Public key
+ -> Maybe SharedSecret
+computeSharedSecret !secBs !pub = do
+ sec <- Secp256k1.roll32 secBs
+ ecdhPoint <- Secp256k1.mul pub sec
+ let !compressed = Secp256k1.serialize_point ecdhPoint
+ !ss = SHA256.hash compressed
+ pure $! SharedSecret ss
+{-# INLINE computeSharedSecret #-}
+
+-- Path creation -------------------------------------------------------------
+
+-- | Create a blinded path from a seed and list of nodes with their data.
+createBlindedPath
+ :: BS.ByteString -- ^ 32-byte random seed for ephemeral key
+ -> [(Secp256k1.Projective, BlindedHopData)] -- ^ Nodes with their data
+ -> Either BlindingError BlindedPath
+createBlindedPath !seed !nodes
+ | BS.length seed /= 32 = Left InvalidSeed
+ | otherwise = case nodes of
+ [] -> Left EmptyPath
+ ((introNode, _) : _) -> do
+ -- (e_0, E_0) = keypair from seed
+ e0 <- maybe (Left InvalidSeed) Right (Secp256k1.roll32 seed)
+ e0Pub <- maybe (Left InvalidSeed) Right
+ (Secp256k1.mul Secp256k1._CURVE_G e0)
+ -- Process all hops
+ hops <- processHops seed e0Pub nodes 0
+ Right (BlindedPath introNode e0Pub hops)
+
+processHops
+ :: BS.ByteString -- ^ Current e_i
+ -> Secp256k1.Projective -- ^ Current E_i
+ -> [(Secp256k1.Projective, BlindedHopData)]
+ -> Int -- ^ Index for error reporting
+ -> Either BlindingError [BlindedHop]
+processHops _ _ [] _ = Right []
+processHops !eKey !ePub ((nodePub, hopData) : rest) !idx = do
+ -- ss_i = SHA256(ECDH(e_i, N_i))
+ ss <- maybe (Left (InvalidNodeKey idx)) Right
+ (computeSharedSecret eKey nodePub)
+ -- rho_i = deriveBlindingRho(ss_i)
+ let !rho = deriveBlindingRho ss
+ -- B_i = deriveBlindedNodeId(ss_i, N_i)
+ blindedId <- maybe (Left (InvalidNodeKey idx)) Right
+ (deriveBlindedNodeId ss nodePub)
+ -- encrypted_i = encryptHopData(rho_i, data_i)
+ let !encData = encryptHopData rho hopData
+ !hop = BlindedHop blindedId encData
+ -- (e_{i+1}, E_{i+1}) = nextEphemeral(e_i, E_i, ss_i)
+ (nextE, nextEPub) <- maybe (Left (InvalidNodeKey idx)) Right
+ (nextEphemeral eKey ePub ss)
+ -- Process remaining hops
+ restHops <- processHops nextE nextEPub rest (idx + 1)
+ Right (hop : restHops)
+
+-- Hop processing ------------------------------------------------------------
+
+-- | Process a blinded hop, returning decrypted data and next path key.
+processBlindedHop
+ :: BS.ByteString -- ^ Node's 32-byte private key
+ -> Secp256k1.Projective -- ^ E_i, current path key (blinding point)
+ -> BS.ByteString -- ^ encrypted_data from onion payload
+ -> Either BlindingError (BlindedHopData, Secp256k1.Projective)
+processBlindedHop !nodeSecKey !pathKey !encData = do
+ -- ss = SHA256(ECDH(node_seckey, path_key))
+ ss <- maybe (Left InvalidPathKey) Right
+ (computeSharedSecret nodeSecKey pathKey)
+ -- rho = deriveBlindingRho(ss)
+ let !rho = deriveBlindingRho ss
+ -- hop_data = decryptHopData(rho, encrypted_data)
+ hopData <- maybe (Left DecryptionFailed) Right
+ (decryptHopData rho encData)
+ -- Compute next path key
+ nextKey <- case bhdNextPathKeyOverride hopData of
+ Just override -> do
+ -- Parse override as compressed point
+ maybe (Left InvalidPathKey) Right (Secp256k1.parse_point override)
+ Nothing -> do
+ -- E_next = SHA256(path_key || ss) * path_key
+ maybe (Left InvalidPathKey) Right (nextPathKey pathKey ss)
+ Right (hopData, nextKey)
+
+-- Helper functions ----------------------------------------------------------
+
+-- | Convert Builder to strict ByteString.
+toStrict :: B.Builder -> BS.ByteString
+toStrict = BL.toStrict . B.toLazyByteString
+{-# INLINE toStrict #-}
+
+-- | Decode big-endian Word16.
+word16BE :: BS.ByteString -> Word16
+word16BE !bs =
+ let !b0 = fromIntegral (BS.index bs 0) :: Word16
+ !b1 = fromIntegral (BS.index bs 1) :: Word16
+ in (b0 `shiftL` 8) + b1
+{-# INLINE word16BE #-}
+
+-- | Decode big-endian Word32.
+word32BE :: BS.ByteString -> Word32
+word32BE !bs =
+ let !b0 = fromIntegral (BS.index bs 0) :: Word32
+ !b1 = fromIntegral (BS.index bs 1) :: Word32
+ !b2 = fromIntegral (BS.index bs 2) :: Word32
+ !b3 = fromIntegral (BS.index bs 3) :: Word32
+ in (b0 `shiftL` 24) + (b1 `shiftL` 16) + (b2 `shiftL` 8) + b3
+{-# INLINE word32BE #-}
+
+-- | Encode Word64 as truncated unsigned (minimal bytes).
+encodeWord64TU :: Word64 -> BS.ByteString
+encodeWord64TU !n
+ | n == 0 = BS.empty
+ | otherwise = BS.dropWhile (== 0) (toStrict (B.word64BE n))
+{-# INLINE encodeWord64TU #-}
+
+-- | Decode truncated unsigned to Word64.
+decodeWord64TU :: BS.ByteString -> Maybe Word64
+decodeWord64TU !bs
+ | BS.null bs = Just 0
+ | BS.length bs > 8 = Nothing
+ | not (BS.null bs) && BS.index bs 0 == 0 = Nothing -- Non-canonical
+ | otherwise = Just (go 0 bs)
+ where
+ go :: Word64 -> BS.ByteString -> Word64
+ go !acc !b = case BS.uncons b of
+ Nothing -> acc
+ Just (x, rest) -> go ((acc `shiftL` 8) + fromIntegral x) rest
+{-# INLINE decodeWord64TU #-}
+
+-- | Encode Word32 as truncated unsigned.
+encodeWord32TU :: Word32 -> BS.ByteString
+encodeWord32TU !n
+ | n == 0 = BS.empty
+ | otherwise = BS.dropWhile (== 0) (toStrict (B.word32BE n))
+{-# INLINE encodeWord32TU #-}
+
+-- | Decode truncated unsigned to Word32.
+decodeWord32TU :: BS.ByteString -> Maybe Word32
+decodeWord32TU !bs
+ | BS.null bs = Just 0
+ | BS.length bs > 4 = Nothing
+ | not (BS.null bs) && BS.index bs 0 == 0 = Nothing -- Non-canonical
+ | otherwise = Just (go 0 bs)
+ where
+ go :: Word32 -> BS.ByteString -> Word32
+ go !acc !b = case BS.uncons b of
+ Nothing -> acc
+ Just (x, rest) -> go ((acc `shiftL` 8) + fromIntegral x) rest
+{-# INLINE decodeWord32TU #-}
+
+-- | Multiply two secret keys mod curve order q.
+mulSecKey :: BS.ByteString -> BS.ByteString -> BS.ByteString
+mulSecKey !a !b =
+ let !aInt = bsToInteger a
+ !bInt = bsToInteger b
+ -- secp256k1 curve order
+ !qInt = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141
+ !resultInt = (aInt * bInt) `mod` qInt
+ in integerToBS32 resultInt
+{-# INLINE mulSecKey #-}
+
+-- Convert big-endian ByteString to Integer.
+bsToInteger :: BS.ByteString -> Integer
+bsToInteger = BS.foldl' (\acc b -> acc * 256 + fromIntegral b) 0
+{-# INLINE bsToInteger #-}
+
+-- Convert Integer to 32-byte big-endian ByteString.
+integerToBS32 :: Integer -> BS.ByteString
+integerToBS32 n = BS.pack (go 32 n [])
+ where
+ go :: Int -> Integer -> [Word8] -> [Word8]
+ go 0 _ acc = acc
+ go i x acc = go (i - 1) (x `div` 256) (fromIntegral (x `mod` 256) : acc)
+{-# INLINE integerToBS32 #-}
diff --git a/ppad-bolt4.cabal b/ppad-bolt4.cabal
@@ -24,6 +24,7 @@ library
-Wall
exposed-modules:
Lightning.Protocol.BOLT4
+ Lightning.Protocol.BOLT4.Blinding
Lightning.Protocol.BOLT4.Codec
Lightning.Protocol.BOLT4.Construct
Lightning.Protocol.BOLT4.Error
@@ -33,6 +34,7 @@ library
build-depends:
base >= 4.9 && < 5
, bytestring >= 0.9 && < 0.13
+ , ppad-aead >= 0.3 && < 0.4
, ppad-chacha >= 0.2 && < 0.3
, ppad-secp256k1 >= 0.5 && < 0.6
, ppad-sha256 >= 0.3 && < 0.4
diff --git a/test/Main.hs b/test/Main.hs
@@ -6,6 +6,8 @@ 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 Data.Word (Word8)
+import Lightning.Protocol.BOLT4.Blinding
import Lightning.Protocol.BOLT4.Codec
import Lightning.Protocol.BOLT4.Construct
import Lightning.Protocol.BOLT4.Error
@@ -43,6 +45,14 @@ main = defaultMain $ testGroup "ppad-bolt4" [
, testGroup "Error" [
errorTests
]
+ , testGroup "Blinding" [
+ blindingKeyDerivationTests
+ , blindingEphemeralKeyTests
+ , blindingTlvTests
+ , blindingEncryptionTests
+ , blindingCreatePathTests
+ , blindingProcessHopTests
+ ]
]
-- BigSize tests ------------------------------------------------------------
@@ -87,11 +97,9 @@ bigsizeTests = testGroup "boundary values" [
BS.pack [0xFF, 0x00, 0x00, 0x00, 0x01, 0x00, 0x00, 0x00, 0x00]
result @?= Just (0x100000000, BS.empty)
, testCase "reject non-canonical 0xFD encoding of small value" $ do
- -- 0x00FC encoded as 0xFD 0x00 0xFC should be rejected
let result = decodeBigSize (BS.pack [0xFD, 0x00, 0xFC])
result @?= Nothing
, testCase "reject non-canonical 0xFE encoding of small value" $ do
- -- 0x0000FFFF encoded with 0xFE should be rejected
let result = decodeBigSize (BS.pack [0xFE, 0x00, 0x00, 0xFF, 0xFF])
result @?= Nothing
, testCase "bigSizeLen" $ do
@@ -128,7 +136,6 @@ tlvTests = testGroup "encoding/decoding" [
decoded = decodeTlvStream encoded
decoded @?= Just recs
, testCase "reject out-of-order types" $ do
- -- Manually construct out-of-order stream
let rec1 = encodeTlv (TlvRecord 4 (BS.pack [0x01]))
rec2 = encodeTlv (TlvRecord 2 (BS.pack [0x02]))
badStream = rec1 <> rec2
@@ -156,7 +163,6 @@ sciTests = testGroup "encoding/decoding" [
let decoded = decodeShortChannelId encoded
decoded @?= Just sci
, testCase "maximum values" $ do
- -- Max 3-byte block (0xFFFFFF), max 3-byte tx (0xFFFFFF), max output
let sci = ShortChannelId 0xFFFFFF 0xFFFFFF 0xFFFF
encoded = encodeShortChannelId sci
BS.length encoded @?= 8
@@ -194,9 +200,8 @@ onionPacketTests = testGroup "encoding/decoding" [
decoded @?= Nothing
]
--- Prim tests -----------------------------------------------------------------
+-- Prim tests ---------------------------------------------------------------
--- BOLT4 spec test vectors using session key 0x4141...41 (32 bytes of 0x41).
sessionKey :: BS.ByteString
sessionKey = BS.replicate 32 0x41
@@ -212,7 +217,6 @@ hop0BlindingFactorHex :: BS.ByteString
hop0BlindingFactorHex =
"2ec2e5da605776054187180343287683aa6a51b4b1c04d6dd49c45d8cffb3c36"
--- Parse hex helper
fromHex :: BS.ByteString -> BS.ByteString
fromHex h = case B16.decode h of
Just bs -> bs
@@ -794,3 +798,363 @@ testFailureMessageParsing = testGroup "failure message parsing" [
_ -> assertFailure $ "Failed for code: " ++ show code
) codes
]
+
+-- Blinding tests -----------------------------------------------------------
+
+-- Test data setup
+
+testSeed :: BS.ByteString
+testSeed = BS.pack [1..32]
+
+makeSecKey :: Word8 -> BS.ByteString
+makeSecKey seed = BS.pack $ replicate 31 0x00 ++ [seed]
+
+makePubKey :: Word8 -> Maybe Secp256k1.Projective
+makePubKey seed = do
+ sk <- Secp256k1.roll32 (makeSecKey seed)
+ Secp256k1.derive_pub sk
+
+testNodeSecKey1, testNodeSecKey2, testNodeSecKey3 :: BS.ByteString
+testNodeSecKey1 = makeSecKey 0x11
+testNodeSecKey2 = makeSecKey 0x22
+testNodeSecKey3 = makeSecKey 0x33
+
+testNodePubKey1, testNodePubKey2, testNodePubKey3 :: Secp256k1.Projective
+Just testNodePubKey1 = makePubKey 0x11
+Just testNodePubKey2 = makePubKey 0x22
+Just testNodePubKey3 = makePubKey 0x33
+
+testSharedSecretBS :: SharedSecret
+testSharedSecretBS = SharedSecret (BS.pack [0x42..0x61])
+
+emptyHopData :: BlindedHopData
+emptyHopData = BlindedHopData
+ Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+
+sampleHopData :: BlindedHopData
+sampleHopData = BlindedHopData
+ { bhdPadding = Nothing
+ , bhdShortChannelId = Just (ShortChannelId 700000 1234 0)
+ , bhdNextNodeId = Nothing
+ , bhdPathId = Just (BS.pack [0x42, 0x42])
+ , bhdNextPathKeyOverride = Nothing
+ , bhdPaymentRelay = Just (PaymentRelay 40 1000 500)
+ , bhdPaymentConstraints = Just (PaymentConstraints 144 1000000)
+ , bhdAllowedFeatures = Nothing
+ }
+
+hopDataWithNextNode :: BlindedHopData
+hopDataWithNextNode = emptyHopData
+ { bhdNextNodeId = Just (Secp256k1.serialize_point testNodePubKey2) }
+
+-- 1. Key Derivation Tests --------------------------------------------------
+
+blindingKeyDerivationTests :: TestTree
+blindingKeyDerivationTests = testGroup "key derivation" [
+ testCase "deriveBlindingRho produces 32 bytes" $ do
+ let DerivedKey rho = deriveBlindingRho testSharedSecretBS
+ BS.length rho @?= 32
+
+ , testCase "deriveBlindingRho is deterministic" $ do
+ let rho1 = deriveBlindingRho testSharedSecretBS
+ rho2 = deriveBlindingRho testSharedSecretBS
+ rho1 @?= rho2
+
+ , testCase "deriveBlindingRho differs for different secrets" $ do
+ let ss1 = SharedSecret (BS.replicate 32 0x00)
+ ss2 = SharedSecret (BS.replicate 32 0x01)
+ rho1 = deriveBlindingRho ss1
+ rho2 = deriveBlindingRho ss2
+ assertBool "rho values should differ" (rho1 /= rho2)
+
+ , testCase "deriveBlindedNodeId produces 33 bytes" $ do
+ case deriveBlindedNodeId testSharedSecretBS testNodePubKey1 of
+ Nothing -> assertFailure "deriveBlindedNodeId returned Nothing"
+ Just blindedId -> BS.length blindedId @?= 33
+
+ , testCase "deriveBlindedNodeId is deterministic" $ do
+ let result1 = deriveBlindedNodeId testSharedSecretBS testNodePubKey1
+ result2 = deriveBlindedNodeId testSharedSecretBS testNodePubKey1
+ result1 @?= result2
+
+ , testCase "deriveBlindedNodeId differs for different nodes" $ do
+ let result1 = deriveBlindedNodeId testSharedSecretBS testNodePubKey1
+ result2 = deriveBlindedNodeId testSharedSecretBS testNodePubKey2
+ assertBool "blinded node IDs should differ" (result1 /= result2)
+ ]
+
+-- 2. Ephemeral Key Iteration Tests -----------------------------------------
+
+-- | Derive the public key for testSeed
+testSeedPubKey :: Secp256k1.Projective
+testSeedPubKey =
+ let Just sk = Secp256k1.roll32 testSeed
+ Just pk = Secp256k1.derive_pub sk
+ in pk
+
+blindingEphemeralKeyTests :: TestTree
+blindingEphemeralKeyTests = testGroup "ephemeral key iteration" [
+ testCase "nextEphemeral produces valid keys" $ do
+ -- Use matching secret/public key pair
+ case nextEphemeral testSeed testSeedPubKey testSharedSecretBS of
+ Nothing -> assertFailure "nextEphemeral returned Nothing"
+ Just (newSecKey, newPubKey) -> do
+ BS.length newSecKey @?= 32
+ let serialized = Secp256k1.serialize_point newPubKey
+ BS.length serialized @?= 33
+
+ , testCase "nextEphemeral: new secret key derives new public key" $ do
+ -- Use matching secret/public key pair
+ case nextEphemeral testSeed testSeedPubKey testSharedSecretBS of
+ Nothing -> assertFailure "nextEphemeral returned Nothing"
+ Just (newSecKey, newPubKey) -> do
+ let Just sk = Secp256k1.roll32 newSecKey
+ Just derivedPub = Secp256k1.derive_pub sk
+ derivedPub @?= newPubKey
+
+ , testCase "nextEphemeral is deterministic" $ do
+ let result1 = nextEphemeral testSeed testSeedPubKey testSharedSecretBS
+ result2 = nextEphemeral testSeed testSeedPubKey testSharedSecretBS
+ result1 @?= result2
+
+ , testCase "nextEphemeral differs for different shared secrets" $ do
+ let ss1 = SharedSecret (BS.replicate 32 0xAA)
+ ss2 = SharedSecret (BS.replicate 32 0xBB)
+ result1 = nextEphemeral testSeed testSeedPubKey ss1
+ result2 = nextEphemeral testSeed testSeedPubKey ss2
+ assertBool "results should differ" (result1 /= result2)
+ ]
+
+-- 3. TLV Encoding/Decoding Tests -------------------------------------------
+
+blindingTlvTests :: TestTree
+blindingTlvTests = testGroup "TLV encoding/decoding" [
+ testCase "roundtrip: empty hop data" $ do
+ let encoded = encodeBlindedHopData emptyHopData
+ decoded = decodeBlindedHopData encoded
+ decoded @?= Just emptyHopData
+
+ , testCase "roundtrip: sample hop data" $ do
+ let encoded = encodeBlindedHopData sampleHopData
+ decoded = decodeBlindedHopData encoded
+ decoded @?= Just sampleHopData
+
+ , testCase "roundtrip: hop data with next node ID" $ do
+ let encoded = encodeBlindedHopData hopDataWithNextNode
+ decoded = decodeBlindedHopData encoded
+ decoded @?= Just hopDataWithNextNode
+
+ , testCase "roundtrip: hop data with padding" $ do
+ let hopData = emptyHopData { bhdPadding = Just (BS.replicate 16 0x00) }
+ encoded = encodeBlindedHopData hopData
+ decoded = decodeBlindedHopData encoded
+ decoded @?= Just hopData
+
+ , testCase "PaymentRelay encoding/decoding" $ do
+ let relay = PaymentRelay 40 1000 500
+ hopData = emptyHopData { bhdPaymentRelay = Just relay }
+ encoded = encodeBlindedHopData hopData
+ decoded = decodeBlindedHopData encoded
+ case decoded of
+ Nothing -> assertFailure "decodeBlindedHopData returned Nothing"
+ Just hd -> bhdPaymentRelay hd @?= Just relay
+
+ , testCase "PaymentConstraints encoding/decoding" $ do
+ let constraints = PaymentConstraints 144 1000000
+ hopData = emptyHopData { bhdPaymentConstraints = Just constraints }
+ encoded = encodeBlindedHopData hopData
+ decoded = decodeBlindedHopData encoded
+ case decoded of
+ Nothing -> assertFailure "decodeBlindedHopData returned Nothing"
+ Just hd -> bhdPaymentConstraints hd @?= Just constraints
+
+ , testCase "decode empty bytestring returns empty hop data" $ do
+ let decoded = decodeBlindedHopData BS.empty
+ decoded @?= Just emptyHopData
+ ]
+
+-- 4. Encryption/Decryption Tests -------------------------------------------
+
+blindingEncryptionTests :: TestTree
+blindingEncryptionTests = testGroup "encryption/decryption" [
+ testCase "roundtrip: encrypt then decrypt" $ do
+ let rho = deriveBlindingRho testSharedSecretBS
+ encrypted = encryptHopData rho sampleHopData
+ decrypted = decryptHopData rho encrypted
+ decrypted @?= Just sampleHopData
+
+ , testCase "roundtrip: empty hop data" $ do
+ let rho = deriveBlindingRho testSharedSecretBS
+ encrypted = encryptHopData rho emptyHopData
+ decrypted = decryptHopData rho encrypted
+ decrypted @?= Just emptyHopData
+
+ , testCase "decryption with wrong key fails" $ do
+ let rho1 = deriveBlindingRho testSharedSecretBS
+ rho2 = deriveBlindingRho (SharedSecret (BS.replicate 32 0xFF))
+ encrypted = encryptHopData rho1 sampleHopData
+ decrypted = decryptHopData rho2 encrypted
+ assertBool "decryption should fail or produce garbage"
+ (decrypted /= Just sampleHopData)
+
+ , testCase "encrypt is deterministic" $ do
+ let rho = deriveBlindingRho testSharedSecretBS
+ encrypted1 = encryptHopData rho sampleHopData
+ encrypted2 = encryptHopData rho sampleHopData
+ encrypted1 @?= encrypted2
+ ]
+
+-- 5. createBlindedPath Tests -----------------------------------------------
+
+blindingCreatePathTests :: TestTree
+blindingCreatePathTests = testGroup "createBlindedPath" [
+ testCase "create path with 2 hops" $ do
+ let nodes = [(testNodePubKey1, emptyHopData),
+ (testNodePubKey2, sampleHopData)]
+ case createBlindedPath testSeed nodes of
+ Left err -> assertFailure $ "createBlindedPath failed: " ++ show err
+ Right path -> do
+ length (bpBlindedHops path) @?= 2
+ let serialized = Secp256k1.serialize_point (bpBlindingKey path)
+ BS.length serialized @?= 33
+
+ , testCase "create path with 3 hops" $ do
+ let nodes = [ (testNodePubKey1, emptyHopData)
+ , (testNodePubKey2, hopDataWithNextNode)
+ , (testNodePubKey3, sampleHopData)
+ ]
+ case createBlindedPath testSeed nodes of
+ Left err -> assertFailure $ "createBlindedPath failed: " ++ show err
+ Right path -> length (bpBlindedHops path) @?= 3
+
+ , testCase "all blinded node IDs are 33 bytes" $ do
+ let nodes = [ (testNodePubKey1, emptyHopData)
+ , (testNodePubKey2, emptyHopData)
+ , (testNodePubKey3, emptyHopData)
+ ]
+ case createBlindedPath testSeed nodes of
+ Left err -> assertFailure $ "createBlindedPath failed: " ++ show err
+ Right path -> do
+ let blindedIds = map bhBlindedNodeId (bpBlindedHops path)
+ mapM_ (\bid -> BS.length bid @?= 33) blindedIds
+
+ , testCase "empty path returns EmptyPath error" $ do
+ case createBlindedPath testSeed [] of
+ Left EmptyPath -> return ()
+ Left err -> assertFailure $ "Expected EmptyPath, got: " ++ show err
+ Right _ -> assertFailure "Expected error, got success"
+
+ , testCase "invalid seed returns InvalidSeed error" $ do
+ let invalidSeed = BS.pack [1..16]
+ nodes = [(testNodePubKey1, emptyHopData)]
+ case createBlindedPath invalidSeed nodes of
+ Left InvalidSeed -> return ()
+ Left err -> assertFailure $ "Expected InvalidSeed, got: " ++ show err
+ Right _ -> assertFailure "Expected error, got success"
+
+ , testCase "createBlindedPath is deterministic" $ do
+ let nodes = [(testNodePubKey1, emptyHopData),
+ (testNodePubKey2, sampleHopData)]
+ result1 = createBlindedPath testSeed nodes
+ result2 = createBlindedPath testSeed nodes
+ result1 @?= result2
+ ]
+
+-- 6. processBlindedHop Tests -----------------------------------------------
+
+blindingProcessHopTests :: TestTree
+blindingProcessHopTests = testGroup "processBlindedHop" [
+ testCase "process first hop decrypts correctly" $ do
+ let nodes = [(testNodePubKey1, sampleHopData),
+ (testNodePubKey2, emptyHopData)]
+ case createBlindedPath testSeed nodes of
+ Left err -> assertFailure $ "createBlindedPath failed: " ++ show err
+ Right path -> do
+ let firstHop = head (bpBlindedHops path)
+ pathKey = bpBlindingKey path
+ case processBlindedHop testNodeSecKey1 pathKey
+ (bhEncryptedData firstHop) of
+ Left err -> assertFailure $
+ "processBlindedHop failed: " ++ show err
+ Right (decryptedData, _) -> decryptedData @?= sampleHopData
+
+ , testCase "process hop chain correctly" $ do
+ let nodes = [ (testNodePubKey1, emptyHopData)
+ , (testNodePubKey2, sampleHopData)
+ , (testNodePubKey3, hopDataWithNextNode)
+ ]
+ case createBlindedPath testSeed nodes of
+ Left err -> assertFailure $ "createBlindedPath failed: " ++ show err
+ Right path -> do
+ let [hop1, hop2, hop3] = bpBlindedHops path
+ pathKey1 = bpBlindingKey path
+
+ case processBlindedHop testNodeSecKey1 pathKey1
+ (bhEncryptedData hop1) of
+ Left err -> assertFailure $
+ "processBlindedHop hop1 failed: " ++ show err
+ Right (data1, pathKey2) -> do
+ data1 @?= emptyHopData
+
+ case processBlindedHop testNodeSecKey2 pathKey2
+ (bhEncryptedData hop2) of
+ Left err -> assertFailure $
+ "processBlindedHop hop2 failed: " ++ show err
+ Right (data2, pathKey3) -> do
+ data2 @?= sampleHopData
+
+ case processBlindedHop testNodeSecKey3 pathKey3
+ (bhEncryptedData hop3) of
+ Left err -> assertFailure $
+ "processBlindedHop hop3 failed: " ++ show err
+ Right (data3, _) -> data3 @?= hopDataWithNextNode
+
+ , testCase "process hop with wrong node key fails" $ do
+ let nodes = [(testNodePubKey1, sampleHopData)]
+ case createBlindedPath testSeed nodes of
+ Left err -> assertFailure $ "createBlindedPath failed: " ++ show err
+ Right path -> do
+ let firstHop = head (bpBlindedHops path)
+ pathKey = bpBlindingKey path
+ case processBlindedHop testNodeSecKey2 pathKey
+ (bhEncryptedData firstHop) of
+ Left _ -> return ()
+ Right (decryptedData, _) ->
+ assertBool "should not decrypt correctly"
+ (decryptedData /= sampleHopData)
+
+ , testCase "next path key is valid point" $ do
+ let nodes = [(testNodePubKey1, emptyHopData),
+ (testNodePubKey2, emptyHopData)]
+ case createBlindedPath testSeed nodes of
+ Left err -> assertFailure $ "createBlindedPath failed: " ++ show err
+ Right path -> do
+ let firstHop = head (bpBlindedHops path)
+ pathKey = bpBlindingKey path
+ case processBlindedHop testNodeSecKey1 pathKey
+ (bhEncryptedData firstHop) of
+ Left err -> assertFailure $
+ "processBlindedHop failed: " ++ show err
+ Right (_, nextPathKey) -> do
+ let serialized = Secp256k1.serialize_point nextPathKey
+ BS.length serialized @?= 33
+
+ , testCase "next_path_key_override is used when present" $ do
+ let overrideKey = Secp256k1.serialize_point testNodePubKey3
+ hopDataWithOverride' = emptyHopData
+ { bhdNextPathKeyOverride = Just overrideKey }
+ nodes = [(testNodePubKey1, hopDataWithOverride'),
+ (testNodePubKey2, emptyHopData)]
+ case createBlindedPath testSeed nodes of
+ Left err -> assertFailure $ "createBlindedPath failed: " ++ show err
+ Right path -> do
+ let firstHop = head (bpBlindedHops path)
+ pathKey = bpBlindingKey path
+ case processBlindedHop testNodeSecKey1 pathKey
+ (bhEncryptedData firstHop) of
+ Left err -> assertFailure $
+ "processBlindedHop failed: " ++ show err
+ Right (decryptedData, nextPathKey) -> do
+ bhdNextPathKeyOverride decryptedData @?= Just overrideKey
+ nextPathKey @?= testNodePubKey3
+ ]
