commit dd4a5625a853a465d07feba5e6e5fee47c7b0776
parent c8797c8adce7a5e0ea120590c8222539800b7dfd
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 10 Oct 2026 13:42:25 +0400
lib: make keystream and encryption failures explicit
generateStream returned an all-zero keystream when ChaCha20 failed
(reachable with a hand-built DerivedKey), i.e. no encryption at all.
It now returns Maybe. encryptHopData called error on an AEAD failure;
it now returns Maybe too.
Callers propagate the failure: construct maps it to InvalidSessionKey
(pad stream) or InvalidHopPubKey (a hop's rho stream, now generated
once per hop), process to InvalidEphemeralKey, createBlindedPath to
InvalidNodeKey, and unwrapError to UnknownOrigin. constructError and
wrapError now return Maybe ErrorPacket.
Diffstat:
6 files changed, 140 insertions(+), 107 deletions(-)
diff --git a/lib/Lightning/Protocol/BOLT4/Blinding.hs b/lib/Lightning/Protocol/BOLT4/Blinding.hs
@@ -167,13 +167,16 @@ nextPathKey !pubKey (SharedSecret !ss) = do
-- | Encrypt hop data with ChaCha20-Poly1305.
--
-- Uses rho key and 12-byte zero nonce, empty AAD.
-encryptHopData :: DerivedKey -> BlindedHopData -> BS.ByteString
+--
+-- Returns 'Nothing' if encryption fails (e.g. the key is not 32
+-- bytes).
+encryptHopData :: DerivedKey -> BlindedHopData -> Maybe 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 e -> error $ "encryptHopData: unexpected AEAD error: " ++ show e
- Right (!ciphertext, !mac) -> ciphertext <> mac
+ Left _ -> Nothing
+ Right (!ciphertext, !mac) -> Just (ciphertext <> mac)
{-# INLINE encryptHopData #-}
-- | Decrypt hop data with ChaCha20-Poly1305.
@@ -341,8 +344,9 @@ processHops !eKey !ePub ((nodePub, hopData) : rest) !idx = do
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
+ encData <- maybe (Left (InvalidNodeKey idx)) Right
+ (encryptHopData rho hopData)
+ let !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)
diff --git a/lib/Lightning/Protocol/BOLT4/Construct.hs b/lib/Lightning/Protocol/BOLT4/Construct.hs
@@ -81,20 +81,23 @@ construct !sessionKey !hops !assocData
if totalSize > hopPayloadsSize
then Left (PayloadTooLarge totalSize)
else do
- -- Generate filler using secrets for all but final hop
+ -- Generate each hop's rho stream (2 * 1300 bytes)
+ rhoStreams <- traverse rhoStream (zip [0 ..] secrets)
+
+ -- Generate filler using streams for all but final hop
let numHops = length hops
- secretsExceptFinal = take (numHops - 1) secrets
+ streamsExceptFinal = take (numHops - 1) rhoStreams
sizesExceptFinal = take (numHops - 1) payloadSizes
- filler = generateFiller secretsExceptFinal sizesExceptFinal
+ filler = generateFiller streamsExceptFinal sizesExceptFinal
-- Initialize hop_payloads with deterministic padding
- let DerivedKey padKey = derivePad (SharedSecret sessionKey)
- initialPayloads = generateStream (DerivedKey padKey)
- hopPayloadsSize
+ initialPayloads <- maybe (Left InvalidSessionKey) Right
+ (generateStream (derivePad (SharedSecret sessionKey))
+ hopPayloadsSize)
-- Wrap payloads in reverse order (final hop first)
- let (finalPayloads, finalHmac) = wrapAllHops
- secrets payloadBytes filler assocData initialPayloads
+ let (finalPayloads, finalHmac) = wrapAllHops secrets
+ rhoStreams payloadBytes filler assocData initialPayloads
-- Build the final packet
let ephPubBytes = Secp256k1.serialize_point ephPub
@@ -106,6 +109,9 @@ construct !sessionKey !hops !assocData
}
Right (packet, secrets)
+ where
+ rhoStream (i, ss) = maybe (Left (InvalidHopPubKey i)) Right
+ (generateStream (deriveRho ss) (2 * hopPayloadsSize))
-- | Compute the total shift size for a payload.
payloadShiftSize :: BS.ByteString -> Int
@@ -134,24 +140,22 @@ computeAllSecrets !initSec !initPub = go initSec initPub 0 []
(blindPubKey ephPub bf)
go newEphSec newEphPub (idx + 1) (ss : acc) rest
--- | Generate filler bytes.
+-- | Generate filler bytes from the hops' 2600-byte rho streams.
--
-- At each hop the filler, extended by that hop's shift size, is XORed
-- with the hop's rho stream starting at 1300 minus the length of the
-- filler before extension.
-generateFiller :: [SharedSecret] -> [Int] -> BS.ByteString
-generateFiller !secrets !sizes = go BS.empty secrets sizes
+generateFiller :: [BS.ByteString] -> [Int] -> BS.ByteString
+generateFiller !streams !sizes = go BS.empty streams sizes
where
go !filler [] [] = filler
- go !filler (ss:sss) (sz:szs) =
+ go !filler (stream:sts) (sz:szs) =
let !extended = filler <> BS.replicate sz 0
- !rhoKey = deriveRho ss
- !stream = generateStream rhoKey (2 * hopPayloadsSize)
!streamOffset = hopPayloadsSize - BS.length filler
!streamPart = BS.take (BS.length extended)
(BS.drop streamOffset stream)
!newFiller = xorBytes extended streamPart
- in go newFiller sss szs
+ in go newFiller sts szs
go !filler _ _ = filler
{-# INLINE generateFiller #-}
@@ -159,26 +163,28 @@ generateFiller !secrets !sizes = go BS.empty secrets sizes
wrapAllHops
:: [SharedSecret]
-> [BS.ByteString]
+ -> [BS.ByteString]
-> BS.ByteString
-> BS.ByteString
-> BS.ByteString
-> (BS.ByteString, BS.ByteString)
-wrapAllHops !secrets !payloads !filler !assocData !initPayloads =
- let !paired = reverse (zip secrets payloads)
+wrapAllHops !secrets !streams !payloads !filler !assocData !initPayloads =
+ let !paired = reverse (zip3 secrets streams payloads)
!numHops = length paired
!initHmac = BS.replicate hmacSize 0
in go numHops initPayloads initHmac paired
where
go !_ !hpBuf !hmac [] = (hpBuf, hmac)
- go !remaining !hpBuf !hmac ((ss, payload):rest) =
+ go !remaining !hpBuf !hmac ((ss, stream, payload):rest) =
let !isLastHop = remaining ==
length (reverse (zip secrets payloads))
(!newPayloads, !newHmac) =
- wrapHop ss payload hmac hpBuf
+ wrapHop ss stream payload hmac hpBuf
assocData filler isLastHop
in go (remaining - 1) newPayloads newHmac rest
--- | Wrap a single hop's payload.
+-- | Wrap a single hop's payload, given its shared secret and rho
+-- stream.
wrapHop
:: SharedSecret
-> BS.ByteString
@@ -186,17 +192,16 @@ wrapHop
-> BS.ByteString
-> BS.ByteString
-> BS.ByteString
+ -> BS.ByteString
-> Bool
-> (BS.ByteString, BS.ByteString)
-wrapHop !ss !payload !hmac !hpBuf !assocData !filler !isFinalHop =
+wrapHop !ss !stream !payload !hmac !hpBuf !assocData !filler !isFinalHop =
let !payloadLen = BS.length payload
!lenBytes = encodeBigSize (fromIntegral payloadLen)
!shiftSize = BS.length lenBytes + payloadLen + hmacSize
!shifted = BS.take (hopPayloadsSize - shiftSize) hpBuf
!prepended = lenBytes <> payload <> hmac <> shifted
- !rhoKey = deriveRho ss
- !stream = generateStream rhoKey hopPayloadsSize
- !obfuscated = xorBytes prepended stream
+ !obfuscated = xorBytes prepended (BS.take hopPayloadsSize stream)
!withFiller = if isFinalHop && not (BS.null filler)
then applyFiller obfuscated filler
else obfuscated
diff --git a/lib/Lightning/Protocol/BOLT4/Error.hs b/lib/Lightning/Protocol/BOLT4/Error.hs
@@ -65,29 +65,31 @@ minErrorPacketSize = 256
--
-- Takes the shared secret (from processing) and failure message,
-- and wraps it for return to origin.
+--
+-- Returns 'Nothing' if the obfuscation stream cannot be generated.
constructError
:: SharedSecret -- ^ from packet processing
-> FailureMessage -- ^ failure details
- -> ErrorPacket
-constructError !ss !failure =
+ -> Maybe ErrorPacket
+constructError !ss !failure = do
let !um = deriveUm ss
!ammag = deriveAmmag ss
!inner = buildErrorMessage um failure
- !obfuscated = obfuscateError ammag inner
- in ErrorPacket obfuscated
+ ErrorPacket <$> obfuscateError ammag inner
{-# INLINE constructError #-}
-- | Wrap an existing error packet for forwarding back.
--
-- Each intermediate node wraps the error with its own layer.
+--
+-- Returns 'Nothing' if the obfuscation stream cannot be generated.
wrapError
:: SharedSecret -- ^ this node's shared secret
-> ErrorPacket -- ^ error from downstream
- -> ErrorPacket
+ -> Maybe ErrorPacket
wrapError !ss (ErrorPacket !packet) =
let !ammag = deriveAmmag ss
- !wrapped = obfuscateError ammag packet
- in ErrorPacket wrapped
+ in ErrorPacket <$> obfuscateError ammag packet
{-# INLINE wrapError #-}
-- Error unwrapping -----------------------------------------------------------
@@ -109,12 +111,14 @@ unwrapError secrets (ErrorPacket !initialPacket) = go 0 initialPacket secrets
go !idx !packet (ss:rest) =
let !ammag = deriveAmmag ss
!um = deriveUm ss
- !deobfuscated = deobfuscateError ammag packet
- in if verifyErrorHmac um deobfuscated
- then case parseErrorMessage (BS.drop 32 deobfuscated) of
- Just msg -> Attributed idx msg
- Nothing -> UnknownOrigin deobfuscated
- else go (idx + 1) deobfuscated rest
+ in case deobfuscateError ammag packet of
+ Nothing -> UnknownOrigin packet
+ Just deobfuscated
+ | verifyErrorHmac um deobfuscated ->
+ case parseErrorMessage (BS.drop 32 deobfuscated) of
+ Just msg -> Attributed idx msg
+ Nothing -> UnknownOrigin deobfuscated
+ | otherwise -> go (idx + 1) deobfuscated rest
-- Internal functions ---------------------------------------------------------
@@ -148,21 +152,21 @@ buildErrorMessage (DerivedKey !umKey) !failure =
--
-- XORs the entire packet with pseudo-random stream.
obfuscateError
- :: DerivedKey -- ^ ammag key
- -> BS.ByteString -- ^ error packet
- -> BS.ByteString -- ^ obfuscated packet
-obfuscateError !ammag !packet =
- let !stream = generateStream ammag (BS.length packet)
- in xorBytes packet stream
+ :: DerivedKey -- ^ ammag key
+ -> BS.ByteString -- ^ error packet
+ -> Maybe BS.ByteString -- ^ obfuscated packet
+obfuscateError !ammag !packet = do
+ stream <- generateStream ammag (BS.length packet)
+ pure $! xorBytes packet stream
{-# INLINE obfuscateError #-}
-- | Remove one layer of obfuscation from error packet.
--
-- XOR is its own inverse, so same as obfuscation.
deobfuscateError
- :: DerivedKey -- ^ ammag key
- -> BS.ByteString -- ^ obfuscated packet
- -> BS.ByteString -- ^ deobfuscated packet
+ :: DerivedKey -- ^ ammag key
+ -> BS.ByteString -- ^ obfuscated packet
+ -> Maybe BS.ByteString -- ^ deobfuscated packet
deobfuscateError = obfuscateError
{-# INLINE deobfuscateError #-}
diff --git a/lib/Lightning/Protocol/BOLT4/Prim.hs b/lib/Lightning/Protocol/BOLT4/Prim.hs
@@ -183,14 +183,16 @@ blindSecKey !secBs (BlindingFactor !bf)
--
-- Uses derived key as ChaCha20 key, 96-bit zero nonce, counter=0.
-- Encrypts zeros to produce keystream.
+--
+-- Returns 'Nothing' if ChaCha20 fails (e.g. the key is not 32 bytes).
generateStream
:: DerivedKey -- ^ rho or ammag key
-> Int -- ^ desired length
- -> BS.ByteString
+ -> Maybe BS.ByteString
generateStream (DerivedKey !key) !len =
let !nonce = BS.replicate 12 0
!zeros = BS.replicate len 0
- in either (const (BS.replicate len 0)) id
+ in either (const Nothing) Just
(ChaCha.cipher key (0 :: Word32) nonce zeros)
{-# INLINE generateStream #-}
diff --git a/lib/Lightning/Protocol/BOLT4/Process.hs b/lib/Lightning/Protocol/BOLT4/Process.hs
@@ -71,8 +71,10 @@ process !secKey !packet !assocData = do
else pure ()
-- Step 6: Decrypt hop payloads
- let !decrypted = decryptPayloads rhoKey
- (unHopPayloads (opHopPayloads packet))
+ decrypted <- case decryptPayloads rhoKey
+ (unHopPayloads (opHopPayloads packet)) of
+ Nothing -> Left InvalidEphemeralKey
+ Just d -> Right d
-- Step 7: Extract payload
(payloadBytes, nextHmac, remaining) <-
@@ -126,13 +128,14 @@ parseEphemeralKey !packet =
decryptPayloads
:: DerivedKey -- ^ rho key
-> BS.ByteString -- ^ hop_payloads (1300 bytes)
- -> BS.ByteString -- ^ decrypted (2600 bytes, first 1300 useful)
-decryptPayloads !rhoKey !payloads =
+ -> Maybe BS.ByteString
+ -- ^ decrypted (2600 bytes, first 1300 useful)
+decryptPayloads !rhoKey !payloads = do
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
+ stream <- generateStream rhoKey streamLen
+ -- Extend payloads with zeros for the shift operation
+ let !extended = payloads <> BS.replicate hopPayloadsSize 0
+ pure $! xorBytes stream extended
{-# INLINE decryptPayloads #-}
-- | XOR two bytestrings of equal length.
diff --git a/test/Main.hs b/test/Main.hs
@@ -2,6 +2,7 @@
module Main where
+import Control.Monad (foldM)
import Data.Bits (xor)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
@@ -404,17 +405,17 @@ testGenerateStream :: TestTree
testGenerateStream = testGroup "generateStream" [
testCase "produces correct length" $ do
let dk = DerivedKey (BS.replicate 32 0)
- stream = generateStream dk 100
- BS.length stream @?= 100
+ fmap BS.length (generateStream dk 100) @?= Just 100
, testCase "1300-byte stream for hop_payloads" $ do
let dk = DerivedKey (BS.replicate 32 0x42)
- stream = generateStream dk 1300
- BS.length stream @?= 1300
+ fmap BS.length (generateStream dk 1300) @?= Just 1300
, testCase "deterministic output" $ do
let dk = DerivedKey (BS.replicate 32 0x55)
stream1 = generateStream dk 64
stream2 = generateStream dk 64
stream1 @?= stream2
+ , testCase "fails on a key that is not 32 bytes" $
+ generateStream (DerivedKey "short") 16 @?= Nothing
]
testHmacOperations :: TestTree
@@ -745,9 +746,9 @@ testProcessBasic = testGroup "basic processing" [
rawPayloads = payloadWithHmac <> padding
ss <- demand "computeSharedSecret" $
computeSharedSecret sessionKey hop0PubKey
- let rhoKey = deriveRho ss
- muKey = deriveMu ss
- stream = generateStream rhoKey 1300
+ stream <- demand "generateStream" $
+ generateStream (deriveRho ss) 1300
+ let muKey = deriveMu ss
encryptedPayloads =
BS.pack (BS.zipWith xor rawPayloads stream)
correctHmac =
@@ -779,8 +780,9 @@ mkPacket plain = do
pub <- demand "derive_pub"
(Secp256k1.roll32 sessionKey >>= Secp256k1.derive_pub)
ss <- demand "computeSharedSecret" (computeSharedSecret sessionKey pub)
- let stream = generateStream (deriveRho ss) hopPayloadsSize
- enc = BS.pack (BS.zipWith xor plain stream)
+ stream <- demand "generateStream" $
+ generateStream (deriveRho ss) hopPayloadsSize
+ let enc = BS.pack (BS.zipWith xor plain stream)
mac = computeHmac (deriveMu ss) enc BS.empty
hp <- demand "hopPayloads" (hopPayloads enc)
hm <- demand "hmac32" (hmac32 mac)
@@ -884,11 +886,19 @@ u16At off bs = case BS.unpack (BS.take 2 (BS.drop off bs)) of
[hi, lo] -> pure (fromIntegral hi * 256 + fromIntegral lo)
_ -> assertFailure "u16At: input too short"
+-- | 'constructError', failing the test on Nothing.
+mkError :: SharedSecret -> FailureMessage -> IO ErrorPacket
+mkError ss fm = demand "constructError" (constructError ss fm)
+
+-- | 'wrapError', failing the test on Nothing.
+wrapErr :: SharedSecret -> ErrorPacket -> IO ErrorPacket
+wrapErr ss pkt = demand "wrapError" (wrapError ss pkt)
+
-- | Strip the failing node's obfuscation from a return packet and
-- return (failure_len, pad_len, packet length).
returnPacketLengths :: SharedSecret -> ErrorPacket -> IO (Int, Int, Int)
returnPacketLengths ss pkt = do
- let ErrorPacket raw = wrapError ss pkt
+ ErrorPacket raw <- wrapErr ss pkt
failureLen <- u16At 32 raw
padLen <- u16At (34 + failureLen) raw
pure (failureLen, padLen, BS.length raw)
@@ -897,7 +907,7 @@ testErrorConstruction :: TestTree
testErrorConstruction = testGroup "error packet construction" [
testCase "short message is padded to 256" $ do
let failure = FailureMessage TemporaryNodeFailure BS.empty []
- errPacket = constructError testSecret1 failure
+ errPacket <- mkError testSecret1 failure
(fl, pl, size) <- returnPacketLengths testSecret1 errPacket
fl @?= 2
fl + pl @?= minErrorPacketSize
@@ -905,7 +915,7 @@ testErrorConstruction = testGroup "error packet construction" [
, testCase "long message is not truncated or padded" $ do
let failure = FailureMessage TemporaryNodeFailure BS.empty
[TlvRecord 1 (BS.replicate 300 0x00)]
- errPacket = constructError testSecret1 failure
+ errPacket <- mkError testSecret1 failure
(fl, pl, size) <- returnPacketLengths testSecret1 errPacket
fl @?= 2 + 1 + 3 + 300
pl @?= 0
@@ -915,8 +925,8 @@ testErrorConstruction = testGroup "error packet construction" [
testErrorRoundtrip :: TestTree
testErrorRoundtrip =
testCase "construct and unwrap roundtrip" $ do
- let errPacket = constructError testSecret1 testFailure
- result = unwrapError [testSecret1] errPacket
+ errPacket <- mkError testSecret1 testFailure
+ let result = unwrapError [testSecret1] errPacket
case result of
Attributed idx msg -> do
idx @?= 0
@@ -930,10 +940,10 @@ testMultiHopWrapping = testGroup "multi-hop wrapping" [
testCase "3-hop route, error from hop 2 (final)" $ do
let secrets =
[testSecret1, testSecret2, testSecret3]
- err0 = constructError testSecret3 testFailure
- err1 = wrapError testSecret2 err0
- err2 = wrapError testSecret1 err1
- result = unwrapError secrets err2
+ err0 <- mkError testSecret3 testFailure
+ err1 <- wrapErr testSecret2 err0
+ err2 <- wrapErr testSecret1 err1
+ let result = unwrapError secrets err2
case result of
Attributed idx msg -> do
idx @?= 2
@@ -945,9 +955,9 @@ testMultiHopWrapping = testGroup "multi-hop wrapping" [
, testCase "4-hop route, error from hop 1" $ do
let secrets = [testSecret1, testSecret2,
testSecret3, testSecret4]
- err0 = constructError testSecret2 testFailure
- err1 = wrapError testSecret1 err0
- result = unwrapError secrets err1
+ err0 <- mkError testSecret2 testFailure
+ err1 <- wrapErr testSecret1 err0
+ let result = unwrapError secrets err1
case result of
Attributed idx msg -> do
idx @?= 1
@@ -959,8 +969,8 @@ testMultiHopWrapping = testGroup "multi-hop wrapping" [
, testCase "4-hop route, error from hop 0 (first)" $ do
let secrets = [testSecret1, testSecret2,
testSecret3, testSecret4]
- err0 = constructError testSecret1 testFailure
- result = unwrapError secrets err0
+ err0 <- mkError testSecret1 testFailure
+ let result = unwrapError secrets err0
case result of
Attributed idx msg -> do
idx @?= 0
@@ -973,8 +983,8 @@ testMultiHopWrapping = testGroup "multi-hop wrapping" [
testErrorAttribution :: TestTree
testErrorAttribution = testGroup "error attribution" [
testCase "wrong secrets gives UnknownOrigin" $ do
- let err = constructError testSecret1 testFailure
- wrongSecrets = [testSecret2, testSecret3]
+ err <- mkError testSecret1 testFailure
+ let wrongSecrets = [testSecret2, testSecret3]
result = unwrapError wrongSecrets err
case result of
UnknownOrigin _ -> return ()
@@ -983,8 +993,8 @@ testErrorAttribution = testGroup "error attribution" [
"Expected UnknownOrigin with wrong secrets"
, testCase "empty secrets gives UnknownOrigin" $ do
- let err = constructError testSecret1 testFailure
- result = unwrapError [] err
+ err <- mkError testSecret1 testFailure
+ let result = unwrapError [] err
case result of
UnknownOrigin _ -> return ()
Attributed _ _ ->
@@ -999,8 +1009,8 @@ testErrorAttribution = testGroup "error attribution" [
]
mapM_ (\(code, secret) -> do
let failure = FailureMessage code (failureData code) []
- err = constructError secret failure
- result = unwrapError [secret] err
+ err <- mkError secret failure
+ let result = unwrapError [secret] err
case result of
Attributed 0 msg -> fmCode msg @?= code
_ -> assertFailure $
@@ -1015,8 +1025,8 @@ testFailureMessageParsing =
let failData = BS.pack [0, 0, 0, 0, 0, 0, 0x03, 0xe8, 0, 0]
failure =
FailureMessage AmountBelowMinimum failData []
- err = constructError testSecret1 failure
- result = unwrapError [testSecret1] err
+ err <- mkError testSecret1 failure
+ let result = unwrapError [testSecret1] err
case result of
Attributed 0 msg -> do
fmCode msg @?= AmountBelowMinimum
@@ -1034,8 +1044,8 @@ testFailureMessageParsing =
]
mapM_ (\code -> do
let failure = FailureMessage code (failureData code) []
- err = constructError testSecret1 failure
- result = unwrapError [testSecret1] err
+ err <- mkError testSecret1 failure
+ let result = unwrapError [testSecret1] err
case result of
Attributed 0 msg -> fmCode msg @?= code
_ -> assertFailure $
@@ -1302,30 +1312,33 @@ 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
+ encrypted <- demand "encryptHopData" $
+ encryptHopData rho sampleHopData
+ decryptHopData rho encrypted @?= Just sampleHopData
, testCase "roundtrip: empty hop data" $ do
let rho = deriveBlindingRho testSharedSecretBS
- encrypted = encryptHopData rho emptyHopData
- decrypted = decryptHopData rho encrypted
- decrypted @?= Just emptyHopData
+ encrypted <- demand "encryptHopData" $
+ encryptHopData rho emptyHopData
+ decryptHopData rho encrypted @?= 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
+ encrypted <- demand "encryptHopData" $
+ encryptHopData rho1 sampleHopData
assertBool "decryption should fail or produce garbage"
- (decrypted /= Just sampleHopData)
+ (decryptHopData rho2 encrypted /= Just sampleHopData)
, testCase "encrypt is deterministic" $ do
let rho = deriveBlindingRho testSharedSecretBS
encrypted1 = encryptHopData rho sampleHopData
encrypted2 = encryptHopData rho sampleHopData
encrypted1 @?= encrypted2
+
+ , testCase "encrypt fails on a key that is not 32 bytes" $
+ encryptHopData (DerivedKey "short") sampleHopData @?= Nothing
]
-- 5. createBlindedPath Tests ----------------------------------------------
@@ -1891,14 +1904,15 @@ errorVectorTests = testGroup "onion-error-test.json" [
fm @?= FailureMessage TemporaryNodeFailure BS.empty []
encodeFailureMessage fm @?= msg
-- removing hop 4's own obfuscation leaves hmac || payload
- let ErrorPacket raw = wrapError ss4 (constructError ss4 fm)
+ ErrorPacket raw <- mkError ss4 fm >>= wrapErr ss4
BS.drop 32 raw @?= payload
, testCase "wrapping at each hop yields the spec packet" $ do
(ss4, wrappers) <- errorWrappers
expected <- unhex V.errPacket
let fm = FailureMessage TemporaryNodeFailure BS.empty []
- final = foldl (flip wrapError) (constructError ss4 fm) wrappers
+ initial <- mkError ss4 fm
+ final <- foldM (flip wrapErr) initial wrappers
final @?= ErrorPacket expected
, testCase "origin attributes the spec packet to hop 4" $ do
@@ -1936,8 +1950,9 @@ traceVectorTests = testGroup "returning errors trace" [
expected <- mapM unhex
[ V.tracePacket4, V.tracePacket3, V.tracePacket2
, V.tracePacket1, V.tracePacket0 ]
- let packets = drop 1 $
- scanl (flip wrapError) (ErrorPacket raw) (ss4 : wrappers)
+ packets <- demand "wrapError" $ sequence $ drop 1 $
+ scanl (\p ss -> p >>= wrapError ss) (Just (ErrorPacket raw))
+ (ss4 : wrappers)
packets @?= map ErrorPacket expected
, testCase "origin attributes the trace packet to hop 4" $ do
