commit 56d36474ebb995931313bf1dc4bdd2a3f84db799
parent 779bf5c0d8de70c80aaa2bc8b9ee3430f768c15a
Author: Jared Tobin <jared@jtobin.io>
Date: Sun, 25 Jan 2026 11:30:37 +0400
Address REVIEW1.md findings
Types.hs:
- Add Secret newtype (32-byte per-commitment secret) with smart constructor
Messages.hs:
- RevokeAndAck.revokeAndAckPerCommitmentSecret now uses Secret
- ChannelReestablish.channelReestablishYourLastCommitSecret now uses Secret
Codec.hs:
- Add encodeU16BytesE (bounds-checked u16-prefixed encoding)
- Add checkListCountU16 (bounds-checked list count)
- Add decodeSecretBytes, DecodeInvalidSecret error
- encodeTxAddInput, encodeTxAddOutput, encodeTxSignatures, encodeTxAbort,
encodeUpdateFailHtlc, encodeCommitmentSigned now return Either EncodeError
- Remove unused encodeU16Bytes and decodeBytesE
test/Main.hs:
- Update tests for Either-returning encoders
- Update tests to use Secret type
- Fix unhex to return Maybe (total function)
bench/Main.hs:
- Update for Either-returning encoders
CLAUDE.md, AGENTS.md:
- Add directive to record design decisions to plans/TODO
plans/:
- Add TODO with outstanding design decisions (TLV unknown-even rule,
flake dependency path)
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
Diffstat:
11 files changed, 500 insertions(+), 143 deletions(-)
diff --git a/AGENTS.md b/AGENTS.md
@@ -134,6 +134,7 @@ When planning work:
- Consider forking subagents for concurrent work on independent steps
- Write implementation plans to `plans/IMPL<n>.md` if the project uses
this convention
+- Record outstanding design decisions and deferred work to `plans/TODO`
## Flake Structure
diff --git a/CLAUDE.md b/CLAUDE.md
@@ -134,6 +134,7 @@ When planning work:
- Consider forking subagents for concurrent work on independent steps
- Write implementation plans to `plans/IMPL<n>.md` if the project uses
this convention
+- Record outstanding design decisions and deferred work to `plans/TODO`
## Flake Structure
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -158,7 +158,9 @@ testTxSignatures = TxSignatures
-- | Encoded TxSignatures for decode benchmarks.
encodedTxSignatures :: BS.ByteString
-encodedTxSignatures = encodeTxSignatures testTxSignatures
+encodedTxSignatures = case encodeTxSignatures testTxSignatures of
+ Right bs -> bs
+ Left e -> error $ "encodedTxSignatures: " ++ show e
{-# NOINLINE encodedTxSignatures #-}
-- Close messages --------------------------------------------------------------
@@ -209,7 +211,9 @@ testCommitmentSigned = CommitmentSigned
-- | Encoded CommitmentSigned for decode benchmarks.
encodedCommitmentSigned :: BS.ByteString
-encodedCommitmentSigned = encodeCommitmentSigned testCommitmentSigned
+encodedCommitmentSigned = case encodeCommitmentSigned testCommitmentSigned of
+ Right bs -> bs
+ Left e -> error $ "encodedCommitmentSigned: " ++ show e
{-# NOINLINE encodedCommitmentSigned #-}
-- Benchmark groups ------------------------------------------------------------
diff --git a/lib/Lightning/Protocol/BOLT2/Codec.hs b/lib/Lightning/Protocol/BOLT2/Codec.hs
@@ -126,6 +126,7 @@ data DecodeError
| DecodeInvalidPaymentHash
| DecodeInvalidPaymentPreimage
| DecodeInvalidOnionPacket
+ | DecodeInvalidSecret
| DecodeTlvError !TlvError
deriving stock (Eq, Show, Generic)
@@ -272,17 +273,29 @@ decodeOnionPacketBytes !bs = do
Right (op, rest)
{-# INLINE decodeOnionPacketBytes #-}
--- | Decode bytes using Either.
-decodeBytesE
- :: Int -> BS.ByteString -> Either DecodeError (BS.ByteString, BS.ByteString)
-decodeBytesE !n !bs = maybe (Left DecodeInsufficientBytes) Right
- (decodeBytes n bs)
-{-# INLINE decodeBytesE #-}
-
--- | Encode a u16-prefixed byte string.
-encodeU16Bytes :: BS.ByteString -> BS.ByteString
-encodeU16Bytes !bs = encodeU16 (fromIntegral (BS.length bs)) <> bs
-{-# INLINE encodeU16Bytes #-}
+-- | Decode a Secret (32 bytes).
+decodeSecretBytes
+ :: BS.ByteString -> Either DecodeError (Secret, BS.ByteString)
+decodeSecretBytes !bs = do
+ (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right
+ (decodeBytes secretLen bs)
+ sec <- maybe (Left DecodeInvalidSecret) Right (secret raw)
+ Right (sec, rest)
+{-# INLINE decodeSecretBytes #-}
+
+-- | Encode a u16-prefixed byte string with bounds checking.
+encodeU16BytesE :: BS.ByteString -> Either EncodeError BS.ByteString
+encodeU16BytesE !bs
+ | BS.length bs > 65535 = Left EncodeLengthOverflow
+ | otherwise = Right $! encodeU16 (fromIntegral (BS.length bs)) <> bs
+{-# INLINE encodeU16BytesE #-}
+
+-- | Check that a list count fits in u16.
+checkListCountU16 :: Int -> Either EncodeError Word16
+checkListCountU16 !n
+ | n > 65535 = Left EncodeLengthOverflow
+ | otherwise = Right $! fromIntegral n
+{-# INLINE checkListCountU16 #-}
-- | Decode a u16-prefixed byte string.
decodeU16Bytes
@@ -877,14 +890,16 @@ decodeAcceptChannel2 !bs = do
Right (msg, BS.empty)
-- | Encode a TxAddInput message (type 66).
-encodeTxAddInput :: TxAddInput -> BS.ByteString
-encodeTxAddInput !msg = mconcat
- [ unChannelId (txAddInputChannelId msg)
- , encodeU64 (txAddInputSerialId msg)
- , encodeU16Bytes (txAddInputPrevTx msg)
- , encodeU32 (txAddInputPrevVout msg)
- , encodeU32 (txAddInputSequence msg)
- ]
+encodeTxAddInput :: TxAddInput -> Either EncodeError BS.ByteString
+encodeTxAddInput !msg = do
+ prevTxEnc <- encodeU16BytesE (txAddInputPrevTx msg)
+ Right $! mconcat
+ [ unChannelId (txAddInputChannelId msg)
+ , encodeU64 (txAddInputSerialId msg)
+ , prevTxEnc
+ , encodeU32 (txAddInputPrevVout msg)
+ , encodeU32 (txAddInputSequence msg)
+ ]
-- | Decode a TxAddInput message (type 66).
decodeTxAddInput
@@ -906,13 +921,15 @@ decodeTxAddInput !bs = do
Right (msg, rest5)
-- | Encode a TxAddOutput message (type 67).
-encodeTxAddOutput :: TxAddOutput -> BS.ByteString
-encodeTxAddOutput !msg = mconcat
- [ unChannelId (txAddOutputChannelId msg)
- , encodeU64 (txAddOutputSerialId msg)
- , encodeU64 (unSatoshis (txAddOutputSats msg))
- , encodeU16Bytes (unScriptPubKey (txAddOutputScript msg))
- ]
+encodeTxAddOutput :: TxAddOutput -> Either EncodeError BS.ByteString
+encodeTxAddOutput !msg = do
+ scriptEnc <- encodeU16BytesE (unScriptPubKey (txAddOutputScript msg))
+ Right $! mconcat
+ [ unChannelId (txAddOutputChannelId msg)
+ , encodeU64 (txAddOutputSerialId msg)
+ , encodeU64 (unSatoshis (txAddOutputSats msg))
+ , scriptEnc
+ ]
-- | Decode a TxAddOutput message (type 67).
decodeTxAddOutput
@@ -983,9 +1000,9 @@ decodeTxComplete !bs = do
let !msg = TxComplete { txCompleteChannelId = cid }
Right (msg, rest)
--- | Encode a single witness.
-encodeWitness :: Witness -> BS.ByteString
-encodeWitness (Witness !wdata) = encodeU16Bytes wdata
+-- | Encode a single witness with bounds checking.
+encodeWitnessE :: Witness -> Either EncodeError BS.ByteString
+encodeWitnessE (Witness !wdata) = encodeU16BytesE wdata
-- | Decode a single witness.
decodeWitness :: BS.ByteString -> Either DecodeError (Witness, BS.ByteString)
@@ -994,15 +1011,16 @@ decodeWitness !bs = do
Right (Witness wdata, rest)
-- | Encode a TxSignatures message (type 71).
-encodeTxSignatures :: TxSignatures -> BS.ByteString
-encodeTxSignatures !msg =
+encodeTxSignatures :: TxSignatures -> Either EncodeError BS.ByteString
+encodeTxSignatures !msg = do
let !witnesses = txSignaturesWitnesses msg
- !numWit = fromIntegral (length witnesses) :: Word16
- in mconcat $
- [ unChannelId (txSignaturesChannelId msg)
- , unTxId (txSignaturesTxid msg)
- , encodeU16 numWit
- ] ++ map encodeWitness witnesses
+ numWit <- checkListCountU16 (length witnesses)
+ encodedWits <- traverse encodeWitnessE witnesses
+ Right $! mconcat $
+ [ unChannelId (txSignaturesChannelId msg)
+ , unTxId (txSignaturesTxid msg)
+ , encodeU16 numWit
+ ] ++ encodedWits
-- | Decode a TxSignatures message (type 71).
decodeTxSignatures
@@ -1072,11 +1090,13 @@ decodeTxAckRbf !bs = do
Right (msg, BS.empty)
-- | Encode a TxAbort message (type 74).
-encodeTxAbort :: TxAbort -> BS.ByteString
-encodeTxAbort !msg = mconcat
- [ unChannelId (txAbortChannelId msg)
- , encodeU16Bytes (txAbortData msg)
- ]
+encodeTxAbort :: TxAbort -> Either EncodeError BS.ByteString
+encodeTxAbort !msg = do
+ dataEnc <- encodeU16BytesE (txAbortData msg)
+ Right $! mconcat
+ [ unChannelId (txAbortChannelId msg)
+ , dataEnc
+ ]
-- | Decode a TxAbort message (type 74).
decodeTxAbort
@@ -1155,13 +1175,15 @@ decodeUpdateFulfillHtlc !bs = do
Right (msg, rest4)
-- | Encode an UpdateFailHtlc message (type 131).
-encodeUpdateFailHtlc :: UpdateFailHtlc -> BS.ByteString
-encodeUpdateFailHtlc !m = mconcat
- [ unChannelId (updateFailHtlcChannelId m)
- , encodeU64 (updateFailHtlcId m)
- , encodeU16Bytes (updateFailHtlcReason m)
- , encodeTlvStream (updateFailHtlcTlvs m)
- ]
+encodeUpdateFailHtlc :: UpdateFailHtlc -> Either EncodeError BS.ByteString
+encodeUpdateFailHtlc !m = do
+ reasonEnc <- encodeU16BytesE (updateFailHtlcReason m)
+ Right $! mconcat
+ [ unChannelId (updateFailHtlcChannelId m)
+ , encodeU64 (updateFailHtlcId m)
+ , reasonEnc
+ , encodeTlvStream (updateFailHtlcTlvs m)
+ ]
-- | Decode an UpdateFailHtlc message (type 131).
decodeUpdateFailHtlc
@@ -1207,15 +1229,15 @@ decodeUpdateFailMalformedHtlc !bs = do
Right (msg, rest4)
-- | Encode a CommitmentSigned message (type 132).
-encodeCommitmentSigned :: CommitmentSigned -> BS.ByteString
-encodeCommitmentSigned !m = mconcat $
- [ unChannelId (commitmentSignedChannelId m)
- , unSignature (commitmentSignedSignature m)
- , encodeU16 numHtlcs
- ] ++ map unSignature sigs
- where
- !sigs = commitmentSignedHtlcSignatures m
- !numHtlcs = fromIntegral (length sigs) :: Word16
+encodeCommitmentSigned :: CommitmentSigned -> Either EncodeError BS.ByteString
+encodeCommitmentSigned !m = do
+ let !sigs = commitmentSignedHtlcSignatures m
+ numHtlcs <- checkListCountU16 (length sigs)
+ Right $! mconcat $
+ [ unChannelId (commitmentSignedChannelId m)
+ , unSignature (commitmentSignedSignature m)
+ , encodeU16 numHtlcs
+ ] ++ map unSignature sigs
-- | Decode a CommitmentSigned message (type 132).
decodeCommitmentSigned
@@ -1247,7 +1269,7 @@ decodeCommitmentSigned !bs = do
encodeRevokeAndAck :: RevokeAndAck -> BS.ByteString
encodeRevokeAndAck !m = mconcat
[ unChannelId (revokeAndAckChannelId m)
- , revokeAndAckPerCommitmentSecret m
+ , unSecret (revokeAndAckPerCommitmentSecret m)
, unPoint (revokeAndAckNextPerCommitPoint m)
]
@@ -1256,11 +1278,11 @@ decodeRevokeAndAck
:: BS.ByteString -> Either DecodeError (RevokeAndAck, BS.ByteString)
decodeRevokeAndAck !bs = do
(cid, rest1) <- decodeChannelIdBytes bs
- (secret, rest2) <- decodeBytesE 32 rest1
+ (sec, rest2) <- decodeSecretBytes rest1
(nextPoint, rest3) <- decodePointBytes rest2
let !msg = RevokeAndAck
{ revokeAndAckChannelId = cid
- , revokeAndAckPerCommitmentSecret = secret
+ , revokeAndAckPerCommitmentSecret = sec
, revokeAndAckNextPerCommitPoint = nextPoint
}
Right (msg, rest3)
@@ -1292,7 +1314,7 @@ encodeChannelReestablish !m = mconcat
[ unChannelId (channelReestablishChannelId m)
, encodeU64 (channelReestablishNextCommitNum m)
, encodeU64 (channelReestablishNextRevocationNum m)
- , channelReestablishYourLastCommitSecret m
+ , unSecret (channelReestablishYourLastCommitSecret m)
, unPoint (channelReestablishMyCurrentCommitPoint m)
, encodeTlvStream (channelReestablishTlvs m)
]
@@ -1306,14 +1328,14 @@ decodeChannelReestablish !bs = do
(decodeU64 rest1)
(nextRevoke, rest3) <- maybe (Left DecodeInsufficientBytes) Right
(decodeU64 rest2)
- (lastSecret, rest4) <- decodeBytesE 32 rest3
+ (sec, rest4) <- decodeSecretBytes rest3
(myPoint, rest5) <- decodePointBytes rest4
(tlvs, rest6) <- decodeOptionalTlvs rest5
let !msg = ChannelReestablish
{ channelReestablishChannelId = cid
, channelReestablishNextCommitNum = nextCommit
, channelReestablishNextRevocationNum = nextRevoke
- , channelReestablishYourLastCommitSecret = lastSecret
+ , channelReestablishYourLastCommitSecret = sec
, channelReestablishMyCurrentCommitPoint = myPoint
, channelReestablishTlvs = tlvs
}
diff --git a/lib/Lightning/Protocol/BOLT2/Messages.hs b/lib/Lightning/Protocol/BOLT2/Messages.hs
@@ -526,7 +526,7 @@ instance NFData CommitmentSigned
-- of the commitment_signed.
data RevokeAndAck = RevokeAndAck
{ revokeAndAckChannelId :: !ChannelId
- , revokeAndAckPerCommitmentSecret :: !BS.ByteString
+ , revokeAndAckPerCommitmentSecret :: !Secret
, revokeAndAckNextPerCommitPoint :: !Point
} deriving stock (Eq, Show, Generic)
@@ -551,7 +551,7 @@ data ChannelReestablish = ChannelReestablish
{ channelReestablishChannelId :: !ChannelId
, channelReestablishNextCommitNum :: {-# UNPACK #-} !Word64
, channelReestablishNextRevocationNum :: {-# UNPACK #-} !Word64
- , channelReestablishYourLastCommitSecret :: !BS.ByteString
+ , channelReestablishYourLastCommitSecret :: !Secret
, channelReestablishMyCurrentCommitPoint :: !Point
, channelReestablishTlvs :: !TlvStream
} deriving stock (Eq, Show, Generic)
diff --git a/lib/Lightning/Protocol/BOLT2/Types.hs b/lib/Lightning/Protocol/BOLT2/Types.hs
@@ -40,6 +40,9 @@ module Lightning.Protocol.BOLT2.Types (
, PaymentPreimage
, paymentPreimage
, unPaymentPreimage
+ , Secret
+ , secret
+ , unSecret
-- * Transaction types
, TxId
@@ -78,6 +81,7 @@ module Lightning.Protocol.BOLT2.Types (
, paymentHashLen
, paymentPreimageLen
, onionPacketLen
+ , secretLen
) where
import Control.DeepSeq (NFData)
@@ -133,6 +137,11 @@ onionPacketLen :: Int
onionPacketLen = 1366
{-# INLINE onionPacketLen #-}
+-- | Length of a per-commitment secret in bytes (32).
+secretLen :: Int
+secretLen = 32
+{-# INLINE secretLen #-}
+
-- identifiers -----------------------------------------------------------------
-- | A 32-byte channel identifier.
@@ -290,6 +299,28 @@ unPaymentPreimage :: PaymentPreimage -> BS.ByteString
unPaymentPreimage (PaymentPreimage bs) = bs
{-# INLINE unPaymentPreimage #-}
+-- | A 32-byte per-commitment secret.
+--
+-- Used in revoke_and_ack and channel_reestablish messages to revoke
+-- old commitment transactions.
+newtype Secret = Secret BS.ByteString
+ deriving stock (Eq, Ord, Show, Generic)
+ deriving newtype NFData
+
+-- | Construct a 'Secret' from a 32-byte 'BS.ByteString'.
+--
+-- Returns 'Nothing' if the input is not exactly 32 bytes.
+secret :: BS.ByteString -> Maybe Secret
+secret !bs
+ | BS.length bs == secretLen = Just $! Secret bs
+ | otherwise = Nothing
+{-# INLINE secret #-}
+
+-- | Extract the underlying 'BS.ByteString' from a 'Secret'.
+unSecret :: Secret -> BS.ByteString
+unSecret (Secret bs) = bs
+{-# INLINE unSecret #-}
+
-- transaction types -----------------------------------------------------------
-- | A 32-byte transaction identifier.
diff --git a/plans/ARCH1.md b/plans/ARCH1.md
@@ -0,0 +1,109 @@
+# ARCH1: BOLT2 architecture
+
+Goal: implement the Lightning Network peer protocol (BOLT #2) with
+strong types, total decoding, and high performance, using only core and
+ppad libraries.
+
+## Scope
+
+- Messages defined in BOLT #2 (v1 and v2 channel establishment, close,
+ normal operation, reestablish).
+- Binary encoding/decoding of messages and TLVs.
+- Validation of message invariants at boundary.
+- Tests against spec vectors and property tests for roundtrips.
+- Benchmarks for encode/decode hot paths.
+
+Out of scope: wire transport, encryption, gossip, BOLT #3/7 logic.
+
+## Module layout (proposed)
+
+- `Lightning.Protocol.BOLT2`
+ - Public re-exports, type aliases, and high level API.
+- `Lightning.Protocol.BOLT2.Types`
+ - Newtypes and ADTs for identifiers, amounts, features, and message
+ payloads.
+- `Lightning.Protocol.BOLT2.Message`
+ - Sum type of all BOLT2 messages and message type tags.
+- `Lightning.Protocol.BOLT2.Codec`
+ - Encoding/decoding for each message and the top-level dispatcher.
+- `Lightning.Protocol.BOLT2.TLV`
+ - TLV stream types and known TLV records.
+- `Lightning.Protocol.BOLT2.Validation`
+ - Smart constructors and invariants for all public types.
+
+A module split keeps API clean and allows smaller, INLINE-friendly
+functions in the codec.
+
+## Types and invariants
+
+- Use newtypes for identifiers and amounts:
+ - `ChannelId`, `ShortChannelId`, `Satoshis`, `MilliSatoshis`,
+ `BlockHeight`, `FeeratePerKw`, `CsvDelay`, `HtlcId`, `CltvExpiry`.
+- Use fixed-size ByteString newtypes:
+ - `PubKey33`, `Signature64`, `Sha256`, `ChainHash32`.
+- Encode legal states in ADTs:
+ - `ShutdownScript` as a sum of allowed script forms.
+ - `CloseFee` either `CloseFeeProposed` or `CloseFeeNone` for v2 flow.
+- Smart constructors validate lengths and numeric bounds.
+
+All public constructors should be total, validated, and return
+`Either DecodeError a` or `Maybe a`.
+
+## Encoding and decoding
+
+- Use BOLT1 primitives (`encodeU16`, `decodeU16`, `encodeBigSize`, ...).
+- Provide `encodeMessage :: Message -> ByteString` and
+ `decodeMessage :: ByteString -> Either DecodeError Message`.
+- Dispatch on message type tag; for known tags, parse body strictly.
+- Keep parsers total; never throw exceptions; return `DecodeError`.
+- For TLVs, parse as `TLVStream` with known/unknown TLVs preserved.
+
+## TLV handling
+
+- Implement a small TLV framework using BigSize types.
+- Known TLVs decode into typed records; unknown TLVs preserved as raw
+ `(type, bytes)` for roundtrip correctness.
+- For each message with TLVs, keep `tlvs :: TLVStream` field.
+
+## Validation
+
+- Validate per-message invariants described in BOLT #2, for example:
+ - channel reserve <= funding amount.
+ - dust limits within limits.
+ - maximum HTLC values consistent with fee rate.
+ - feature bit constraints for v2 flows.
+- Provide `validateMessage :: Message -> Either ValidationError Message`.
+
+## Error model
+
+- `DecodeError` enumerates: short input, unknown tag, invalid length,
+ invalid field, invalid TLV ordering, and overflow.
+- `ValidationError` enumerates semantic violations.
+
+## Performance
+
+- Strict fields with `BangPatterns` and `UNPACK` where practical.
+- Small, INLINE encode/decode helpers for hot paths.
+- Avoid intermediate lists in codecs; use ByteString builders.
+
+## Tests
+
+- Unit tests from BOLT #2 examples.
+- Roundtrip tests for each message:
+ - `decodeMessage (encodeMessage m) == Right m`.
+- Property tests for TLV ordering and unknown TLV preservation.
+- Totality tests for decoders with short or malformed inputs.
+
+## Benchmarks
+
+- Encode/decode benchmarks for:
+ - open_channel, accept_channel, commitment_signed,
+ update_add_htlc, channel_reestablish.
+- Separate allocation benchmarks in `bench/Weight.hs`.
+
+## Deliverables
+
+- New modules under `lib/Lightning/Protocol/BOLT2/*`.
+- Tests under `test/` and benchmarks under `bench/`.
+- Updated `ppad-bolt2.cabal` exports and test/bench stanzas.
+
diff --git a/plans/IMPL1.md b/plans/IMPL1.md
@@ -0,0 +1,74 @@
+# IMPL1: BOLT2 implementation plan
+
+Goal: implement full BOLT #2 message types, codecs, validation, tests,
+benchmarks.
+
+## Work breakdown
+
+1) Core types
+- Implement newtypes for identifiers, amounts, hashes, and keys.
+- Provide smart constructors and validation helpers.
+- Add NFData instances for benchmark use.
+
+2) Message ADTs
+- Define per-message record types with strict fields.
+- Define the top-level `Message` sum type and tag mapping.
+
+3) TLV framework
+- Implement `TLVStream` type and parser.
+- Encode/decode BigSize, ordering, and unknown TLV retention.
+
+4) Codec layer
+- Implement `encodeMessage` and `decodeMessage` dispatchers.
+- Implement codecs for each message type using BOLT1 primitives.
+
+5) Validation layer
+- Implement `validateMessage` and per-message validators.
+- Enforce invariants that cannot be encoded in types.
+
+6) Tests
+- Add unit tests from BOLT #2 vectors.
+- Add property tests for roundtrip and TLV ordering.
+
+7) Benchmarks
+- Add criterion benchmarks for hot paths.
+- Add weigh benchmarks for allocation profile.
+
+8) Cabal + exports
+- Update `ppad-bolt2.cabal` to expose modules and tests/benchmarks.
+- Keep `Lightning.Protocol.BOLT2` as the public entry point.
+
+## Parallelizable tasks
+
+- TLV framework can be built independently from message codecs.
+- Core types can be built in parallel with TLV and message ADTs.
+- Tests can be written in parallel once codecs and TLVs are sketched.
+- Benchmarks can be added after codecs are in place.
+
+## Suggested subagent delegation
+
+- Agent A: Core types + validation helpers.
+- Agent B: TLV framework + TLV tests.
+- Agent C: Message ADTs + tag mapping.
+- Agent D: Codecs for v1 establishment + close messages.
+- Agent E: Codecs for v2 interactive-tx messages.
+- Agent F: Normal operation + reestablish messages.
+- Agent G: Test vectors + property tests.
+- Agent H: Benchmarks + NFData instances.
+
+## Risks / notes
+
+- Some invariants depend on other BOLTs or feature bits. Keep validation
+ modular and allow partial validation when necessary.
+- Ensure total decoders and avoid partial pattern matches.
+- Keep lines under 80 chars; use strict fields and UNPACK.
+- Do not add external deps without explicit approval.
+- If other BOLT implementations are needed (e.g. BOLT1), add them as
+ flake inputs (e.g. `../bolt1`) and consume via Nix, not ad hoc paths.
+
+## Acceptance criteria
+
+- All BOLT #2 messages are representable and roundtrip.
+- All public constructors are total and validated.
+- All tests and benchmarks compile and run via cabal.
+- No partial functions; no unchecked indexing in tests.
diff --git a/plans/REVIEW1.md b/plans/REVIEW1.md
@@ -0,0 +1,55 @@
+# REVIEW1: PTAL findings
+
+## Findings
+
+1) High: u16-length fields can silently truncate on encode.
+- Helper `encodeU16Bytes` uses `fromIntegral` without bounds checks.
+- Affected encoders: TxAddInput, TxAddOutput, Witness, TxAbort,
+ UpdateFailHtlc.
+- Files:
+ - lib/Lightning/Protocol/BOLT2/Codec.hs:283
+ - lib/Lightning/Protocol/BOLT2/Codec.hs:879
+ - lib/Lightning/Protocol/BOLT2/Codec.hs:909
+ - lib/Lightning/Protocol/BOLT2/Codec.hs:986
+ - lib/Lightning/Protocol/BOLT2/Codec.hs:1074
+ - lib/Lightning/Protocol/BOLT2/Codec.hs:1157
+
+2) Medium: fixed-size 32-byte secrets are unvalidated in message types.
+- `RevokeAndAck` and `ChannelReestablish` store secrets as raw
+ ByteString; encoders don't validate length.
+- Files:
+ - lib/Lightning/Protocol/BOLT2/Messages.hs:527
+ - lib/Lightning/Protocol/BOLT2/Messages.hs:550
+ - lib/Lightning/Protocol/BOLT2/Codec.hs:1247
+ - lib/Lightning/Protocol/BOLT2/Codec.hs:1289
+
+3) Medium: TLV decoding allows unknown even types by default.
+- `decodeTlvStreamRaw` does not enforce the unknown-even rule.
+- Files:
+ - lib/Lightning/Protocol/BOLT2/Codec.hs:226
+ - lib/Lightning/Protocol/BOLT2/Codec.hs:297
+
+4) Low: list counts can overflow Word16 on encode.
+- `length` of witnesses/signatures is truncated to Word16 without
+ checking.
+- Files:
+ - lib/Lightning/Protocol/BOLT2/Codec.hs:996
+ - lib/Lightning/Protocol/BOLT2/Codec.hs:1210
+
+5) Low: flake uses absolute path for ppad-bolt1.
+- `flake.nix` points to `/Users/jtobin/src/ppad/bolt1`.
+- File:
+ - flake.nix:5
+
+6) Low: tests are empty and helper uses partial `error`.
+- No tests in `test/Main.hs`; `unhex` uses `error`.
+- File:
+ - test/Main.hs:15
+
+## Notes
+
+- Decide whether TLV unknown-even enforcement belongs in codec or in a
+ validation layer.
+- Consider making u16-length encoders return `Either EncodeError` to
+ prevent silent truncation.
+
diff --git a/plans/TODO b/plans/TODO
@@ -0,0 +1,38 @@
+# Outstanding Design Decisions
+
+## TLV Unknown-Even Rule Enforcement
+
+Per BOLT spec, unknown TLV types with even type numbers must cause message
+rejection. Currently `decodeTlvStreamRaw` (from ppad-bolt1) does not enforce
+this rule.
+
+Options:
+1. Enforce in ppad-bolt1's TLV decoder
+2. Add a validation layer in ppad-bolt2 that wraps decoded messages
+3. Leave to application layer
+
+Recommendation: Enforce in ppad-bolt1 since it's a fundamental TLV rule.
+
+## Flake Dependency Path
+
+flake.nix currently uses a local filesystem path for ppad-bolt1:
+
+```nix
+ppad-bolt1 = {
+ type = "path";
+ path = "/Users/jtobin/src/ppad/bolt1";
+ ...
+};
+```
+
+This was a workaround for network connectivity issues. Should be reverted
+to git URL when appropriate:
+
+```nix
+ppad-bolt1 = {
+ type = "git";
+ url = "git://git.ppad.tech/bolt1.git";
+ ref = "master";
+ ...
+};
+```
diff --git a/test/Main.hs b/test/Main.hs
@@ -61,6 +61,10 @@ testPaymentPreimage = fromJust $ paymentPreimage (BS.replicate 32 0xbb)
testOnionPacket :: OnionPacket
testOnionPacket = fromJust $ onionPacket (BS.replicate 1366 0x00)
+-- | Create a valid Secret (32 bytes).
+testSecret :: Secret
+testSecret = fromJust $ secret (BS.replicate 32 0x11)
+
-- | Empty TLV stream for messages.
emptyTlvs :: TlvStream
emptyTlvs = TlvStream []
@@ -237,10 +241,11 @@ v2_establishment_tests = testGroup "V2 Channel Establishment" [
, txAddInputPrevVout = 0
, txAddInputSequence = 0xfffffffe
}
- encoded = encodeTxAddInput msg
- case decodeTxAddInput encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
+ case encodeTxAddInput msg of
+ Left e -> assertFailure $ "encode failed: " ++ show e
+ Right encoded -> case decodeTxAddInput encoded of
+ Right (decoded, _) -> decoded @?= msg
+ Left e -> assertFailure $ "decode failed: " ++ show e
, testCase "roundtrip with empty prevTx" $ do
let msg = TxAddInput
{ txAddInputChannelId = testChannelId
@@ -249,10 +254,11 @@ v2_establishment_tests = testGroup "V2 Channel Establishment" [
, txAddInputPrevVout = 0
, txAddInputSequence = 0
}
- encoded = encodeTxAddInput msg
- case decodeTxAddInput encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
+ case encodeTxAddInput msg of
+ Left e -> assertFailure $ "encode failed: " ++ show e
+ Right encoded -> case decodeTxAddInput encoded of
+ Right (decoded, _) -> decoded @?= msg
+ Left e -> assertFailure $ "decode failed: " ++ show e
]
, testGroup "TxAddOutput" [
testCase "encode/decode roundtrip" $ do
@@ -263,10 +269,11 @@ v2_establishment_tests = testGroup "V2 Channel Establishment" [
, txAddOutputScript = scriptPubKey (BS.pack [0x00, 0x14] <>
BS.replicate 20 0xaa)
}
- encoded = encodeTxAddOutput msg
- case decodeTxAddOutput encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
+ case encodeTxAddOutput msg of
+ Left e -> assertFailure $ "encode failed: " ++ show e
+ Right encoded -> case decodeTxAddOutput encoded of
+ Right (decoded, _) -> decoded @?= msg
+ Left e -> assertFailure $ "decode failed: " ++ show e
]
, testGroup "TxRemoveInput" [
testCase "encode/decode roundtrip" $ do
@@ -305,10 +312,11 @@ v2_establishment_tests = testGroup "V2 Channel Establishment" [
, txSignaturesTxid = testTxId
, txSignaturesWitnesses = []
}
- encoded = encodeTxSignatures msg
- case decodeTxSignatures encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
+ case encodeTxSignatures msg of
+ Left e -> assertFailure $ "encode failed: " ++ show e
+ Right encoded -> case decodeTxSignatures encoded of
+ Right (decoded, _) -> decoded @?= msg
+ Left e -> assertFailure $ "decode failed: " ++ show e
, testCase "encode/decode with multiple witnesses" $ do
let w1 = Witness (BS.pack [0x30, 0x44] <> BS.replicate 68 0xaa)
w2 = Witness (BS.pack [0x02] <> BS.replicate 32 0xbb)
@@ -317,10 +325,11 @@ v2_establishment_tests = testGroup "V2 Channel Establishment" [
, txSignaturesTxid = testTxId
, txSignaturesWitnesses = [w1, w2]
}
- encoded = encodeTxSignatures msg
- case decodeTxSignatures encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
+ case encodeTxSignatures msg of
+ Left e -> assertFailure $ "encode failed: " ++ show e
+ Right encoded -> case decodeTxSignatures encoded of
+ Right (decoded, _) -> decoded @?= msg
+ Left e -> assertFailure $ "decode failed: " ++ show e
]
, testGroup "TxInitRbf" [
testCase "encode/decode roundtrip" $ do
@@ -352,19 +361,21 @@ v2_establishment_tests = testGroup "V2 Channel Establishment" [
{ txAbortChannelId = testChannelId
, txAbortData = "transaction abort reason"
}
- encoded = encodeTxAbort msg
- case decodeTxAbort encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
+ case encodeTxAbort msg of
+ Left e -> assertFailure $ "encode failed: " ++ show e
+ Right encoded -> case decodeTxAbort encoded of
+ Right (decoded, _) -> decoded @?= msg
+ Left e -> assertFailure $ "decode failed: " ++ show e
, testCase "roundtrip with empty data" $ do
let msg = TxAbort
{ txAbortChannelId = testChannelId
, txAbortData = BS.empty
}
- encoded = encodeTxAbort msg
- case decodeTxAbort encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
+ case encodeTxAbort msg of
+ Left e -> assertFailure $ "encode failed: " ++ show e
+ Right encoded -> case decodeTxAbort encoded of
+ Right (decoded, _) -> decoded @?= msg
+ Left e -> assertFailure $ "decode failed: " ++ show e
]
]
@@ -514,10 +525,11 @@ normal_operation_tests = testGroup "Normal Operation" [
, updateFailHtlcReason = BS.replicate 32 0xaa
, updateFailHtlcTlvs = emptyTlvs
}
- encoded = encodeUpdateFailHtlc msg
- case decodeUpdateFailHtlc encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
+ case encodeUpdateFailHtlc msg of
+ Left e -> assertFailure $ "encode failed: " ++ show e
+ Right encoded -> case decodeUpdateFailHtlc encoded of
+ Right (decoded, _) -> decoded @?= msg
+ Left e -> assertFailure $ "decode failed: " ++ show e
, testCase "roundtrip with empty reason" $ do
let msg = UpdateFailHtlc
{ updateFailHtlcChannelId = testChannelId
@@ -525,10 +537,11 @@ normal_operation_tests = testGroup "Normal Operation" [
, updateFailHtlcReason = BS.empty
, updateFailHtlcTlvs = emptyTlvs
}
- encoded = encodeUpdateFailHtlc msg
- case decodeUpdateFailHtlc encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
+ case encodeUpdateFailHtlc msg of
+ Left e -> assertFailure $ "encode failed: " ++ show e
+ Right encoded -> case decodeUpdateFailHtlc encoded of
+ Right (decoded, _) -> decoded @?= msg
+ Left e -> assertFailure $ "decode failed: " ++ show e
]
, testGroup "UpdateFailMalformedHtlc" [
testCase "encode/decode roundtrip" $ do
@@ -550,10 +563,11 @@ normal_operation_tests = testGroup "Normal Operation" [
, commitmentSignedSignature = testSignature
, commitmentSignedHtlcSignatures = []
}
- encoded = encodeCommitmentSigned msg
- case decodeCommitmentSigned encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
+ case encodeCommitmentSigned msg of
+ Left e -> assertFailure $ "encode failed: " ++ show e
+ Right encoded -> case decodeCommitmentSigned encoded of
+ Right (decoded, _) -> decoded @?= msg
+ Left e -> assertFailure $ "decode failed: " ++ show e
, testCase "encode/decode with HTLC signatures" $ do
let sig2 = fromJust $ signature (BS.replicate 64 0xdd)
sig3 = fromJust $ signature (BS.replicate 64 0xee)
@@ -562,16 +576,17 @@ normal_operation_tests = testGroup "Normal Operation" [
, commitmentSignedSignature = testSignature
, commitmentSignedHtlcSignatures = [sig2, sig3]
}
- encoded = encodeCommitmentSigned msg
- case decodeCommitmentSigned encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
+ case encodeCommitmentSigned msg of
+ Left e -> assertFailure $ "encode failed: " ++ show e
+ Right encoded -> case decodeCommitmentSigned encoded of
+ Right (decoded, _) -> decoded @?= msg
+ Left e -> assertFailure $ "decode failed: " ++ show e
]
, testGroup "RevokeAndAck" [
testCase "encode/decode roundtrip" $ do
let msg = RevokeAndAck
{ revokeAndAckChannelId = testChannelId
- , revokeAndAckPerCommitmentSecret = BS.replicate 32 0x11
+ , revokeAndAckPerCommitmentSecret = testSecret
, revokeAndAckNextPerCommitPoint = testPoint
}
encoded = encodeRevokeAndAck msg
@@ -597,11 +612,12 @@ normal_operation_tests = testGroup "Normal Operation" [
reestablish_tests :: TestTree
reestablish_tests = testGroup "Channel Reestablish" [
testCase "encode/decode roundtrip" $ do
- let msg = ChannelReestablish
+ let sec = fromJust $ secret (BS.replicate 32 0x22)
+ msg = ChannelReestablish
{ channelReestablishChannelId = testChannelId
, channelReestablishNextCommitNum = 5
, channelReestablishNextRevocationNum = 4
- , channelReestablishYourLastCommitSecret = BS.replicate 32 0x22
+ , channelReestablishYourLastCommitSecret = sec
, channelReestablishMyCurrentCommitPoint = testPoint
, channelReestablishTlvs = emptyTlvs
}
@@ -610,11 +626,12 @@ reestablish_tests = testGroup "Channel Reestablish" [
Right (decoded, _) -> decoded @?= msg
Left e -> assertFailure $ "decode failed: " ++ show e
, testCase "roundtrip with zero counters" $ do
- let msg = ChannelReestablish
+ let sec = fromJust $ secret (BS.replicate 32 0x00)
+ msg = ChannelReestablish
{ channelReestablishChannelId = testChannelId
, channelReestablishNextCommitNum = 1
, channelReestablishNextRevocationNum = 0
- , channelReestablishYourLastCommitSecret = BS.replicate 32 0x00
+ , channelReestablishYourLastCommitSecret = sec
, channelReestablishMyCurrentCommitPoint = testPoint
, channelReestablishTlvs = emptyTlvs
}
@@ -957,10 +974,11 @@ propTxAddInputRoundtrip prevTxBytes vout seqNum = property $ do
, txAddInputPrevVout = vout
, txAddInputSequence = seqNum
}
- encoded = encodeTxAddInput msg
- case decodeTxAddInput encoded of
- Right (decoded, _) -> decoded == msg
+ case encodeTxAddInput msg of
Left _ -> False
+ Right encoded -> case decodeTxAddInput encoded of
+ Right (decoded, _) -> decoded == msg
+ Left _ -> False
-- Property: TxAddOutput roundtrip
propTxAddOutputRoundtrip :: Word64 -> [Word8] -> Property
@@ -972,10 +990,11 @@ propTxAddOutputRoundtrip sats scriptBytes = property $ do
, txAddOutputSats = Satoshis sats
, txAddOutputScript = script
}
- encoded = encodeTxAddOutput msg
- case decodeTxAddOutput encoded of
- Right (decoded, _) -> decoded == msg
+ case encodeTxAddOutput msg of
Left _ -> False
+ Right encoded -> case decodeTxAddOutput encoded of
+ Right (decoded, _) -> decoded == msg
+ Left _ -> False
-- Property: TxRemoveInput roundtrip
propTxRemoveInputRoundtrip :: Word64 -> Property
@@ -1019,10 +1038,11 @@ propTxSignaturesRoundtrip witnessList = property $ do
, txSignaturesTxid = testTxId
, txSignaturesWitnesses = wits
}
- encoded = encodeTxSignatures msg
- case decodeTxSignatures encoded of
- Right (decoded, _) -> decoded == msg
+ case encodeTxSignatures msg of
Left _ -> False
+ Right encoded -> case decodeTxSignatures encoded of
+ Right (decoded, _) -> decoded == msg
+ Left _ -> False
-- Property: TxInitRbf roundtrip
propTxInitRbfRoundtrip :: Word32 -> Word32 -> Property
@@ -1058,10 +1078,11 @@ propTxAbortRoundtrip dataBytes = property $ do
{ txAbortChannelId = testChannelId
, txAbortData = abortData
}
- encoded = encodeTxAbort msg
- case decodeTxAbort encoded of
- Right (decoded, _) -> decoded == msg
+ case encodeTxAbort msg of
Left _ -> False
+ Right encoded -> case decodeTxAbort encoded of
+ Right (decoded, _) -> decoded == msg
+ Left _ -> False
-- Property: Stfu roundtrip
propStfuRoundtrip :: Word8 -> Property
@@ -1186,10 +1207,11 @@ propUpdateFailHtlcRoundtrip htlcId reasonBytes = property $ do
, updateFailHtlcReason = failReason
, updateFailHtlcTlvs = emptyTlvs
}
- encoded = encodeUpdateFailHtlc msg
- case decodeUpdateFailHtlc encoded of
- Right (decoded, _) -> decoded == msg
+ case encodeUpdateFailHtlc msg of
Left _ -> False
+ Right encoded -> case decodeUpdateFailHtlc encoded of
+ Right (decoded, _) -> decoded == msg
+ Left _ -> False
-- Property: UpdateFailMalformedHtlc roundtrip
propUpdateFailMalformedHtlcRoundtrip :: Word64 -> Word16 -> Property
@@ -1215,17 +1237,18 @@ propCommitmentSignedRoundtrip (NonNegative n) = property $ do
, commitmentSignedSignature = testSignature
, commitmentSignedHtlcSignatures = htlcSigs
}
- encoded = encodeCommitmentSigned msg
- case decodeCommitmentSigned encoded of
- Right (decoded, _) -> decoded == msg
+ case encodeCommitmentSigned msg of
Left _ -> False
+ Right encoded -> case decodeCommitmentSigned encoded of
+ Right (decoded, _) -> decoded == msg
+ Left _ -> False
-- Property: RevokeAndAck roundtrip
propRevokeAndAckRoundtrip :: Property
propRevokeAndAckRoundtrip = property $ do
let msg = RevokeAndAck
{ revokeAndAckChannelId = testChannelId
- , revokeAndAckPerCommitmentSecret = BS.replicate 32 0x11
+ , revokeAndAckPerCommitmentSecret = testSecret
, revokeAndAckNextPerCommitPoint = testPoint
}
encoded = encodeRevokeAndAck msg
@@ -1248,11 +1271,12 @@ propUpdateFeeRoundtrip feerate = property $ do
-- Property: ChannelReestablish roundtrip
propChannelReestablishRoundtrip :: Word64 -> Word64 -> Property
propChannelReestablishRoundtrip nextCommit nextRevoke = property $ do
- let msg = ChannelReestablish
+ let sec = fromJust $ secret (BS.replicate 32 0x22)
+ msg = ChannelReestablish
{ channelReestablishChannelId = testChannelId
, channelReestablishNextCommitNum = nextCommit
, channelReestablishNextRevocationNum = nextRevoke
- , channelReestablishYourLastCommitSecret = BS.replicate 32 0x22
+ , channelReestablishYourLastCommitSecret = sec
, channelReestablishMyCurrentCommitPoint = testPoint
, channelReestablishTlvs = emptyTlvs
}
@@ -1263,8 +1287,6 @@ propChannelReestablishRoundtrip nextCommit nextRevoke = property $ do
-- Helpers ---------------------------------------------------------------------
--- | Decode hex string. Fails the test on invalid hex.
-unhex :: BS.ByteString -> BS.ByteString
-unhex bs = case B16.decode bs of
- Just r -> r
- Nothing -> error $ "invalid hex: " ++ show bs
+-- | Decode hex string. Returns Nothing on invalid hex.
+unhex :: BS.ByteString -> Maybe BS.ByteString
+unhex = B16.decode
