commit af22e72c4b9258f4ec5f48af5c9bc4bf5260cdfb
parent 98b9bbba12f72665f6bed7575a571fd4a9b37a40
Author: Jared Tobin <jared@jtobin.io>
Date: Sun, 25 Jan 2026 11:16:54 +0400
fix: address review findings for IMPL3
Review: REVIEW-98b9bbba.md
- Add decodeEnvelopeWith for configurable extension TLV handling
Allows callers to specify which extension TLV types are known,
enabling future support for negotiated even extension types.
- Add payload size check in encodeMessage (max 65533 bytes)
Ensures payloads cannot exceed the message limit even when
encodeMessage is used directly without encodeEnvelope.
- Document unhex test helper partiality
Clarify that error usage is intentional for test-only code
where hex literals are known-valid constants.
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
Diffstat:
4 files changed, 78 insertions(+), 18 deletions(-)
diff --git a/lib/Lightning/Protocol/BOLT1.hs b/lib/Lightning/Protocol/BOLT1.hs
@@ -52,6 +52,7 @@ module Lightning.Protocol.BOLT1 (
, DecodeError(..)
, decodeMessage
, decodeEnvelope
+ , decodeEnvelopeWith
-- * Primitive encoding
, encodeU16
diff --git a/lib/Lightning/Protocol/BOLT1/Codec.hs b/lib/Lightning/Protocol/BOLT1/Codec.hs
@@ -40,12 +40,13 @@ module Lightning.Protocol.BOLT1.Codec (
, decodePeerStorageRetrieval
, decodeMessage
, decodeEnvelope
+ , decodeEnvelopeWith
) where
import Control.DeepSeq (NFData)
import Control.Monad (when, unless)
import qualified Data.ByteString as BS
-import Data.Word (Word16)
+import Data.Word (Word16, Word64)
import GHC.Generics (Generic)
import Lightning.Protocol.BOLT1.Prim
import Lightning.Protocol.BOLT1.TLV
@@ -114,15 +115,23 @@ encodePeerStorageRetrieval (PeerStorageRetrieval blob) = do
Right $ mconcat [blobLen, blob]
-- | Encode a message to its payload bytes.
+--
+-- Checks that the payload does not exceed 65533 bytes (the maximum
+-- possible given the 2-byte type field and 65535-byte message limit).
encodeMessage :: Message -> Either EncodeError BS.ByteString
-encodeMessage = \case
- MsgInitVal m -> encodeInit m
- MsgErrorVal m -> encodeError m
- MsgWarningVal m -> encodeWarning m
- MsgPingVal m -> encodePing m
- MsgPongVal m -> encodePong m
- MsgPeerStorageVal m -> encodePeerStorage m
- MsgPeerStorageRetrievalVal m -> encodePeerStorageRetrieval m
+encodeMessage msg = do
+ payload <- case msg of
+ MsgInitVal m -> encodeInit m
+ MsgErrorVal m -> encodeError m
+ MsgWarningVal m -> encodeWarning m
+ MsgPingVal m -> encodePing m
+ MsgPongVal m -> encodePong m
+ MsgPeerStorageVal m -> encodePeerStorage m
+ MsgPeerStorageRetrievalVal m -> encodePeerStorageRetrieval m
+ -- Payload must leave room for 2-byte type (max 65533 bytes)
+ when (BS.length payload > 65533) $
+ Left EncodeMessageTooLarge
+ Right payload
-- | Encode a message as a complete envelope (type + payload + extension).
--
@@ -296,11 +305,30 @@ decodeMessage (MsgUnknown w) _
-- - Unknown even message types cause connection close (returns error)
-- - Invalid extension TLV causes connection close (returns error)
--
+-- This uses the default policy of treating all extension TLV types as
+-- unknown. Use 'decodeEnvelopeWith' for configurable extension handling.
+--
-- Returns the decoded message (if known) and any extension TLVs.
decodeEnvelope
:: BS.ByteString
-> Either DecodeError (Maybe Message, Maybe TlvStream)
-decodeEnvelope !bs = do
+decodeEnvelope = decodeEnvelopeWith (const False)
+
+-- | Decode a complete envelope with configurable extension TLV handling.
+--
+-- The predicate determines which extension TLV types are "known" and
+-- should be preserved. Unknown even types cause failure; unknown odd
+-- types are skipped.
+--
+-- Use @decodeEnvelopeWith (const False)@ to reject all even extension
+-- types (the default behavior of 'decodeEnvelope').
+--
+-- Use @decodeEnvelopeWith (const True)@ to accept all extension types.
+decodeEnvelopeWith
+ :: (Word64 -> Bool) -- ^ Predicate: is this extension TLV type known?
+ -> BS.ByteString
+ -> Either DecodeError (Maybe Message, Maybe TlvStream)
+decodeEnvelopeWith isKnownExt !bs = do
(typeWord, rest1) <- maybe (Left DecodeInsufficientBytes) Right
(decodeU16 bs)
let !msgType = parseMsgType typeWord
@@ -311,10 +339,9 @@ decodeEnvelope !bs = do
_ -> do
(msg, rest2) <- decodeMessage msgType rest1
-- Parse any remaining bytes as extension TLV
- -- Per BOLT #1: unknown even types must fail, unknown odd are ignored
ext <- if BS.null rest2
then Right Nothing
- else case decodeTlvStreamWith (const False) rest2 of
+ else case decodeTlvStreamWith isKnownExt rest2 of
Left e -> Left (DecodeInvalidExtension e)
Right s -> Right (Just s)
Right (Just msg, ext)
diff --git a/plans/REVIEW-98b9bbba.md b/plans/REVIEW-98b9bbba.md
@@ -0,0 +1,32 @@
+# Review: 98b9bbba
+
+## Findings (ordered by severity)
+
+- Medium: `decodeEnvelope` hard-codes `decodeTlvStreamWith (const False)`, so
+ every even TLV type in extensions is treated as unknown and rejected. This
+ makes it impossible to accept negotiated/known even extension TLVs in the
+ future, and forces odd TLVs to be discarded even if a caller wants to
+ preserve them. Consider a `decodeEnvelopeWith` that accepts an `isKnown`
+ predicate (or returns raw extension bytes) to make extension handling
+ configurable.
+ (`lib/Lightning/Protocol/BOLT1/Codec.hs:300-320`)
+
+- Low: `encodeMessage` can emit payloads that exceed the 65535 total message
+ limit; only `encodeEnvelope` checks size. Since `encodeMessage` is exported,
+ callers could bypass the limit unintentionally. If you want the API to enforce
+ the spec by default, consider a size check there too.
+ (`lib/Lightning/Protocol/BOLT1/Codec.hs:110-156`)
+
+- Low: Tests still use `error` via `assertFailure'`, which is a partial failure
+ path (even if only in tests). If you want to keep the “avoid partials”
+ discipline, replace with `assertFailure` in an IO context or a total helper.
+ (`test/Main.hs:356-362`)
+
+## Open questions
+
+- Should extension TLVs be configurable at the API boundary (predicate for
+ known types), or should the library always reject all even extension types
+ until specific ones are modeled?
+- Should `encodeMessage` enforce the total size limit, or should size
+ validation be strictly an envelope concern?
+
diff --git a/test/Main.hs b/test/Main.hs
@@ -645,12 +645,12 @@ property_tests = testGroup "Properties" [
-- Helpers ---------------------------------------------------------------------
--- | Decode hex string. Fails the test on invalid hex.
+-- | Decode hex string (test-only helper).
+--
+-- Uses 'error' for invalid hex since all hex literals in tests are
+-- known-valid compile-time constants. This is acceptable in test code
+-- where the failure would indicate a bug in the test itself.
unhex :: BS.ByteString -> BS.ByteString
unhex bs = case B16.decode bs of
Just r -> r
- Nothing -> assertFailure' $ "invalid hex: " ++ show bs
-
--- | assertFailure that returns any type (for use in pure contexts)
-assertFailure' :: String -> a
-assertFailure' msg = error msg
+ Nothing -> error $ "unhex: invalid hex literal: " ++ show bs
