commit 833b7a4a40403b2aedbcc59a464f25c2c0e73584
parent 5e2934e93ac38f94da3f4225391ae903786743f3
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 10 Oct 2026 14:25:09 +0400
Merge impl/modernize: 0.1.0 API
Ports ppad-bolt2 onto ppad-bolt1 0.1.0 and the BOLT #2 spec as of
lightning/bolts 1aadb719, with breaking changes throughout.
API
* Single public module, Lightning.Protocol.BOLT2, with snake_case
names and per-message field prefixes. Types from ppad-bolt1, ppad-tx
and ppad-bolt9 are used directly, not re-exported.
* decode_<msg> :: ByteString -> Either DecodeError <Msg> consumes the
whole payload; encode_<msg> returns Either EncodeError ByteString
only where it can fail. A Message sum with message_type,
encode_message and decode_message handles complete messages, framed
by bolt1's envelope codec (which enforces the 65535-byte limit).
* Amounts are bolt1's bounded Satoshi/MilliSatoshi, except
max_htlc_value_in_flight_msat (Word64).
* OnionPacket becomes the length-checked OnionRoutingPacket;
ScriptPubKey and Witness are bounded at 65535 bytes; OnionHash,
AttributionData, FeeRange and NextFunding are new; FeatureBits,
Initiator (now a Bool) and MsgType are gone.
TLVs
* Every message has a TLV stream with a per-message known-type set:
unknown even types fail, unknown odd records are kept in the _tlvs
field, and encode . decode is the identity on bytes.
* Typed fields for every non-splicing record: upfront_shutdown_script,
channel_type (a bolt9 FeatureVector), require_confirmed_inputs,
funding_output_contribution, short_channel_id alias, closing
signatures, fee_range, blinded_path, attribution_data,
fulfillment_payload, commitment_signed funding_txid, and
channel_reestablish next_funding (now type 1). Known values are
length-checked.
* Splicing (splice_init/ack/locked, start_batch and splicing-only
records) is out of scope.
Tests and benches
* A hand-assembled known-answer test per message, per-message TLV
tests, negative tests for every rejection rule, round-trip
properties, and an edit-and-redecode exactness property.
* Criterion and weigh suites over representative messages.
Docs
* README with a checked GHCi session, spec commit and unimplemented
features; CHANGELOG; spec copy refreshed in etc/.
Diffstat:
16 files changed, 4623 insertions(+), 4158 deletions(-)
diff --git a/AGENTS.md b/AGENTS.md
@@ -3,11 +3,12 @@
Haskell implementation of BOLT #2 (Lightning Network peer protocol).
Specification: https://github.com/lightning/bolts/blob/master/02-peer-protocol.md
+(implemented as of lightning/bolts 1aadb719; a copy lives in `etc/`).
## Project Structure
- `lib/` - library source (Lightning.Protocol.BOLT2)
-- `test/` - tests (tasty + tasty-hunit)
+- `test/` - tests (tasty, tasty-hunit, tasty-quickcheck)
- `bench/` - benchmarks (criterion for timing, weigh for allocations)
- `etc/` - reference materials (BOLT spec)
- `flake.nix` - nix flake for dependency and build management
@@ -32,8 +33,8 @@ Do not use stack. All dependency and build management via nix.
### ppad libraries (use freely)
Use ppad libraries (github.com/ppad-tech, git.ppad.tech) liberally.
-Current dependencies: ppad-bolt1 (for primitive encoding/decoding, TLV),
-ppad-tx (for TxId and OutPoint types).
+Current dependencies: ppad-bolt1 (fundamental types, primitive codecs,
+TLV), ppad-bolt9 (feature vectors), ppad-tx (TxId).
### External libraries
@@ -61,7 +62,7 @@ Use only minimal external dependencies. Prefer GHC's core/boot libraries
### Type safety
- Encode invariants into the type system
-- Use newtypes liberally (e.g., ChannelId, Satoshis, Signature)
+- Use newtypes liberally (e.g., HtlcId, SerialId, ScriptPubKey)
- Use ADTs to make illegal states unrepresentable
- Prefer smart constructors that validate inputs
@@ -142,5 +143,4 @@ When planning work:
The flake.nix follows ppad conventions:
- Uses ppad-nixpkgs as base
- Follows references to avoid duplication
-- Supports LLVM backend via cabal flag
- Provides devShell with ghc, cabal, cc, llvm
diff --git a/CHANGELOG b/CHANGELOG
@@ -1,4 +1,42 @@
# Changelog
-- 0.0.1 (2025-01-25)
+- 0.1.0 (UNRELEASED)
+ * A substantial rewrite against ppad-bolt1 0.1.0, with breaking
+ changes throughout:
+
+ * The API is exported from Lightning.Protocol.BOLT2 alone, and uses
+ snake_case names, with record fields prefixed by their message's
+ name (e.g. encode_open_channel, open_channel_funding_satoshis).
+
+ * Payload decoders have type ByteString -> Either DecodeError a and
+ consume their whole input; encoders return Either EncodeError
+ ByteString only where they can fail. A Message type, with
+ message_type, encode_message and decode_message, handles complete
+ messages.
+
+ * Every message has a TLV stream. Known TLV records are typed fields
+ (channel_type is a ppad-bolt9 feature vector), unknown even records
+ are rejected, and unknown odd records are kept, so encoding a
+ decoded message reproduces its bytes.
+
+ * Amounts use ppad-bolt1's bounded Satoshi and MilliSatoshi, except
+ max_htlc_value_in_flight_msat. Types from ppad-bolt1 and ppad-tx
+ are no longer re-exported.
+
+ * OnionPacket is renamed OnionRoutingPacket and checks its length;
+ ScriptPubKey and Witness are bounded at 65535 bytes; FeatureBits,
+ Initiator and MsgType are removed; OnionHash, AttributionData,
+ FeeRange and NextFunding are added.
+
+ * Catches up with BOLT #2 as of lightning/bolts 1aadb719:
+ channel_reestablish's next_funding moves to TLV type 1, and
+ update_fulfill_htlc (fulfillment_payload), commitment_signed
+ (funding_txid), tx_add_input and tx_signatures gain TLV streams.
+
+ * Fixes decoding, which accepted unknown even TLV types, didn't check
+ known TLV values, point prefixes or amounts, and ignored trailing
+ bytes on some messages; and encoding, which accepted malformed
+ field values.
+
+- 0.0.1 (2026-04-18)
* Initial release.
diff --git a/CLAUDE.md b/CLAUDE.md
@@ -3,11 +3,12 @@
Haskell implementation of BOLT #2 (Lightning Network peer protocol).
Specification: https://github.com/lightning/bolts/blob/master/02-peer-protocol.md
+(implemented as of lightning/bolts 1aadb719; a copy lives in `etc/`).
## Project Structure
- `lib/` - library source (Lightning.Protocol.BOLT2)
-- `test/` - tests (tasty + tasty-hunit)
+- `test/` - tests (tasty, tasty-hunit, tasty-quickcheck)
- `bench/` - benchmarks (criterion for timing, weigh for allocations)
- `etc/` - reference materials (BOLT spec)
- `flake.nix` - nix flake for dependency and build management
@@ -32,8 +33,8 @@ Do not use stack. All dependency and build management via nix.
### ppad libraries (use freely)
Use ppad libraries (github.com/ppad-tech, git.ppad.tech) liberally.
-Current dependencies: ppad-bolt1 (for primitive encoding/decoding, TLV),
-ppad-tx (for TxId and OutPoint types).
+Current dependencies: ppad-bolt1 (fundamental types, primitive codecs,
+TLV), ppad-bolt9 (feature vectors), ppad-tx (TxId).
### External libraries
@@ -61,7 +62,7 @@ Use only minimal external dependencies. Prefer GHC's core/boot libraries
### Type safety
- Encode invariants into the type system
-- Use newtypes liberally (e.g., ChannelId, Satoshis, Signature)
+- Use newtypes liberally (e.g., HtlcId, SerialId, ScriptPubKey)
- Use ADTs to make illegal states unrepresentable
- Prefer smart constructors that validate inputs
@@ -142,5 +143,4 @@ When planning work:
The flake.nix follows ppad conventions:
- Uses ppad-nixpkgs as base
- Follows references to avoid duplication
-- Supports LLVM backend via cabal flag
- Provides devShell with ghc, cabal, cc, llvm
diff --git a/README.md b/README.md
@@ -4,9 +4,10 @@
[](https://docs.ppad.tech/bolt2)
-Haskell implementation of BOLT #2 (Lightning Network peer protocol),
-including message types and codecs for channel establishment, normal
-operation, and channel close.
+A pure Haskell implementation of the Lightning Network peer protocol,
+[BOLT #2][bolt2]: the messages for channel establishment (v1 and v2),
+interactive transaction construction, quiescence, channel close, normal
+operation and message retransmission, with their wire codecs.
## Usage
@@ -14,70 +15,87 @@ A sample GHCi session:
```
> :set -XOverloadedStrings
- >
> import qualified Data.ByteString as BS
- > import qualified Lightning.Protocol.BOLT2 as BOLT2
- > import Lightning.Protocol.BOLT1 (TlvStream(..))
+ > import qualified Lightning.Protocol.BOLT1 as BOLT1
+ > import Lightning.Protocol.BOLT2
+ >
+ > -- a channel_ready carrying an scid alias (a typed TLV record)
+ > let Just cid = BOLT1.channel_id (BS.replicate 32 0xab)
+ > let Just point = BOLT1.point (BS.cons 0x02 (BS.replicate 32 0x11))
+ > let alias = BOLT1.short_channel_id 539268 845 1
+ > let ready = ChannelReady cid point alias BOLT1.empty_tlv_stream
+ > let Right wire = encode_message (MsgChannelReady ready)
+ > BS.length wire
+ 77
+ > decode_message wire == Right (MsgChannelReady ready)
+ True
>
- > -- construct an open_channel message
- > let Just cid = BOLT2.channelId (BS.replicate 32 0x00)
- > let Just ch = BOLT2.chainHash (BS.replicate 32 0x01)
- > let Just pk = BOLT2.point (BS.cons 0x02 (BS.replicate 32 0xff))
+ > -- unknown odd TLV records are kept, so re-encoding is exact
+ > let payload = BS.drop 2 wire
+ > let Right ext = decode_channel_ready (payload <> "\x2b\x01\x2a")
+ > channel_ready_tlvs ext
+ TlvStream [TlvRecord {tlv_type = 43, tlv_value = "*"}]
+ > encode_channel_ready ext == Right (payload <> "\x2b\x01\x2a")
+ True
>
- > let msg = BOLT2.OpenChannel
- > { BOLT2.openChannelChainHash = ch
- > , BOLT2.openChannelTempChannelId = cid
- > , BOLT2.openChannelFundingSatoshis = BOLT2.Satoshis 1000000
- > , BOLT2.openChannelPushMsat = BOLT2.MilliSatoshis 0
- > , BOLT2.openChannelDustLimitSatoshis = BOLT2.Satoshis 546
- > , BOLT2.openChannelMaxHtlcValueInFlight = BOLT2.MilliSatoshis 100000000
- > , BOLT2.openChannelChannelReserveSat = BOLT2.Satoshis 10000
- > , BOLT2.openChannelHtlcMinimumMsat = BOLT2.MilliSatoshis 1000
- > , BOLT2.openChannelFeeratePerKw = 2500
- > , BOLT2.openChannelToSelfDelay = 144
- > , BOLT2.openChannelMaxAcceptedHtlcs = 483
- > , BOLT2.openChannelFundingPubkey = pk
- > , BOLT2.openChannelRevocationBasepoint = pk
- > , BOLT2.openChannelPaymentBasepoint = pk
- > , BOLT2.openChannelDelayedPaymentBase = pk
- > , BOLT2.openChannelHtlcBasepoint = pk
- > , BOLT2.openChannelFirstPerCommitPoint = pk
- > , BOLT2.openChannelChannelFlags = 0x01
- > , BOLT2.openChannelTlvs = TlvStream []
- > }
+ > -- unknown even records and malformed known ones are rejected
+ > decode_channel_ready (payload <> "\x2a\x00")
+ Left (DecodeTlvError (TlvUnknownEvenType 42))
+ > let fixed = BS.take 65 payload
+ > decode_channel_ready (fixed <> "\x01\x07" <> BS.replicate 7 0x00)
+ Left (DecodeInvalidTlvValue 1)
>
- > -- encode and decode
- > let encoded = BOLT2.encodeOpenChannel msg
- > BS.length encoded
- 319
- > BOLT2.decodeOpenChannel encoded
- Right (OpenChannel {..}, "")
+ > -- messages from other BOLTs (or splicing) aren't BOLT #2's
+ > decode_message ("\x00\x50" <> payload)
+ Left (DecodeUnknownEvenType 80)
```
-## Message Types
+## Documentation
-Supported BOLT #2 messages:
+Haddocks (API documentation, etc.) are hosted at
+[docs.ppad.tech/bolt2](https://docs.ppad.tech/bolt2).
-- Channel establishment v1: `open_channel`, `accept_channel`,
- `funding_created`, `funding_signed`, `channel_ready`
-- Channel establishment v2: `open_channel2`, `accept_channel2`,
- `tx_add_input`, `tx_add_output`, `tx_remove_input`, `tx_remove_output`,
- `tx_complete`, `tx_signatures`, `tx_init_rbf`, `tx_ack_rbf`, `tx_abort`
-- Channel close: `stfu`, `shutdown`, `closing_signed`, `closing_complete`,
- `closing_sig`
-- Normal operation: `update_add_htlc`, `update_fulfill_htlc`,
- `update_fail_htlc`, `update_fail_malformed_htlc`, `commitment_signed`,
- `revoke_and_ack`, `update_fee`
-- Reestablishment: `channel_reestablish`
+## Specification
-## Documentation
+This library implements BOLT #2 as of lightning/bolts commit
+[1aadb719][spec] (2026-09-21); a copy lives in `etc/`.
+
+Fundamental types and the TLV format come from [ppad-bolt1][bolt1],
+transaction ids from [ppad-tx][tx], and `channel_type` feature vectors
+from [ppad-bolt9][bolt9]. Every TLV record the specification defines
+outside of splicing has a typed field; unknown odd records are kept.
+
+Not implemented:
+
+* Splicing: the `splice_init`, `splice_ack` and `splice_locked`
+ messages, and the splicing-only TLV records. `tx_add_input`'s
+ `shared_input_txid` and `tx_signatures`' `shared_input_signature` are
+ rejected as unknown even types; `channel_reestablish`'s
+ `my_current_funding_locked` is kept as an unknown odd record.
+* The `start_batch` message.
+* Channel-level validation: the library checks what decoding needs
+ (field lengths, point prefixes, amounts of at most 21M BTC, TLV
+ rules), and leaves rules that depend on channel state or negotiated
+ features (reserves, feerates, shutdown script forms, `serial_id`
+ parity, required TLV records, points being on the curve, etc.) to the
+ caller.
+* Interpretation of the onion routing packet and attribution data,
+ which are kept opaque (see BOLT #4).
-Haddocks are hosted at [docs.ppad.tech/bolt2][hadoc].
+## Performance
+
+The aim is best-in-class performance for pure Haskell code. Run the
+benchmarks with:
+
+```
+$ cabal bench
+```
## Security
-This is a pre-release version of the library and makes no guarantees about
-security whatsoever.
+This library has received no security audit. It decodes strictly:
+every message must be consumed exactly, unknown even TLV records are
+rejected, and encoding a decoded message reproduces its bytes.
## Development
@@ -91,11 +109,15 @@ $ nix develop
Then do e.g.:
```
-$ cabal build
-$ cabal test
-$ cabal bench
+$ cabal repl ppad-bolt2
```
+to get a REPL for the main library.
+
+[bolt2]: https://github.com/lightning/bolts/blob/master/02-peer-protocol.md
+[bolt1]: https://git.ppad.tech/bolt1
+[bolt9]: https://git.ppad.tech/bolt9
+[tx]: https://git.ppad.tech/tx
+[spec]: https://github.com/lightning/bolts/tree/1aadb719b4007c4cea0ba6e36b08c4fb53788dee
[nixos]: https://nixos.org/
[flake]: https://nixos.org/manual/nix/unstable/command-ref/new-cli/nix3-flake.html
-[hadoc]: https://docs.ppad.tech/bolt2
diff --git a/bench/Fixtures.hs b/bench/Fixtures.hs
@@ -0,0 +1,126 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Fixtures (
+ Fixtures(..)
+ , fixtures
+ ) where
+
+import qualified Bitcoin.Prim.Tx as Tx
+import qualified Data.ByteString as BS
+import qualified Lightning.Protocol.BOLT1 as BOLT1
+import Lightning.Protocol.BOLT2
+import qualified Lightning.Protocol.BOLT9 as BOLT9
+
+-- representative messages, with their encoded payloads
+data Fixtures = Fixtures
+ { fx_open_channel :: !OpenChannel
+ , fx_open_channel_bytes :: !BS.ByteString
+ , fx_accept_channel2 :: !AcceptChannel2
+ , fx_accept_channel2_bytes :: !BS.ByteString
+ , fx_tx_signatures :: !TxSignatures
+ , fx_tx_signatures_bytes :: !BS.ByteString
+ , fx_closing_complete :: !ClosingComplete
+ , fx_closing_complete_bytes :: !BS.ByteString
+ , fx_update_add_htlc :: !UpdateAddHtlc
+ , fx_update_add_htlc_bytes :: !BS.ByteString
+ , fx_update_add_htlc_wire :: !BS.ByteString
+ , fx_update_fulfill_htlc :: !UpdateFulfillHtlc
+ , fx_update_fulfill_htlc_bytes :: !BS.ByteString
+ , fx_commitment_signed :: !CommitmentSigned
+ , fx_commitment_signed_bytes :: !BS.ByteString
+ , fx_commitment_signed_483 :: !CommitmentSigned
+ , fx_commitment_signed_483_bytes :: !BS.ByteString
+ , fx_revoke_and_ack :: !RevokeAndAck
+ , fx_revoke_and_ack_bytes :: !BS.ByteString
+ , fx_channel_reestablish :: !ChannelReestablish
+ , fx_channel_reestablish_bytes :: !BS.ByteString
+ }
+
+ok :: Either e a -> Maybe a
+ok = either (const Nothing) Just
+
+empty :: BOLT1.TlvStream
+empty = BOLT1.empty_tlv_stream
+
+fixtures :: Maybe Fixtures
+fixtures = do
+ ch <- BOLT1.chain_hash (BS.replicate 32 0x6f)
+ cid <- BOLT1.channel_id (BS.replicate 32 0xab)
+ pts <- traverse (\b -> BOLT1.point (BS.cons 0x02 (BS.replicate 32 b)))
+ [0x11, 0x22, 0x33, 0x44, 0x55, 0x66, 0x77]
+ sig <- BOLT1.signature (BS.replicate 64 0xa1)
+ txid <- Tx.mkTxId (BS.replicate 32 0x7e)
+ spk <- script_pubkey ("\x00\x14" <> BS.replicate 20 0x88)
+ fund <- BOLT1.satoshi 1000000
+ dust <- BOLT1.satoshi 546
+ res <- BOLT1.satoshi 10000
+ push <- BOLT1.milli_satoshi 0
+ hmin <- BOLT1.milli_satoshi 1000
+ amt <- BOLT1.milli_satoshi 100000
+ fee <- BOLT1.satoshi 500
+ ph <- BOLT1.payment_hash (BS.replicate 32 0x9a)
+ pre <- BOLT1.payment_preimage (BS.replicate 32 0x50)
+ sec <- BOLT1.per_commitment_secret (BS.replicate 32 0x5e)
+ onion <- onion_routing_packet (BS.replicate 1366 0x44)
+ att <- attribution_data (BS.replicate 920 0x0b)
+ ws <- traverse witness
+ [ "\x02\x47" <> BS.replicate 71 0x30 <> "\x21"
+ <> BS.replicate 33 0x02
+ , "\x01\x40" <> BS.replicate 64 0x01 ]
+ ext <- BOLT1.tlv_stream [BOLT1.TlvRecord 43 (BS.replicate 16 0x2a)]
+ (p1, p2, p3, p4, p5, p6, p7) <- case pts of
+ [a, b, c, d, e, f, g] -> Just (a, b, c, d, e, f, g)
+ _ -> Nothing
+ let ctype = BOLT9.channel_type_features
+ (BOLT9.ChannelType BOLT9.BasicAnchors False False)
+
+ oc = OpenChannel ch cid fund push dust maxBound res hmin 253 144 483
+ p1 p2 p3 p4 p5 p6 1 (Just spk) (Just ctype) empty
+ ac2 = AcceptChannel2 cid fund dust maxBound hmin 3 144 483
+ p1 p2 p3 p4 p5 p6 p7 (Just spk) (Just ctype) True ext
+ txs = TxSignatures cid txid ws empty
+ cc = ClosingComplete cid spk spk fee 0 (Just sig) Nothing (Just sig)
+ empty
+ add = UpdateAddHtlc cid (HtlcId 42) amt ph 800000 onion (Just p1)
+ empty
+ ful = UpdateFulfillHtlc cid (HtlcId 42) pre (Just att) Nothing empty
+ cs0 = CommitmentSigned cid sig [] (Just txid) empty
+ cs483 = CommitmentSigned cid sig (replicate 483 sig) (Just txid)
+ empty
+ raa = RevokeAndAck cid sec p1 empty
+ rst = ChannelReestablish cid 5 4 sec p1 (Just (NextFunding txid 1))
+ empty
+
+ oc_b <- ok (encode_open_channel oc)
+ ac2_b <- ok (encode_accept_channel2 ac2)
+ txs_b <- ok (encode_tx_signatures txs)
+ cc_b <- ok (encode_closing_complete cc)
+ add_b <- ok (encode_update_add_htlc add)
+ add_w <- ok (encode_message (MsgUpdateAddHtlc add))
+ ful_b <- ok (encode_update_fulfill_htlc ful)
+ cs0_b <- ok (encode_commitment_signed cs0)
+ cs483_b <- ok (encode_commitment_signed cs483)
+ rst_b <- ok (encode_channel_reestablish rst)
+ pure Fixtures
+ { fx_open_channel = oc
+ , fx_open_channel_bytes = oc_b
+ , fx_accept_channel2 = ac2
+ , fx_accept_channel2_bytes = ac2_b
+ , fx_tx_signatures = txs
+ , fx_tx_signatures_bytes = txs_b
+ , fx_closing_complete = cc
+ , fx_closing_complete_bytes = cc_b
+ , fx_update_add_htlc = add
+ , fx_update_add_htlc_bytes = add_b
+ , fx_update_add_htlc_wire = add_w
+ , fx_update_fulfill_htlc = ful
+ , fx_update_fulfill_htlc_bytes = ful_b
+ , fx_commitment_signed = cs0
+ , fx_commitment_signed_bytes = cs0_b
+ , fx_commitment_signed_483 = cs483
+ , fx_commitment_signed_483_bytes = cs483_b
+ , fx_revoke_and_ack = raa
+ , fx_revoke_and_ack_bytes = encode_revoke_and_ack raa
+ , fx_channel_reestablish = rst
+ , fx_channel_reestablish_bytes = rst_b
+ }
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -1,301 +1,65 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE OverloadedStrings #-}
-
--- |
--- Module: Main
--- Copyright: (c) 2025 Jared Tobin
--- License: MIT
--- Maintainer: Jared Tobin <jared@ppad.tech>
---
--- Criterion timing benchmarks for BOLT #2 message codecs.
-
module Main where
import Criterion.Main
-import qualified Data.ByteString as BS
-import Lightning.Protocol.BOLT1 (TlvStream, unsafeTlvStream)
+import Fixtures
import Lightning.Protocol.BOLT2
--- Test data construction ------------------------------------------------------
-
--- | 32 zero bytes for channel IDs, chain hashes, etc.
-zeroBytes32 :: BS.ByteString
-zeroBytes32 = BS.replicate 32 0x00
-{-# NOINLINE zeroBytes32 #-}
-
--- | 33-byte compressed public key (02 prefix + 32 zero bytes).
-testPoint :: Point
-testPoint = case point (BS.cons 0x02 zeroBytes32) of
- Just p -> p
- Nothing -> error "testPoint: invalid"
-{-# NOINLINE testPoint #-}
-
--- | 64-byte signature.
-testSignature :: Signature
-testSignature = case signature (BS.replicate 64 0x01) of
- Just s -> s
- Nothing -> error "testSignature: invalid"
-{-# NOINLINE testSignature #-}
-
--- | 32-byte channel ID.
-testChannelId :: ChannelId
-testChannelId = case channelId zeroBytes32 of
- Just c -> c
- Nothing -> error "testChannelId: invalid"
-{-# NOINLINE testChannelId #-}
-
--- | 32-byte chain hash.
-testChainHash :: ChainHash
-testChainHash = case chainHash zeroBytes32 of
- Just h -> h
- Nothing -> error "testChainHash: invalid"
-{-# NOINLINE testChainHash #-}
-
--- | 32-byte txid.
-testTxId :: TxId
-testTxId = case mkTxId zeroBytes32 of
- Just t -> t
- Nothing -> error "testTxId: invalid"
-{-# NOINLINE testTxId #-}
-
--- | 32-byte payment hash.
-testPaymentHash :: PaymentHash
-testPaymentHash = case paymentHash zeroBytes32 of
- Just h -> h
- Nothing -> error "testPaymentHash: invalid"
-{-# NOINLINE testPaymentHash #-}
-
--- | 1366-byte onion packet.
-testOnionPacket :: OnionPacket
-testOnionPacket = case onionPacket (BS.replicate 1366 0x00) of
- Just o -> o
- Nothing -> error "testOnionPacket: invalid"
-{-# NOINLINE testOnionPacket #-}
-
--- | Empty TLV stream.
-emptyTlvs :: TlvStream
-emptyTlvs = unsafeTlvStream []
-{-# NOINLINE emptyTlvs #-}
-
--- V1 messages -----------------------------------------------------------------
-
--- | Test OpenChannel message.
-testOpenChannel :: OpenChannel
-testOpenChannel = OpenChannel
- { openChannelChainHash = testChainHash
- , openChannelTempChannelId = testChannelId
- , openChannelFundingSatoshi = Satoshi 1000000
- , openChannelPushMsat = MilliSatoshi 0
- , openChannelDustLimitSatoshi = Satoshi 546
- , openChannelMaxHtlcValueInFlight = MilliSatoshi 1000000000
- , openChannelChannelReserveSat = Satoshi 10000
- , openChannelHtlcMinimumMsat = MilliSatoshi 1000
- , openChannelFeeratePerKw = 250
- , openChannelToSelfDelay = 144
- , openChannelMaxAcceptedHtlcs = 30
- , openChannelFundingPubkey = testPoint
- , openChannelRevocationBasepoint = testPoint
- , openChannelPaymentBasepoint = testPoint
- , openChannelDelayedPaymentBase = testPoint
- , openChannelHtlcBasepoint = testPoint
- , openChannelFirstPerCommitPoint = testPoint
- , openChannelChannelFlags = 0x00
- , openChannelTlvs = emptyTlvs
- }
-{-# NOINLINE testOpenChannel #-}
-
--- | Encoded OpenChannel for decode benchmarks.
-encodedOpenChannel :: BS.ByteString
-encodedOpenChannel = encodeOpenChannel testOpenChannel
-{-# NOINLINE encodedOpenChannel #-}
-
--- V2 messages -----------------------------------------------------------------
-
--- | Test OpenChannel2 message.
-testOpenChannel2 :: OpenChannel2
-testOpenChannel2 = OpenChannel2
- { openChannel2ChainHash = testChainHash
- , openChannel2TempChannelId = testChannelId
- , openChannel2FundingFeeratePerkw = 2500
- , openChannel2CommitFeeratePerkw = 250
- , openChannel2FundingSatoshi = Satoshi 1000000
- , openChannel2DustLimitSatoshi = Satoshi 546
- , openChannel2MaxHtlcValueInFlight = MilliSatoshi 1000000000
- , openChannel2HtlcMinimumMsat = MilliSatoshi 1000
- , openChannel2ToSelfDelay = 144
- , openChannel2MaxAcceptedHtlcs = 30
- , openChannel2Locktime = 0
- , openChannel2FundingPubkey = testPoint
- , openChannel2RevocationBasepoint = testPoint
- , openChannel2PaymentBasepoint = testPoint
- , openChannel2DelayedPaymentBase = testPoint
- , openChannel2HtlcBasepoint = testPoint
- , openChannel2FirstPerCommitPoint = testPoint
- , openChannel2SecondPerCommitPoint = testPoint
- , openChannel2ChannelFlags = 0x00
- , openChannel2Tlvs = emptyTlvs
- }
-{-# NOINLINE testOpenChannel2 #-}
-
--- | Encoded OpenChannel2 for decode benchmarks.
-encodedOpenChannel2 :: BS.ByteString
-encodedOpenChannel2 = encodeOpenChannel2 testOpenChannel2
-{-# NOINLINE encodedOpenChannel2 #-}
-
--- | Test witness data (simulated P2WPKH signature + pubkey).
-testWitness :: Witness
-testWitness = Witness (BS.replicate 107 0xab)
-{-# NOINLINE testWitness #-}
-
--- | TxSignatures with multiple witnesses.
-testTxSignatures :: TxSignatures
-testTxSignatures = TxSignatures
- { txSignaturesChannelId = testChannelId
- , txSignaturesTxid = testTxId
- , txSignaturesWitnesses = replicate 5 testWitness
- }
-{-# NOINLINE testTxSignatures #-}
-
--- | Encoded TxSignatures for decode benchmarks.
-encodedTxSignatures :: BS.ByteString
-encodedTxSignatures = case encodeTxSignatures testTxSignatures of
- Right bs -> bs
- Left e -> error $ "encodedTxSignatures: " ++ show e
-{-# NOINLINE encodedTxSignatures #-}
-
--- Close messages --------------------------------------------------------------
-
--- | Test ClosingSigned message.
-testClosingSigned :: ClosingSigned
-testClosingSigned = ClosingSigned
- { closingSignedChannelId = testChannelId
- , closingSignedFeeSatoshi = Satoshi 1000
- , closingSignedSignature = testSignature
- , closingSignedTlvs = emptyTlvs
- }
-{-# NOINLINE testClosingSigned #-}
-
--- | Encoded ClosingSigned for decode benchmarks.
-encodedClosingSigned :: BS.ByteString
-encodedClosingSigned = encodeClosingSigned testClosingSigned
-{-# NOINLINE encodedClosingSigned #-}
-
--- Normal operation messages ---------------------------------------------------
-
--- | Test UpdateAddHtlc message.
-testUpdateAddHtlc :: UpdateAddHtlc
-testUpdateAddHtlc = UpdateAddHtlc
- { updateAddHtlcChannelId = testChannelId
- , updateAddHtlcId = htlcId 0
- , updateAddHtlcAmountMsat = MilliSatoshi 10000000
- , updateAddHtlcPaymentHash = testPaymentHash
- , updateAddHtlcCltvExpiry = 800000
- , updateAddHtlcOnionPacket = testOnionPacket
- , updateAddHtlcTlvs = emptyTlvs
- }
-{-# NOINLINE testUpdateAddHtlc #-}
-
--- | Encoded UpdateAddHtlc for decode benchmarks.
-encodedUpdateAddHtlc :: BS.ByteString
-encodedUpdateAddHtlc = encodeUpdateAddHtlc testUpdateAddHtlc
-{-# NOINLINE encodedUpdateAddHtlc #-}
-
--- | Test CommitmentSigned message with HTLC signatures (10 sigs).
-testCommitmentSigned :: CommitmentSigned
-testCommitmentSigned = CommitmentSigned
- { commitmentSignedChannelId = testChannelId
- , commitmentSignedSignature = testSignature
- , commitmentSignedHtlcSignatures = replicate 10 testSignature
- }
-{-# NOINLINE testCommitmentSigned #-}
-
--- | Encoded CommitmentSigned for decode benchmarks.
-encodedCommitmentSigned :: BS.ByteString
-encodedCommitmentSigned = case encodeCommitmentSigned testCommitmentSigned of
- Right bs -> bs
- Left e -> error $ "encodedCommitmentSigned: " ++ show e
-{-# NOINLINE encodedCommitmentSigned #-}
-
--- | Test CommitmentSigned with many HTLC signatures (100 sigs).
-testCommitmentSignedLarge :: CommitmentSigned
-testCommitmentSignedLarge = CommitmentSigned
- { commitmentSignedChannelId = testChannelId
- , commitmentSignedSignature = testSignature
- , commitmentSignedHtlcSignatures = replicate 100 testSignature
- }
-{-# NOINLINE testCommitmentSignedLarge #-}
-
--- | Encoded large CommitmentSigned for decode benchmarks.
-encodedCommitmentSignedLarge :: BS.ByteString
-encodedCommitmentSignedLarge =
- case encodeCommitmentSigned testCommitmentSignedLarge of
- Right bs -> bs
- Left e -> error $ "encodedCommitmentSignedLarge: " ++ show e
-{-# NOINLINE encodedCommitmentSignedLarge #-}
-
--- | Test CommitmentSigned with max HTLC signatures (483 sigs).
-testCommitmentSignedMax :: CommitmentSigned
-testCommitmentSignedMax = CommitmentSigned
- { commitmentSignedChannelId = testChannelId
- , commitmentSignedSignature = testSignature
- , commitmentSignedHtlcSignatures = replicate 483 testSignature
- }
-{-# NOINLINE testCommitmentSignedMax #-}
-
--- | Encoded max CommitmentSigned for decode benchmarks.
-encodedCommitmentSignedMax :: BS.ByteString
-encodedCommitmentSignedMax =
- case encodeCommitmentSigned testCommitmentSignedMax of
- Right bs -> bs
- Left e -> error $ "encodedCommitmentSignedMax: " ++ show e
-{-# NOINLINE encodedCommitmentSignedMax #-}
-
--- Benchmark groups ------------------------------------------------------------
-
main :: IO ()
-main = defaultMain
- [ bgroup "v1"
- [ bgroup "open_channel"
- [ bench "encode" $ nf encodeOpenChannel testOpenChannel
- , bench "decode" $ nf decodeOpenChannel encodedOpenChannel
- ]
+main = case fixtures of
+ Nothing -> fail "invalid fixtures"
+ Just fx -> defaultMain [
+ bgroup "open_channel" [
+ bench "encode" $ nf encode_open_channel (fx_open_channel fx)
+ , bench "decode" $ nf decode_open_channel (fx_open_channel_bytes fx)
+ ]
+ , bgroup "accept_channel2" [
+ bench "encode" $ nf encode_accept_channel2 (fx_accept_channel2 fx)
+ , bench "decode" $
+ nf decode_accept_channel2 (fx_accept_channel2_bytes fx)
+ ]
+ , bgroup "tx_signatures" [
+ bench "encode" $ nf encode_tx_signatures (fx_tx_signatures fx)
+ , bench "decode" $ nf decode_tx_signatures (fx_tx_signatures_bytes fx)
+ ]
+ , bgroup "closing_complete" [
+ bench "encode" $ nf encode_closing_complete (fx_closing_complete fx)
+ , bench "decode" $
+ nf decode_closing_complete (fx_closing_complete_bytes fx)
+ ]
+ , bgroup "update_add_htlc" [
+ bench "encode" $ nf encode_update_add_htlc (fx_update_add_htlc fx)
+ , bench "decode" $
+ nf decode_update_add_htlc (fx_update_add_htlc_bytes fx)
+ , bench "encode_message" $
+ nf encode_message (MsgUpdateAddHtlc (fx_update_add_htlc fx))
+ , bench "decode_message" $
+ nf decode_message (fx_update_add_htlc_wire fx)
+ ]
+ , bgroup "update_fulfill_htlc" [
+ bench "encode" $
+ nf encode_update_fulfill_htlc (fx_update_fulfill_htlc fx)
+ , bench "decode" $
+ nf decode_update_fulfill_htlc (fx_update_fulfill_htlc_bytes fx)
]
- , bgroup "v2"
- [ bgroup "open_channel2"
- [ bench "encode" $ nf encodeOpenChannel2 testOpenChannel2
- , bench "decode" $ nf decodeOpenChannel2 encodedOpenChannel2
- ]
- , bgroup "tx_signatures"
- [ bench "encode" $ nf encodeTxSignatures testTxSignatures
- , bench "decode" $ nf decodeTxSignatures encodedTxSignatures
- ]
+ , bgroup "commitment_signed" [
+ bench "encode (0 htlcs)" $
+ nf encode_commitment_signed (fx_commitment_signed fx)
+ , bench "decode (0 htlcs)" $
+ nf decode_commitment_signed (fx_commitment_signed_bytes fx)
+ , bench "encode (483 htlcs)" $
+ nf encode_commitment_signed (fx_commitment_signed_483 fx)
+ , bench "decode (483 htlcs)" $
+ nf decode_commitment_signed (fx_commitment_signed_483_bytes fx)
]
- , bgroup "close"
- [ bgroup "closing_signed"
- [ bench "encode" $ nf encodeClosingSigned testClosingSigned
- , bench "decode" $ nf decodeClosingSigned encodedClosingSigned
- ]
+ , bgroup "revoke_and_ack" [
+ bench "encode" $ nf encode_revoke_and_ack (fx_revoke_and_ack fx)
+ , bench "decode" $
+ nf decode_revoke_and_ack (fx_revoke_and_ack_bytes fx)
]
- , bgroup "normal"
- [ bgroup "update_add_htlc"
- [ bench "encode" $ nf encodeUpdateAddHtlc testUpdateAddHtlc
- , bench "decode" $ nf decodeUpdateAddHtlc encodedUpdateAddHtlc
- ]
- , bgroup "commitment_signed"
- [ bench "encode" $ nf encodeCommitmentSigned testCommitmentSigned
- , bench "decode" $ nf decodeCommitmentSigned encodedCommitmentSigned
- ]
- , bgroup "commitment_signed_100"
- [ bench "encode" $
- nf encodeCommitmentSigned testCommitmentSignedLarge
- , bench "decode" $
- nf decodeCommitmentSigned encodedCommitmentSignedLarge
- ]
- , bgroup "commitment_signed_483"
- [ bench "encode" $
- nf encodeCommitmentSigned testCommitmentSignedMax
- , bench "decode" $
- nf decodeCommitmentSigned encodedCommitmentSignedMax
- ]
+ , bgroup "channel_reestablish" [
+ bench "encode" $
+ nf encode_channel_reestablish (fx_channel_reestablish fx)
+ , bench "decode" $
+ nf decode_channel_reestablish (fx_channel_reestablish_bytes fx)
]
- ]
+ ]
diff --git a/bench/Weight.hs b/bench/Weight.hs
@@ -1,344 +1,49 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE OverloadedStrings #-}
-
--- |
--- Module: Main
--- Copyright: (c) 2025 Jared Tobin
--- License: MIT
--- Maintainer: Jared Tobin <jared@ppad.tech>
---
--- Weigh allocation benchmarks for BOLT #2 message codecs.
-
module Main where
-import qualified Data.ByteString as BS
-import Lightning.Protocol.BOLT1 (TlvStream, unsafeTlvStream)
+import Fixtures
import Lightning.Protocol.BOLT2
import Weigh
--- | Wrapper for encoding functions that return Either.
-forceEncode :: Either EncodeError BS.ByteString -> BS.ByteString
-forceEncode (Right bs) = bs
-forceEncode (Left e) = error $ "forceEncode: " ++ show e
-{-# INLINE forceEncode #-}
-
--- Test data construction ------------------------------------------------------
-
--- | 32 zero bytes for channel IDs, chain hashes, etc.
-zeroBytes32 :: BS.ByteString
-zeroBytes32 = BS.replicate 32 0x00
-{-# NOINLINE zeroBytes32 #-}
-
--- | 33-byte compressed public key (02 prefix + 32 zero bytes).
-testPoint :: Point
-testPoint = case point (BS.cons 0x02 zeroBytes32) of
- Just p -> p
- Nothing -> error "testPoint: invalid"
-{-# NOINLINE testPoint #-}
-
--- | 64-byte signature.
-testSignature :: Signature
-testSignature = case signature (BS.replicate 64 0x01) of
- Just s -> s
- Nothing -> error "testSignature: invalid"
-{-# NOINLINE testSignature #-}
-
--- | 32-byte channel ID.
-testChannelId :: ChannelId
-testChannelId = case channelId zeroBytes32 of
- Just c -> c
- Nothing -> error "testChannelId: invalid"
-{-# NOINLINE testChannelId #-}
-
--- | 32-byte chain hash.
-testChainHash :: ChainHash
-testChainHash = case chainHash zeroBytes32 of
- Just h -> h
- Nothing -> error "testChainHash: invalid"
-{-# NOINLINE testChainHash #-}
-
--- | 32-byte txid.
-testTxId :: TxId
-testTxId = case mkTxId zeroBytes32 of
- Just t -> t
- Nothing -> error "testTxId: invalid"
-{-# NOINLINE testTxId #-}
-
--- | 32-byte payment hash.
-testPaymentHash :: PaymentHash
-testPaymentHash = case paymentHash zeroBytes32 of
- Just h -> h
- Nothing -> error "testPaymentHash: invalid"
-{-# NOINLINE testPaymentHash #-}
-
--- | 1366-byte onion packet.
-testOnionPacket :: OnionPacket
-testOnionPacket = case onionPacket (BS.replicate 1366 0x00) of
- Just o -> o
- Nothing -> error "testOnionPacket: invalid"
-{-# NOINLINE testOnionPacket #-}
-
--- | Empty TLV stream.
-emptyTlvs :: TlvStream
-emptyTlvs = unsafeTlvStream []
-{-# NOINLINE emptyTlvs #-}
-
--- Message constructors --------------------------------------------------------
-
--- | Construct OpenChannel message.
-mkOpenChannel :: ChainHash -> ChannelId -> Point -> TlvStream -> OpenChannel
-mkOpenChannel !ch !cid !pt !tlvs = OpenChannel
- { openChannelChainHash = ch
- , openChannelTempChannelId = cid
- , openChannelFundingSatoshi = Satoshi 1000000
- , openChannelPushMsat = MilliSatoshi 0
- , openChannelDustLimitSatoshi = Satoshi 546
- , openChannelMaxHtlcValueInFlight = MilliSatoshi 1000000000
- , openChannelChannelReserveSat = Satoshi 10000
- , openChannelHtlcMinimumMsat = MilliSatoshi 1000
- , openChannelFeeratePerKw = 250
- , openChannelToSelfDelay = 144
- , openChannelMaxAcceptedHtlcs = 30
- , openChannelFundingPubkey = pt
- , openChannelRevocationBasepoint = pt
- , openChannelPaymentBasepoint = pt
- , openChannelDelayedPaymentBase = pt
- , openChannelHtlcBasepoint = pt
- , openChannelFirstPerCommitPoint = pt
- , openChannelChannelFlags = 0x00
- , openChannelTlvs = tlvs
- }
-
--- | Construct OpenChannel2 message.
-mkOpenChannel2 :: ChainHash -> ChannelId -> Point -> TlvStream -> OpenChannel2
-mkOpenChannel2 !ch !cid !pt !tlvs = OpenChannel2
- { openChannel2ChainHash = ch
- , openChannel2TempChannelId = cid
- , openChannel2FundingFeeratePerkw = 2500
- , openChannel2CommitFeeratePerkw = 250
- , openChannel2FundingSatoshi = Satoshi 1000000
- , openChannel2DustLimitSatoshi = Satoshi 546
- , openChannel2MaxHtlcValueInFlight = MilliSatoshi 1000000000
- , openChannel2HtlcMinimumMsat = MilliSatoshi 1000
- , openChannel2ToSelfDelay = 144
- , openChannel2MaxAcceptedHtlcs = 30
- , openChannel2Locktime = 0
- , openChannel2FundingPubkey = pt
- , openChannel2RevocationBasepoint = pt
- , openChannel2PaymentBasepoint = pt
- , openChannel2DelayedPaymentBase = pt
- , openChannel2HtlcBasepoint = pt
- , openChannel2FirstPerCommitPoint = pt
- , openChannel2SecondPerCommitPoint = pt
- , openChannel2ChannelFlags = 0x00
- , openChannel2Tlvs = tlvs
- }
-
--- | Construct TxSignatures message.
-mkTxSignatures :: ChannelId -> TxId -> [Witness] -> TxSignatures
-mkTxSignatures !cid !tid !ws = TxSignatures
- { txSignaturesChannelId = cid
- , txSignaturesTxid = tid
- , txSignaturesWitnesses = ws
- }
-
--- | Construct ClosingSigned message.
-mkClosingSigned :: ChannelId -> Signature -> TlvStream -> ClosingSigned
-mkClosingSigned !cid !sig !tlvs = ClosingSigned
- { closingSignedChannelId = cid
- , closingSignedFeeSatoshi = Satoshi 1000
- , closingSignedSignature = sig
- , closingSignedTlvs = tlvs
- }
-
--- | Construct UpdateAddHtlc message.
-mkUpdateAddHtlc
- :: ChannelId -> PaymentHash -> OnionPacket -> TlvStream -> UpdateAddHtlc
-mkUpdateAddHtlc !cid !ph !onion !tlvs = UpdateAddHtlc
- { updateAddHtlcChannelId = cid
- , updateAddHtlcId = htlcId 0
- , updateAddHtlcAmountMsat = MilliSatoshi 10000000
- , updateAddHtlcPaymentHash = ph
- , updateAddHtlcCltvExpiry = 800000
- , updateAddHtlcOnionPacket = onion
- , updateAddHtlcTlvs = tlvs
- }
-
--- | Construct CommitmentSigned message.
-mkCommitmentSigned :: ChannelId -> Signature -> [Signature] -> CommitmentSigned
-mkCommitmentSigned !cid !sig !htlcSigs = CommitmentSigned
- { commitmentSignedChannelId = cid
- , commitmentSignedSignature = sig
- , commitmentSignedHtlcSignatures = htlcSigs
- }
-
--- Pre-constructed messages ----------------------------------------------------
-
--- | Test OpenChannel message.
-testOpenChannel :: OpenChannel
-testOpenChannel =
- mkOpenChannel testChainHash testChannelId testPoint emptyTlvs
-{-# NOINLINE testOpenChannel #-}
-
--- | Encoded OpenChannel for decode benchmarks.
-encodedOpenChannel :: BS.ByteString
-encodedOpenChannel = encodeOpenChannel testOpenChannel
-{-# NOINLINE encodedOpenChannel #-}
-
--- | Test OpenChannel2 message.
-testOpenChannel2 :: OpenChannel2
-testOpenChannel2 =
- mkOpenChannel2 testChainHash testChannelId testPoint emptyTlvs
-{-# NOINLINE testOpenChannel2 #-}
-
--- | Encoded OpenChannel2 for decode benchmarks.
-encodedOpenChannel2 :: BS.ByteString
-encodedOpenChannel2 = encodeOpenChannel2 testOpenChannel2
-{-# NOINLINE encodedOpenChannel2 #-}
-
--- | Test witness data.
-testWitness :: Witness
-testWitness = Witness (BS.replicate 107 0xab)
-{-# NOINLINE testWitness #-}
-
--- | Multiple witnesses for TxSignatures.
-testWitnesses :: [Witness]
-testWitnesses = replicate 5 testWitness
-{-# NOINLINE testWitnesses #-}
-
--- | Test TxSignatures message.
-testTxSignatures :: TxSignatures
-testTxSignatures = mkTxSignatures testChannelId testTxId testWitnesses
-{-# NOINLINE testTxSignatures #-}
-
--- | Encoded TxSignatures for decode benchmarks.
-encodedTxSignatures :: BS.ByteString
-encodedTxSignatures = case encodeTxSignatures testTxSignatures of
- Right bs -> bs
- Left e -> error $ "encodedTxSignatures: " ++ show e
-{-# NOINLINE encodedTxSignatures #-}
-
--- | Test ClosingSigned message.
-testClosingSigned :: ClosingSigned
-testClosingSigned = mkClosingSigned testChannelId testSignature emptyTlvs
-{-# NOINLINE testClosingSigned #-}
-
--- | Encoded ClosingSigned for decode benchmarks.
-encodedClosingSigned :: BS.ByteString
-encodedClosingSigned = encodeClosingSigned testClosingSigned
-{-# NOINLINE encodedClosingSigned #-}
-
--- | Test UpdateAddHtlc message.
-testUpdateAddHtlc :: UpdateAddHtlc
-testUpdateAddHtlc =
- mkUpdateAddHtlc testChannelId testPaymentHash testOnionPacket emptyTlvs
-{-# NOINLINE testUpdateAddHtlc #-}
-
--- | Encoded UpdateAddHtlc for decode benchmarks.
-encodedUpdateAddHtlc :: BS.ByteString
-encodedUpdateAddHtlc = encodeUpdateAddHtlc testUpdateAddHtlc
-{-# NOINLINE encodedUpdateAddHtlc #-}
-
--- | HTLC signatures for CommitmentSigned.
-testHtlcSigs :: [Signature]
-testHtlcSigs = replicate 10 testSignature
-{-# NOINLINE testHtlcSigs #-}
-
--- | Test CommitmentSigned message.
-testCommitmentSigned :: CommitmentSigned
-testCommitmentSigned =
- mkCommitmentSigned testChannelId testSignature testHtlcSigs
-{-# NOINLINE testCommitmentSigned #-}
-
--- | Encoded CommitmentSigned for decode benchmarks.
-encodedCommitmentSigned :: BS.ByteString
-encodedCommitmentSigned = case encodeCommitmentSigned testCommitmentSigned of
- Right bs -> bs
- Left e -> error $ "encodedCommitmentSigned: " ++ show e
-{-# NOINLINE encodedCommitmentSigned #-}
-
--- | Large HTLC signatures for CommitmentSigned (100).
-testHtlcSigsLarge :: [Signature]
-testHtlcSigsLarge = replicate 100 testSignature
-{-# NOINLINE testHtlcSigsLarge #-}
-
--- | Test CommitmentSigned message (100 sigs).
-testCommitmentSignedLarge :: CommitmentSigned
-testCommitmentSignedLarge =
- mkCommitmentSigned testChannelId testSignature testHtlcSigsLarge
-{-# NOINLINE testCommitmentSignedLarge #-}
-
--- | Encoded large CommitmentSigned for decode benchmarks.
-encodedCommitmentSignedLarge :: BS.ByteString
-encodedCommitmentSignedLarge =
- case encodeCommitmentSigned testCommitmentSignedLarge of
- Right bs -> bs
- Left e -> error $ "encodedCommitmentSignedLarge: " ++ show e
-{-# NOINLINE encodedCommitmentSignedLarge #-}
-
--- | Max HTLC signatures for CommitmentSigned (483).
-testHtlcSigsMax :: [Signature]
-testHtlcSigsMax = replicate 483 testSignature
-{-# NOINLINE testHtlcSigsMax #-}
-
--- | Test CommitmentSigned message (483 sigs).
-testCommitmentSignedMax :: CommitmentSigned
-testCommitmentSignedMax =
- mkCommitmentSigned testChannelId testSignature testHtlcSigsMax
-{-# NOINLINE testCommitmentSignedMax #-}
-
--- | Encoded max CommitmentSigned for decode benchmarks.
-encodedCommitmentSignedMax :: BS.ByteString
-encodedCommitmentSignedMax =
- case encodeCommitmentSigned testCommitmentSignedMax of
- Right bs -> bs
- Left e -> error $ "encodedCommitmentSignedMax: " ++ show e
-{-# NOINLINE encodedCommitmentSignedMax #-}
-
--- Weigh benchmarks ------------------------------------------------------------
-
main :: IO ()
-main = mainWith $ do
- -- V1 message construction and encoding
- wgroup "v1/open_channel" $ do
- func "construct" (mkOpenChannel testChainHash testChannelId testPoint)
- emptyTlvs
- func "encode" encodeOpenChannel testOpenChannel
- func "decode" decodeOpenChannel encodedOpenChannel
-
- -- V2 message construction and encoding
- wgroup "v2/open_channel2" $ do
- func "construct" (mkOpenChannel2 testChainHash testChannelId testPoint)
- emptyTlvs
- func "encode" encodeOpenChannel2 testOpenChannel2
- func "decode" decodeOpenChannel2 encodedOpenChannel2
-
- wgroup "v2/tx_signatures" $ do
- func "construct" (mkTxSignatures testChannelId testTxId) testWitnesses
- func "encode" (forceEncode . encodeTxSignatures) testTxSignatures
- func "decode" decodeTxSignatures encodedTxSignatures
-
- -- Close messages
- wgroup "close/closing_signed" $ do
- func "construct" (mkClosingSigned testChannelId testSignature) emptyTlvs
- func "encode" encodeClosingSigned testClosingSigned
- func "decode" decodeClosingSigned encodedClosingSigned
-
- -- Normal operation (hot paths)
- wgroup "normal/update_add_htlc" $ do
- func "construct"
- (mkUpdateAddHtlc testChannelId testPaymentHash testOnionPacket) emptyTlvs
- func "encode" encodeUpdateAddHtlc testUpdateAddHtlc
- func "decode" decodeUpdateAddHtlc encodedUpdateAddHtlc
-
- wgroup "normal/commitment_signed" $ do
- func "construct" (mkCommitmentSigned testChannelId testSignature)
- testHtlcSigs
- func "encode" (forceEncode . encodeCommitmentSigned) testCommitmentSigned
- func "decode" decodeCommitmentSigned encodedCommitmentSigned
-
- wgroup "normal/commitment_signed_100" $ do
- func "decode" decodeCommitmentSigned encodedCommitmentSignedLarge
-
- wgroup "normal/commitment_signed_483" $ do
- func "decode" decodeCommitmentSigned encodedCommitmentSignedMax
+main = case fixtures of
+ Nothing -> fail "invalid fixtures"
+ Just fx -> mainWith $ do
+ func "baseline (weigh overhead)" (+ (1 :: Int)) 1
+ wgroup "open_channel" $ do
+ func "encode" encode_open_channel (fx_open_channel fx)
+ func "decode" decode_open_channel (fx_open_channel_bytes fx)
+ wgroup "accept_channel2" $ do
+ func "encode" encode_accept_channel2 (fx_accept_channel2 fx)
+ func "decode" decode_accept_channel2 (fx_accept_channel2_bytes fx)
+ wgroup "tx_signatures" $ do
+ func "encode" encode_tx_signatures (fx_tx_signatures fx)
+ func "decode" decode_tx_signatures (fx_tx_signatures_bytes fx)
+ wgroup "closing_complete" $ do
+ func "encode" encode_closing_complete (fx_closing_complete fx)
+ func "decode" decode_closing_complete (fx_closing_complete_bytes fx)
+ wgroup "update_add_htlc" $ do
+ func "encode" encode_update_add_htlc (fx_update_add_htlc fx)
+ func "decode" decode_update_add_htlc (fx_update_add_htlc_bytes fx)
+ func "encode_message" encode_message
+ (MsgUpdateAddHtlc (fx_update_add_htlc fx))
+ func "decode_message" decode_message (fx_update_add_htlc_wire fx)
+ wgroup "update_fulfill_htlc" $ do
+ func "encode" encode_update_fulfill_htlc (fx_update_fulfill_htlc fx)
+ func "decode" decode_update_fulfill_htlc
+ (fx_update_fulfill_htlc_bytes fx)
+ wgroup "commitment_signed" $ do
+ func "encode (0 htlcs)" encode_commitment_signed
+ (fx_commitment_signed fx)
+ func "decode (0 htlcs)" decode_commitment_signed
+ (fx_commitment_signed_bytes fx)
+ func "encode (483 htlcs)" encode_commitment_signed
+ (fx_commitment_signed_483 fx)
+ func "decode (483 htlcs)" decode_commitment_signed
+ (fx_commitment_signed_483_bytes fx)
+ wgroup "revoke_and_ack" $ do
+ func "encode" encode_revoke_and_ack (fx_revoke_and_ack fx)
+ func "decode" decode_revoke_and_ack (fx_revoke_and_ack_bytes fx)
+ wgroup "channel_reestablish" $ do
+ func "encode" encode_channel_reestablish (fx_channel_reestablish fx)
+ func "decode" decode_channel_reestablish
+ (fx_channel_reestablish_bytes fx)
diff --git a/etc/02-peer-protocol.md b/etc/02-peer-protocol.md
@@ -33,6 +33,11 @@ operation, and closing.
* [Sharing funding signatures: `tx_signatures`](#sharing-funding-signatures-tx_signatures)
* [Fee bumping: `tx_init_rbf` and `tx_ack_rbf`](#fee-bumping-tx_init_rbf-and-tx_ack_rbf)
* [Channel Quiescence](#channel-quiescence)
+ * [Channel Splicing](#channel-splicing)
+ * [The `splice_init` Message](#the-splice_init-message)
+ * [The `splice_ack` Message](#the-splice_ack-message)
+ * [Splice Transaction Construction](#splice-transaction-construction)
+ * [Splice Completion](#splice-completion)
* [Channel Close](#channel-close)
* [Closing Initiation: `shutdown`](#closing-initiation-shutdown)
* [Closing Negotiation: `closing_complete` and `closing_sig`](#closing-negotiation-closing_complete-and-closing_sig)
@@ -42,6 +47,7 @@ operation, and closing.
* [`cltv_expiry_delta` Selection](#cltv_expiry_delta-selection)
* [Adding an HTLC: `update_add_htlc`](#adding-an-htlc-update_add_htlc)
* [Removing an HTLC: `update_fulfill_htlc`, `update_fail_htlc`, and `update_fail_malformed_htlc`](#removing-an-htlc-update_fulfill_htlc-update_fail_htlc-and-update_fail_malformed_htlc)
+ * [Batching channel messages](#batching-channel-messages)
* [Committing Updates So Far: `commitment_signed`](#committing-updates-so-far-commitment_signed)
* [Completing the Transition to the Updated State: `revoke_and_ack`](#completing-the-transition-to-the-updated-state-revoke_and_ack)
* [Updating Fees: `update_fee`](#updating-fees-update_fee)
@@ -200,6 +206,13 @@ This message contains a transaction input.
* [`prevtx_len*byte`:`prevtx`]
* [`u32`:`prevtx_vout`]
* [`u32`:`sequence`]
+ * [`tx_add_input_tlvs`:`tlvs`]
+
+1. `tlv_stream`: `tx_add_input_tlvs`
+2. types:
+ 1. type: 0 (`shared_input_txid`)
+ 2. data:
+ * [`sha256`:`funding_txid`]
#### Requirements
@@ -218,11 +231,16 @@ The receiving node:
- MUST add all received inputs to the transaction
- MUST fail the negotiation if:
- `sequence` is set to `0xFFFFFFFE` or `0xFFFFFFFF`
- - the `prevtx` and `prevtx_vout` are identical to a previously added
- (and not removed) input's
- - `prevtx` is not a valid transaction
- - `prevtx_vout` is greater or equal to the number of outputs on `prevtx`
- - the `scriptPubKey` of the `prevtx_vout` output of `prevtx` is not exactly a 1-byte push opcode (for the numeric values `0` to `16`) followed by a data push between 2 and 40 bytes
+ - if `prevtx_len` is `0`:
+ - `shared_input_txid` is not set
+ - `shared_input_txid` and `prevtx_vout` don't match the previous funding output
+ - a previously added (and not removed) input already exists with `shared_input_txid` set
+ - if `prevtx_len` is not `0`:
+ - `prevtx` and `prevtx_vout` are identical to a previously added (and not removed) input
+ - `prevtx` is not a valid transaction
+ - `prevtx_vout` is greater or equal to the number of outputs on `prevtx`
+ - the `scriptPubKey` of the `prevtx_vout` output of `prevtx` is not exactly a 1-byte push
+ opcode (for the numeric values `0` to `16`) followed by a data push between 2 and 40 bytes
- the `serial_id` is already included in the transaction
- the `serial_id` has the wrong parity
- if has received 4096 `tx_add_input` messages during this negotiation
@@ -235,8 +253,10 @@ MAY omit this message.
`serial_id` is a randomly chosen number which uniquely identifies this input.
Inputs in the constructed transaction MUST be sorted by `serial_id`.
-`prevtx` is the serialized transaction that contains the output
-this input spends. Used to verify that the input is non-malleable.
+`prevtx` is the serialized transaction that contains the output this input
+spends, used to verify that the input is non-malleable. It can be ommitted
+(`prevtx_len` set to `0`) when both peers already know that the input is
+non-malleable (e.g. when it is the previous funding output).
`prevtx_vout` is the index of the output being spent.
@@ -393,12 +413,19 @@ the byte size of the input and output counts on the transaction to one (1).
* [`sha256`:`txid`]
* [`u16`:`num_witnesses`]
* [`num_witnesses*witness`:`witnesses`]
+ * [`tx_signatures_tlvs`:`tlvs`]
1. subtype: `witness`
2. data:
* [`u16`:`len`]
* [`len*byte`:`witness_data`]
+1. `tlv_stream`: `tx_signatures_tlvs`
+2. types:
+ 1. type: 0 (`shared_input_signature`)
+ 2. data:
+ * [`signature`:`signature`]
+
#### Requirements
The sending node:
@@ -458,18 +485,28 @@ completed.
#### Requirements
The sender:
- - MUST set `feerate` greater than or equal to 25/24 times the `feerate`
- of the previously constructed transaction, rounded down.
+ - MUST set `feerate` greater than or equal to the maximum of:
+ - 25/24 times the `feerate` of the previously constructed transaction,
+ rounded down.
+ - 25 sat per kw greater than the `feerate` of the previously
+ constructed transaction.
- If it contributes to the transaction's funding output:
- MUST set `funding_output_contribution`
- If it requires the receiving node to only use confirmed inputs:
- MUST set `require_confirmed_inputs`
+ - If it contributed to previous transactions:
+ - MUST ensure that the new transaction double-spends all other attempts,
+ by sending `tx_add_input` with at least one input
+ from each previous transaction construction attempt.
The recipient:
- MUST respond either with `tx_abort` or with `tx_ack_rbf`
- MUST respond with `tx_abort` if:
- - the `feerate` is not greater than or equal to 25/24 times `feerate`
- of the last successfully constructed transaction
+ - the `feerate` is not greater than or equal to the maximum of:
+ - 25/24 times the `feerate` of the last successfully constructed
+ transaction, rounded down.
+ - 25 sat per kw greater than the `feerate` of the last successfully
+ constructed transaction
- MAY send `tx_abort` for any reason
- MUST fail the negotiation if:
- `require_confirmed_inputs` is set but it cannot provide confirmed inputs
@@ -477,11 +514,16 @@ The recipient:
#### Rationale
`feerate` is the feerate this transaction will pay. It must be at least
-1/24 greater than the last used `feerate`, rounded down to the nearest
-satoshi to ensure there is progress.
+the maximum of 25/24 times the previous `feerate` (rounded down) and 25
+sat per kw above the previous `feerate`. The multiplicative rule ensures
+progress at higher feerates, while the additive floor of 25 sat per kw
+(0.1 sat/vB) ensures that the replacement transaction meets BIP125's
+minimum relay fee requirement (default `incrementalRelayFee` of 0.1
+sat/vB since Bitcoin Core v30.0), which the multiplicative increase alone
+could fail to satisfy at low feerates.
-E.g. if the last `feerate` was 520, the next sent `feerate` must be 541
-(520 * 25 / 24 = 541.667, rounded down to 541).
+E.g. if the last `feerate` was 520, the next sent `feerate` must be at
+least 545 (max(520 * 25 / 24, 520 + 25) = max(541, 545) = 545).
If the previous transaction confirms in the middle of an RBF attempt,
the attempt MUST be abandoned.
@@ -514,6 +556,10 @@ The sender:
- MUST set `funding_output_contribution`
- If it requires the receiving node to only use confirmed inputs:
- MUST set `require_confirmed_inputs`
+ - If it contributed to previous transactions:
+ - MUST ensure that the new transaction double-spends all other attempts,
+ by sending `tx_add_input` with at least one input
+ from each previous transaction construction attempt.
The recipient:
- MUST respond with `tx_abort` or with a `tx_add_input` message,
@@ -609,7 +655,6 @@ the `channel_ready` message, the channel is established and can begin
normal operation. The `channel_ready` message includes information
that will be used to construct channel authentication proofs.
-
+-------+ +-------+
| |--(1)--- open_channel ----->| |
| |<-(2)-- accept_channel -----| |
@@ -745,6 +790,7 @@ affect the channel operation).
The currently defined basic types are:
- `option_static_remotekey` (bit 12)
- `option_anchors` and `option_static_remotekey` (bits 22 and 12)
+ - `zero_fee_commitments` (bit 40)
Each basic type has the following variations allowed:
- `option_scid_alias` (bit 46)
@@ -774,14 +820,19 @@ The sending node:
- MUST set it to a defined type representing the type it wants.
- MUST use the smallest bitmap possible to represent the channel type.
- SHOULD NOT set it to a type containing a feature which was not negotiated.
+ - if `channel_type` includes `zero_fee_commitments`:
+ - MUST set `feerate_per_kw` to `0`.
- if `announce_channel` is `true` (not `0`):
- MUST NOT send `channel_type` with the `option_scid_alias` bit set.
The sending node SHOULD:
- set `to_self_delay` sufficient to ensure the sender can irreversibly spend a commitment transaction output, in case of misbehavior by the receiver.
- - set `feerate_per_kw` to at least the rate it estimates would cause the transaction to be immediately included in a block.
- set `dust_limit_satoshis` to a sufficient value to allow commitment transactions to propagate through the Bitcoin network.
- set `htlc_minimum_msat` to the minimum value HTLC it's willing to accept from this peer.
+ - when using `zero_fee_commitments` or `option_anchors`:
+ - set `dust_limit_satoshis` to a sufficient value to ensure that it is economical to spend, taking the cost of HTLC transactions into account.
+ - otherwise (not using `zero_fee_commitments` or `option_anchors`):
+ - set `feerate_per_kw` to at least the rate it estimates would cause the transaction to be immediately included in a block.
The receiving node MUST:
- ignore undefined bits in `channel_flags`.
@@ -801,14 +852,18 @@ The receiving node MAY fail the channel if:
- it considers `max_htlc_value_in_flight_msat` too small.
- it considers `channel_reserve_satoshis` too large.
- it considers `max_accepted_htlcs` too small.
- - it considers `dust_limit_satoshis` too large.
+ - it considers `dust_limit_satoshis` too large (see [BOLT 3](03-transactions.md#dust-limits)).
The receiving node MUST fail the channel if:
- the `chain_hash` value is set to a hash of a chain that is unknown to the receiver.
- `push_msat` is greater than `funding_satoshis` * 1000.
- `to_self_delay` is unreasonably large.
- - `max_accepted_htlcs` is greater than 483.
- - it considers `feerate_per_kw` too small for timely processing or unreasonably large.
+ - `channel_type` includes `zero_fee_commitments` and:
+ - `max_accepted_htlcs` is greater than 114.
+ - `feerate_per_kw` is not `0`.
+ - `channel_type` does not include `zero_fee_commitments` and:
+ - `max_accepted_htlcs` is greater than 483.
+ - it considers `feerate_per_kw` too small for timely processing or unreasonably large.
- `funding_pubkey`, `revocation_basepoint`, `htlc_basepoint`, `payment_basepoint`, or `delayed_payment_basepoint`
are not valid secp256k1 pubkeys in compressed format.
- `dust_limit_satoshis` is greater than `channel_reserve_satoshis`.
@@ -842,7 +897,10 @@ are above both `dust_limit_satoshis`.
The receiver should not accept large `dust_limit_satoshis`, as this could be
used in griefing attacks, where the peer publishes its commitment with a lot
-of dust htlcs, which effectively become miner fees.
+of dust htlcs, which effectively become miner fees. But it must allow values
+higher than the standard Bitcoin Core dust limits, since HTLC outputs need to
+be spent by a second-stage transaction at a feerate matching the current
+on-chain feerate.
Details for how to handle a channel failure can be found in [BOLT 5:Failing a Channel](05-onchain.md#failing-a-channel).
@@ -1012,6 +1070,7 @@ The sender:
- if it is not the node opening the channel:
- SHOULD wait until the funding transaction has reached `minimum_depth` before
sending this message.
+ - MUST wait for at least 100 blocks if the funding transaction is the coinbase transaction.
- MUST set `second_per_commitment_point` to the per-commitment point to be used
for commitment transaction #1, derived as specified in
[BOLT #3](03-transactions.md#per-commitment-secret-requirements).
@@ -1161,6 +1220,8 @@ If nodes have negotiated `option_dual_fund`:
The sending node:
- MUST set `channel_type`
- MUST set `funding_feerate_perkw` to the feerate for this transaction
+ - if `channel_type` includes `zero_fee_commitments`:
+ - MUST set `commitment_feerate_perkw` to `0`.
- If it requires the receiving node to only use confirmed inputs:
- MUST set `require_confirmed_inputs`
@@ -1169,6 +1230,7 @@ The receiving node:
- the `locktime` is unacceptable
- the `funding_feerate_perkw` is unacceptable
- MUST fail the negotiation if:
+ - `channel_type` includes `zero_fee_commitments` and `commitment_feerate_perkw` is not `0`.
- `require_confirmed_inputs` is set but it cannot provide confirmed inputs
- `channel_type` is not set
@@ -1396,7 +1458,10 @@ a transaction paying more fees to make the channel confirm faster.
#### Requirements
The sender of `tx_init_rbf`:
- - MUST be the *initiator*
+ - MAY be either the *initiator* or the *accepter*
+ - If the sender is the accepter, it becomes the initiator of the `interactive-tx` session and thus:
+ - MUST send `tx_add_output` for the channel output
+ - MUST pay the fees for the shared transaction fields
- MUST NOT have sent or received a `channel_ready` message.
The recipient:
@@ -1419,6 +1484,10 @@ a large feerate change, instead sets their `sats` to zero, and decline to
participate further in the channel funding: by not contributing, they
may obtain incoming liquidity at no cost.
+We allow both nodes to initiate RBF, because any one of them may want to take
+this opportunity to contribute additional funds to the channel without
+waiting for the initial funding transaction to confirm.
+
## Channel Quiescence
Various fundamental changes, in particular protocol upgrades, are
@@ -1487,6 +1556,493 @@ channel state significantly more complex to maintain. This introduces the
derivative property that it is impossible to batch multiple downstream protocols
in the same quiescence session.
+## Channel Splicing
+
+Splicing is the term given for replacing the funding transaction with
+a new one. For simplicity, splicing takes place once a channel is
+[quiescent](#channel-quiescence).
+
+Operation returns to normal once the splice transaction has been signed
+(while waiting for one of the splice transactions to confirm), at which
+point the channel isn't quiescent anymore.
+
+The splice is finally terminated when both sides send `splice_locked`
+to indicate that one of the splice transactions reached acceptable depth.
+
+ +-------+ +-------+
+ | |--- splice_init -------------->| |
+ | A |<--------------- splice_ack ---| B |
+ | | | |
+ | |--- tx_add_input ------------->| |
+ | |<------------- tx_add_input ---| |
+ | |--- tx_add_input ------------->| |
+ | |<------------ tx_add_output ---| |
+ | |--- tx_add_output ------------>| |
+ | |<-------------- tx_complete ---| |
+ | |--- tx_add_output ------------>| |
+ | |<-------------- tx_complete ---| |
+ | |--- tx_complete -------------->| |
+ | | | |
+ | |--- commit_sig --------------->| |
+ | |<--------------- commit_sig ---| |
+ | |--- tx_signatures ------------>| |
+ | |<------------ tx_signatures ---| |
+ | | | |
+ | | <RESUME CHANNEL> | |
+ | | | |
+ | |--- update_add_htlc ---------->| |
+ | |--- commit_sig --------------->| |
+ | |--- commit_sig --------------->| |
+ | |<----------- revoke_and_ack ---| |
+ | |<--------------- commit_sig ---| |
+ | |<--------------- commit_sig ---| |
+ | |--- revoke_and_ack ----------->| |
+ | | | |
+ | | <RBF> | |
+ | | | |
+ | |<-------------- tx_init_rbf ---| |
+ | |--- tx_ack_rbf --------------->| |
+ | |<------------- tx_add_input ---| |
+ | |--- tx_add_input ------------->| |
+ | |<------------- tx_add_input ---| |
+ | |--- tx_add_output ------------>| |
+ | |<------------ tx_add_output ---| |
+ | |--- tx_complete -------------->| |
+ | |<------------ tx_add_output ---| |
+ | |--- tx_complete -------------->| |
+ | |<-------------- tx_complete ---| |
+ | | | |
+ | |<--------------- commit_sig ---| |
+ | |--- commit_sig --------------->| |
+ | |--- tx_signatures ------------>| |
+ | |<------------ tx_signatures ---| |
+ | | | |
+ | | <RESUME CHANNEL> | |
+ | | | |
+ | |--- update_add_htlc ---------->| |
+ | |--- commit_sig --------------->| |
+ | |--- commit_sig --------------->| |
+ | |--- commit_sig --------------->| |
+ | |<----------- revoke_and_ack ---| |
+ | |<--------------- commit_sig ---| |
+ | |<--------------- commit_sig ---| |
+ | |<--------------- commit_sig ---| |
+ | |--- revoke_and_ack ----------->| |
+ | | | |
+ | | <SPLICE COMPLETION> | |
+ | | | |
+ | |--- splice_locked ------------>| |
+ | |<------------ splice_locked ---| |
+ | | | |
+ | | <RESUME CHANNEL> | |
+ | | | |
+ | |--- update_add_htlc ---------->| |
+ | |--- commit_sig --------------->| |
+ | |<----------- revoke_and_ack ---| |
+ | |<--------------- commit_sig ---| |
+ | |--- revoke_and_ack ----------->| |
+ | | | |
+ +-------+ +-------+
+
+### The `splice_init` Message
+
+1. type: 80 (`splice_init`)
+2. data:
+ * [`channel_id`:`channel_id`]
+ * [`s64`:`funding_contribution_satoshis`]
+ * [`u32`:`funding_feerate_perkw`]
+ * [`u32`:`locktime`]
+ * [`point`:`funding_pubkey`]
+ * [`splice_init_tlvs`:`tlvs`]
+
+1. `tlv_stream`: `splice_init_tlvs`
+2. types:
+ 1. type: 2 (`require_confirmed_inputs`)
+
+`funding_contribution_satoshis` is the amount the sender is adding to their
+channel balance (splice-in) or removing from their channel balance (splice-out).
+
+#### Requirements
+
+The sending node:
+ - MUST NOT send `splice_init` if the channel is not quiescent.
+ - MUST NOT send `splice_init` if it is not the quiescence initiator.
+ - MUST NOT send `splice_init` before sending and receiving `channel_ready`.
+ - MUST NOT send `splice_init` while another splice is being negotiated.
+ - MUST NOT send `splice_init` if another splice has been negotiated but
+ `splice_locked` has not been sent and received.
+ - MUST NOT send `splice_init` if it has previously sent `shutdown`.
+ - MUST set `funding_feerate_perkw` to the feerate for the splice transaction.
+ - If it is splicing funds out of the channel:
+ - MUST set `funding_contribution_satoshis` to a negative value matching
+ the amount that will be subtracted from its current channel balance.
+ - If it is splicing funds into the channel:
+ - MUST set `funding_contribution_satoshis` to a positive value matching
+ the amount that will be added to its current channel balance.
+ - If it requires the receiving node to only use confirmed inputs:
+ - MUST set `require_confirmed_inputs`.
+ - SHOULD use a different `funding_pubkey` than the one used for the
+ previous funding transaction.
+
+The receiving node:
+ - If the channel is not quiescent:
+ - MUST send a `warning` and close the connection or send an `error`
+ and fail the channel.
+ - If the sending node is not the quiescence initiator:
+ - MUST send a `warning` and close the connection or send an `error`
+ and fail the channel.
+ - If another splice is already being negotiated:
+ - MUST send a `warning` and close the connection or send an `error`
+ and fail the channel.
+ - If another splice has been negotiated but isn't locked yet:
+ - MUST send a `warning` and close the connection or send an `error`
+ and fail the channel.
+ - If it has received `shutdown`:
+ - MUST send a `warning` and close the connection or send an `error`
+ and fail the channel.
+ - If the `funding_feerate_perkw` is unacceptable:
+ - MUST respond with `tx_abort`.
+ - If `funding_contribution_satoshis` is negative and its absolute value is
+ greater than the sending node's current channel balance:
+ - MUST send a `warning` and close the connection or send an `error`
+ and fail the channel.
+ - If it accepts the splice attempt:
+ - MUST respond with `splice_ack`.
+ - Otherwise (it rejects the splice):
+ - MUST respond with `tx_abort`.
+
+### The `splice_ack` Message
+
+1. type: 81 (`splice_ack`)
+2. data:
+ * [`channel_id`:`channel_id`]
+ * [`s64`:`funding_contribution_satoshis`]
+ * [`point`:`funding_pubkey`]
+ * [`splice_ack_tlvs`:`tlvs`]
+
+1. `tlv_stream`: `splice_ack_tlvs`
+2. types:
+ 1. type: 2 (`require_confirmed_inputs`)
+
+#### Requirements
+
+The sending node:
+ - SHOULD use a different `funding_pubkey` than the one used for the
+ previous funding transaction.
+ - MAY set `funding_contribution_satoshis` to `0` if they don't want
+ to contribute to the splice.
+ - If it requires the receiving node to only use confirmed inputs:
+ - MUST set `require_confirmed_inputs`.
+
+The receiving node:
+ - If it has sent `splice_init`:
+ - If `funding_contribution_satoshis` is negative and its absolute value is
+ greater than the sending node's current channel balance:
+ - MUST send a `warning` and close the connection or send an `error`
+ and fail the channel.
+ - If it accepts the splice attempt:
+ - MUST start an `interactive-tx` session to create the splice transaction.
+ - Otherwise:
+ - MUST reject the splice attempt by sending `tx_abort`.
+ - Otherwise (it has not sent `splice_init`):
+ - MUST send a `warning` and close the connection or send an `error`
+ and fail the channel.
+
+### Splice Transaction Construction
+
+The splice transaction is created using the
+[Interactive Transaction Construction](#interactive-transaction-construction)
+protocol, with the following additional requirements.
+
+#### The `tx_add_input` Message
+
+##### Requirements
+
+The sending node:
+ - If it is the splice initiator:
+ - MUST add the current channel input to the splice transaction by
+ sending `tx_add_input` with `shared_input_txid` containing the
+ `txid` of the previous funding transaction.
+ - MUST NOT include `prevtx` for that shared input.
+ - MUST set `prevtx_vout` to the previous funding output index.
+ - If the receiver set `require_confirmed_inputs` in `splice_init`,
+ `splice_ack`, `tx_init_rbf` or `tx_ack_rbf`:
+ - MUST NOT send a `tx_add_input` that contains an unconfirmed input.
+
+The receiving node:
+ - If `shared_input_txid` is set:
+ - If it doesn't match the `txid` of the previous funding transaction:
+ - MUST fail the negotiation by sending `tx_abort`.
+ - If `prevtx_vout` doesn't match the previous funding output index:
+ - MUST fail the negotiation by sending `tx_abort`.
+
+##### Rationale
+
+The splice transaction must spend the current channel funding output. The
+splice initiator is responsible for adding that input to the transaction,
+and pay the fees for its weight. It would be wasteful to transmit the
+previous funding transaction in the `prevtx` field, and wouldn't even
+be possible for funding transactions that exceed 65kB, so we only transmit
+its `txid` using the `shared_input_txid` field.
+
+#### The `tx_add_output` Message
+
+##### Requirements
+
+The sending node:
+ - If it is the splice initiator:
+ - MUST send at least one `tx_add_output`, which contains the new
+ channel's funding output based on the `funding_pubkey`s from
+ `splice_init` and `splice_ack`.
+ - MUST set the amount of that `tx_add_output` to the previous
+ channel capacity with the `funding_contribution_satoshis`s from
+ `splice_init` and `splice_ack` applied.
+
+##### Rationale
+
+The splice initiator is responsible for adding the new channel funding
+output to the transaction and paying the fees for its weight.
+
+#### The `tx_complete` Message
+
+##### Requirements
+
+The receiving node:
+ - MUST compute the channel balance for each side by adding their respective
+ `funding_contribution_satoshis` to their previous channel balance.
+ - MUST fail the negotiation by sending `tx_abort` if:
+ - There is not exactly one input spending the current funding transaction.
+ - There is not exactly one channel funding output using the funding public
+ keys and funding contributions from `splice_init` and `splice_ack`.
+ - This is an RBF attempt and the transaction's total fees is less than
+ the last successfully negotiated splice transaction's fees.
+ - Either side has added an output other than the channel funding output
+ and the balance for that side is less than the channel reserve that
+ matches the new channel capacity.
+
+##### Rationale
+
+If a side does not meet the reserve requirements, that's OK: but if they take
+funds out of the channel, they must ensure that they do meet them. If your peer
+adds a massive amount to the channel, then you only have to add more reserve if
+you want to contribute to the splice (and you can use `tx_remove_output` and/or
+`tx_remove_input` part-way through if this happens).
+
+#### The `commitment_signed` Message
+
+After exchanging `tx_complete`, both peers send `commitment_signed` to commit
+to the splice transaction by creating a commitment transaction spending the
+new channel funding output.
+
+The usual [`commitment_signed`](#committing-updates-so-far-commitment_signed)
+requirements apply with the following additions.
+
+##### Requirements
+
+The sending node:
+ - MUST create a commitment transaction that spends the splice funding output and:
+ - Adds `funding_contribution_satoshis` from `splice_init` and `splice_ack`
+ to the main balance of their respective sender.
+ - Uses the same feerate as the existing commitment transaction.
+ - Uses the same `commitment_number` as the existing commitment transaction.
+ - MUST send signatures for pending HTLCs.
+ - MUST remember the details of this splice transaction.
+
+The receiving node:
+ - MUST NOT respond with `revoke_and_ack`.
+ - If it has not already transmitted its `commitment_signed`:
+ - MUST send `commitment_signed`.
+ - If it should sign first, as specified in the [`tx_signatures` requirements](#the-tx_signatures-message):
+ - MUST send `tx_signatures`.
+ - Note that since the initiator sends `tx_add_input` for the shared input
+ (corresponding to the previous channel output), 100% of the previous channel
+ capacity is attributed to the initiator when computing who must send
+ `tx_signatures` first (instead of using each node's previous balance).
+
+On reconnection:
+ - If `next_funding` matches the splice transaction:
+ - MUST retransmit `commitment_signed`.
+
+##### Rationale
+
+Once peers are ready to exchange commitment signatures, they must remember
+the details of the splice transaction to allow resuming the signatures
+exchange if a disconnection happens.
+
+#### The `tx_signatures` Message
+
+##### Requirements
+
+The sending node:
+ - MUST set `shared_input_signature` to a valid ECDSA signature for the
+ `tx_add_input` spending the previous channel funding output using the
+ `funding_pubkey` that matches this input.
+
+The receiving node:
+ - If `shared_input_signature` is not set:
+ - MUST send an `error` and fail the channel.
+ - If `shared_input_signature` is not valid or non-compliant with the
+ LOW-S-standard rule<sup>[LOWS](https://github.com/bitcoin/bitcoin/pull/6769)</sup>:
+ - MUST send an `error` and fail the channel.
+ - MUST consider the channel no longer quiescent.
+
+On reconnection:
+ - If `next_funding` matches the splice transaction:
+ - MUST retransmit `tx_signatures`.
+
+##### Rationale
+
+Spending the channel funding output requires a signature from both peers.
+Each peer transmits its own signature, which allows creating a valid
+witness for the shared input without adding an additional message.
+
+Once `tx_signatures` have been exchanged, the splice transaction can be
+broadcast. The channel is no longer quiescent: normal operation can resume
+while waiting for the transaction to confirm and `splice_locked` messages
+to be exchanged.
+
+#### The `tx_init_rbf` Message
+
+##### Requirements
+
+The sending node:
+ - MUST NOT send `tx_init_rbf` if the channel is not quiescent.
+ - MUST NOT send `tx_init_rbf` if it is not the quiescence initiator.
+ - MAY send `tx_init_rbf` even if it is not the splice initiator.
+ - If there are more than 10 pending RBF attempts:
+ - MUST set a high enough `feerate` to ensure quick confirmation.
+ - MUST NOT send `tx_init_rbf` if it has previously sent `splice_locked`.
+ - MUST NOT send `tx_init_rbf` if `option_zeroconf` has been negotiated.
+ - MAY set `funding_output_contribution` to a different value than the
+ `funding_contribution_satoshis` used in `splice_init` or `splice_ack`,
+ or in previous RBF attempts.
+
+The receiving node:
+ - If the channel is not quiescent:
+ - MUST send a `warning` and close the connection or send an `error`
+ and fail the channel.
+ - If the sending node is not the quiescence initiator:
+ - MUST send a `warning` and close the connection or send an `error`
+ and fail the channel.
+ - If another RBF attempt has been created recently:
+ - SHOULD send `tx_abort` to reject this RBF attempt and wait for the
+ previous RBF attempt to confirm.
+ - If there are more than 10 pending RBF attempts and the `feerate` is not
+ high enough to ensure quick confirmation:
+ - SHOULD send `tx_abort` to reject the RBF attempt.
+ - If the sender previously sent `splice_locked`:
+ - MUST send a `warning` and close the connection or send an `error`
+ and fail the channel.
+ - If `option_zeroconf` has been negotiated:
+ - MUST send a `warning` and close the connection or send an `error`
+ and fail the channel.
+ - If `funding_output_contribution` is negative and its absolute value is
+ greater than the sending node's current channel balance:
+ - MUST send a `warning` and close the connection or send an `error`
+ and fail the channel.
+
+##### Rationale
+
+Splice transactions can be RBF-ed to react to changes in the mempool feerate.
+We allow both nodes to initiate RBF, because any one of them may want to take
+this opportunity to splice additional funds into or out of the channel without
+waiting for the initial splice transaction to confirm.
+
+We limit the number of pending RBF attempts, otherwise we may reach the
+`batch_size` limit defined in [`start_batch`](#batching-channel-messages).
+We require using a large enough feerate when we've already created many RBF
+attempts, and we wait between RBF attempts to allow a previous attempt to
+confirm.
+
+Since splice transactions always spend the current channel funding output, the
+RBF attempts automatically double-spend each other. We thus disallow RBF when
+`option_zeroconf` has been negotiated, because that creates a risk of losing
+funds.
+
+#### The `tx_ack_rbf` Message
+
+##### Requirements
+
+The sending node:
+ - MAY set `funding_output_contribution` to a different value than the
+ `funding_contribution_satoshis` used in `splice_init` or `splice_ack`,
+ or in previous RBF attempts.
+
+The receiving node:
+ - If `funding_output_contribution` is negative and its absolute value is
+ greater than the sending node's current channel balance:
+ - MUST send a `warning` and close the connection or send an `error`
+ and fail the channel.
+
+### Splice Completion
+
+Once splice transactions have been signed but haven't reached acceptable
+depth, channel operations go back to normal and HTLCs can be exchanged,
+with the caveat that payments must be valid for all splice transactions.
+
+Nodes keep track of multiple commitment transactions (one for the current
+funding transaction and one for each splice transaction) and exchange
+signatures for each of these commitment transactions.
+
+```
++------------+ +-----------+
+| Funding Tx |---+--->| Commit Tx |
++------------+ | +-----------+
+ | +-----------+ +-----------+
+ +--->| Splice Tx |----------->| Commit Tx |
+ | +-----------+ +-----------+
+ | +---------------+ +-----------+
+ +--->| Splice RBF #1 |------->| Commit Tx |
+ | +---------------+ +-----------+
+ | +---------------+ +-----------+
+ +--->| Splice RBF #2 |------->| Commit Tx |
+ +---------------+ +-----------+
+```
+
+The splice completes by exchanging `splice_locked` messages, at which point
+the locked transaction replaces the previous funding transaction.
+
+#### The `splice_locked` Message
+
+1. type: 77 (`splice_locked`)
+2. data:
+ * [`channel_id`:`channel_id`]
+ * [`sha256`:`splice_txid`]
+
+##### Requirements
+
+Each node:
+ - If any splice transaction reaches acceptable depth:
+ - MUST send `splice_locked` with the `txid` of that transaction.
+ - If `option_zeroconf` has been negotiated:
+ - SHOULD send `splice_locked` immediately after exchanging `tx_signatures`.
+
+The receiving node:
+ - If `splice_txid` doesn't match any of its pending splice transactions:
+ - MUST send a `warning` and close the connection, or send an `error` and
+ fail the channel.
+
+Once a node has sent and received `splice_locked`:
+ - If the `splice_txid`s match:
+ - MUST stop sending `commitment_signed` for RBF attempts and ancestors
+ of this splice transaction.
+ - MAY discard RBF attempts and ancestor transactions.
+ - If `announce_channel` is set for this channel:
+ - MUST send `announcement_signatures` with `short_channel_id` matching
+ this splice transaction.
+ - If the `splice_txid`s are for different RBF candidates:
+ - SHOULD ignore the message.
+ - MAY send an `error` and fail the channel.
+
+##### Rationale
+
+If nodes are on a different fork of the blockchain, they may disagree on which
+RBF attempt has been confirmed: in that case nodes can either close the channel
+or simply ignore `splice_locked` and wait for one of the forks to eventually
+replace the other, at which point both nodes should agree on which RBF attempt
+confirmed and exchange `splice_locked` for the same `splice_txid` to complete
+the splice.
+
## Channel Close
Nodes can negotiate a mutual close of the connection, which unlike a
@@ -1597,6 +2153,7 @@ A sending node:
- if there are updates pending on the receiving node's commitment transaction:
- MUST NOT send a `shutdown`.
- MUST NOT send multiple `shutdown` messages.
+ - MUST NOT send `shutdown` if there is a splice transaction that isn't locked yet.
- MUST NOT send an `update_add_htlc` after a `shutdown`.
- if no HTLCs remain in either commitment transaction (including dust HTLCs)
and neither side has a pending `revoke_and_ack` to send:
@@ -2208,9 +2765,9 @@ A node:
The `max_dust_htlc_exposure_msat` is an upper bound on the trimmed balance from
dust exposure. The exact value used is a matter of node policy.
-For channels that don't use `option_anchors`, an increase of
-the `feerate_per_kw` may trim multiple htlcs from commitment transactions,
-which could create a large increase in dust exposure.
+For channels that don't use `zero_fee_commitments` or `option_anchors`, an
+increase of the `feerate_per_kw` may trim multiple htlcs from commitment
+transactions, which could create a large increase in dust exposure.
### Adding an HTLC: `update_add_htlc`
@@ -2241,26 +2798,27 @@ is destined, is described in [BOLT #4](04-onion-routing.md).
#### Requirements
A sending node:
- - if it is _responsible_ for paying the Bitcoin fee:
- - MUST NOT offer `amount_msat` if, after adding that HTLC to its commitment
- transaction, it cannot pay the fee for either the local or remote commitment
- transaction at the current `feerate_per_kw` while maintaining its channel
- reserve (see [Updating Fees](#updating-fees-update_fee)).
- - if `option_anchors` applies to this commitment transaction and the sending
- node is the funder:
- - MUST be able to additionally pay for `to_local_anchor` and
- `to_remote_anchor` above its reserve.
- - SHOULD NOT offer `amount_msat` if, after adding that HTLC to its commitment
- transaction, its remaining balance doesn't allow it to pay the commitment
- transaction fee when receiving or sending a future additional non-dust HTLC
- while maintaining its channel reserve. It is recommended that this "fee spike
- buffer" can handle twice the current `feerate_per_kw` to ensure predictability
- between implementations.
- - if it is _not responsible_ for paying the Bitcoin fee:
- - SHOULD NOT offer `amount_msat` if, once the remote node adds that HTLC to
- its commitment transaction, it cannot pay the fee for the updated local or
- remote transaction at the current `feerate_per_kw` while maintaining its
- channel reserve.
+ - if `zero_fee_commitments` has not been negotiated:
+ - if it is _responsible_ for paying the Bitcoin fee:
+ - MUST NOT offer `amount_msat` if, after adding that HTLC to its commitment
+ transaction, it cannot pay the fee for either the local or remote commitment
+ transaction at the current `feerate_per_kw` while maintaining its channel
+ reserve (see [Updating Fees](#updating-fees-update_fee)).
+ - if `option_anchors` applies to this commitment transaction and the sending
+ node is the funder:
+ - MUST be able to additionally pay for `to_local_anchor` and
+ `to_remote_anchor` above its reserve.
+ - SHOULD NOT offer `amount_msat` if, after adding that HTLC to its commitment
+ transaction, its remaining balance doesn't allow it to pay the commitment
+ transaction fee when receiving or sending a future additional non-dust HTLC
+ while maintaining its channel reserve. It is recommended that this "fee spike
+ buffer" can handle twice the current `feerate_per_kw` to ensure predictability
+ between implementations.
+ - if it is _not responsible_ for paying the Bitcoin fee:
+ - SHOULD NOT offer `amount_msat` if, once the remote node adds that HTLC to
+ its commitment transaction, it cannot pay the fee for the updated local or
+ remote transaction at the current `feerate_per_kw` while maintaining its
+ channel reserve.
- MUST offer `amount_msat` greater than 0.
- MUST NOT offer `amount_msat` below the receiving node's `htlc_minimum_msat`
- MUST set `cltv_expiry` less than 500000000.
@@ -2275,6 +2833,8 @@ A sending node:
- MUST increase the value of `id` by 1 for each successive offer.
- if it is relaying a payment inside a blinded route:
- MUST set `path_key` (see [Route Blinding](04-onion-routing.md#route-blinding))
+ - if a splice is pending:
+ - MUST ensure that requirements are met for all commmitment transactions.
`id` MUST NOT be reset to 0 after the update is complete (i.e. after `revoke_and_ack` has
been received). It MUST continue incrementing instead.
@@ -2306,6 +2866,8 @@ A receiving node:
- MUST respond with an error as detailed in [Failure Messages](04-onion-routing.md#failure-messages)
- Otherwise:
- MUST follow the requirements for the reader of `payload` in [Payload Format](04-onion-routing.md#payload-format)
+ - If a splice is pending:
+ - MUST ensure that requirements are met for all commmitment transactions.
The `onion_routing_packet` contains an obfuscated list of hops and instructions for each hop along the path.
It commits to the HTLC by setting the `payment_hash` as associated data, i.e. includes the `payment_hash` in the computation of HMACs.
@@ -2329,18 +2891,25 @@ sides send the maximum number of HTLCs, the `commitment_signed` message will
still be under the maximum message size. It also ensures that
a single penalty transaction can spend the entire commitment transaction,
as calculated in [BOLT #5](05-onchain.md#penalty-transaction-weight-calculation).
+When using `zero_fee_commitments`, we further limit `max_accepted_htlcs` to
+114 because v3 transactions are limited to 10kvB, which decreases the number
+of outputs the commitment transaction can have.
`cltv_expiry` values equal to or greater than 500000000 would indicate a time in
seconds, and the protocol only supports an expiry in blocks.
-The node _responsible_ for paying the Bitcoin fee should maintain a "fee
-spike buffer" on top of its reserve to accommodate a future fee increase.
+When `zero_fee_commitments` is not used, the node _responsible_ for paying
+the Bitcoin fee should maintain a "fee spike buffer" on top of its reserve
+to accommodate a future fee increase.
Without this buffer, the node _responsible_ for paying the Bitcoin fee may
reach a state where it is unable to send or receive any non-dust HTLC while
maintaining its channel reserve (because of the increased weight of the
commitment transaction), resulting in a degraded channel. See [#728](https://github.com/lightningnetwork/lightning-rfc/issues/728)
for more details.
+If splicing is supported, there can be more than one commitment transaction
+at a time: proposed changes must be valid for all of them.
+
### Removing an HTLC: `update_fulfill_htlc`, `update_fail_htlc`, and `update_fail_malformed_htlc`
For simplicity, a node can only remove HTLCs added by the other node.
@@ -2360,6 +2929,15 @@ To supply the preimage:
2. data:
* [`20*u32`:`htlc_hold_times`]
* [`210*sha256[..4]`:`truncated_hmacs`]
+ 1. type: 3 (`fulfillment_payload`)
+ 2. data:
+ * [`...*byte`:`fulfillment_payload`]
+
+The `fulfillment_payload` field is an opaque encrypted blob for the benefit of
+the original HTLC initiator, as defined in
+[BOLT #4](04-onion-routing.md#successful-payments). It mirrors the `reason`
+field of `update_fail_htlc`: the final node originates it, and intermediate
+nodes obfuscate and relay it.
For a timed out or route-failed HTLC:
@@ -2416,6 +2994,8 @@ A node:
- When supporting `option_attribution_data`:
- if `path_key` is not set in the incoming `update_add_htlc`:
- MUST initialize `attribution_data` and include it in `update_fail_htlc` and `update_fulfill_htlc`. See [BOLT04](04-onion-routing.md).
+ - if a `fulfillment_payload` is present in the `update_fulfill_htlc` received from the downstream node:
+ - MUST obfuscate and relay it in the outgoing `update_fulfill_htlc`, including in a blinded path. See [BOLT04](04-onion-routing.md).
A receiving node:
- if the `id` does not correspond to an HTLC in its current commitment transaction:
@@ -2425,6 +3005,8 @@ A receiving node:
doesn't SHA256 hash to the corresponding HTLC `payment_hash`:
- MUST send a `warning` and close the connection, or send an
`error` and fail the channel.
+ - if the `fulfillment_payload` in `update_fulfill_htlc` is longer than 32768 bytes (32 KiB):
+ - MUST send an `error` and fail the channel.
- if the `BADONION` bit in `failure_code` is not set for
`update_fail_malformed_htlc`:
- MUST send a `warning` and close the connection, or send an
@@ -2458,6 +3040,60 @@ such detection is left as an option.
Nodes inside a blinded route must use `invalid_onion_blinding` to avoid
leaking information to senders trying to probe the blinded route.
+### Batching channel messages
+
+Multiple channel messages can be grouped together as a single logical message
+using the `start_batch` message.
+
+1. type: 127 (`start_batch`)
+2. data:
+ * [`channel_id`:`channel_id`]
+ * [`u16`:`batch_size`]
+
+1. `tlv_stream`: `start_batch_tlvs`
+2. types:
+ 1. type: 1 (`message_type`)
+ 2. data:
+ * [`u16`:`message_type`]
+
+#### Requirements
+
+A sending node:
+ - MUST set `batch_size` to a value strictly greater than 1.
+ - MUST set `batch_size` to a value lower than or equal to 20.
+ - MUST set `message_type` to `132` (`commitment_signed` message type as
+ defined in [Bolt 1](./01-messaging.md#lightning-message-format)).
+ - After sending `start_batch`:
+ - MUST send `batch_size` `commitment_signed` messages for the same
+ `channel_id`, without any other unrelated messages in-between.
+
+A receiving node:
+ - If `batch_size` is not strictly greater than 1:
+ - MUST ignore the `start_batch` message.
+ - SHOULD send a `warning`.
+ - If `batch_size` is strictly greater than 20:
+ - MUST send a `warning` and close the connection, or send an `error` and
+ fail the channel.
+ - MUST group the next `batch_size` messages and process them together.
+ - If one of those messages is not for the specified `channel_id`:
+ - MUST send a `warning` and close the connection, or send an `error` and
+ fail the channel.
+ - If `message_type` is missing or not set to the type for `commitment_signed`:
+ - MUST ignore the `start_batch` message and process the following messages
+ sequentially.
+
+#### Rationale
+
+The `start_batch` message is only used when sending multiple `commitment_signed`
+messages during splicing. We thus narrow the requirements for this specific
+scenario: they can be relaxed in the future if we use `start_batch` for other
+features.
+
+We limit the `batch_size` to 20 elements to protect against excessive queuing
+that could be abused to DoS receiving nodes. The `start_batch` message is only
+used for splice RBF attempts so far, which shouldn't need that many attempts
+to get transactions confirmed.
+
### Committing Updates So Far: `commitment_signed`
When a node has changes for the remote commitment, it can apply them,
@@ -2470,6 +3106,13 @@ sign the resulting transaction (as defined in [BOLT #3](03-transactions.md)), an
* [`signature`:`signature`]
* [`u16`:`num_htlcs`]
* [`num_htlcs*signature`:`htlc_signature`]
+ * [`commitment_signed_tlvs`:`tlvs`]
+
+1. `tlv_stream`: `commitment_signed_tlvs`
+2. types:
+ 1. type: 1 (`funding_txid`)
+ 2. data:
+ * [`sha256`:`funding_txid`]
#### Requirements
@@ -2484,8 +3127,19 @@ change the commitment transaction aside from the new revocation number
fee changes).
- MUST include one `htlc_signature` for every HTLC transaction corresponding
to the ordering of the commitment transaction (see [BOLT #3](03-transactions.md#transaction-input-and-output-ordering)).
+ - MUST set `funding_txid` to the funding transaction spent by this commitment
+ transaction.
- if it has not recently received a message from the remote node:
- SHOULD use `ping` and await the reply `pong` before sending `commitment_signed`.
+ - If there are `N` pending splice transactions (with `N` greater than `0`):
+ - MUST send `start_batch` first with `batch_size` set to `N + 1` and
+ `message_type` set to `132` (`commitment_signed`).
+ - MUST send `commitment_signed` for the current channel funding output.
+ - MUST send `commitment_signed` for each of the splice transactions.
+ - MUST set `funding_txid` in each `commitment_signed` message to match the
+ funding transaction spent by that commitment transaction.
+ - MUST NOT send any other message before it has sent the batch of
+ `commitment_signed` messages.
A receiving node:
- once all pending updates are applied:
@@ -2499,7 +3153,28 @@ A receiving node:
- if any `htlc_signature` is not valid for the corresponding HTLC transaction OR non-compliant with LOW-S-standard rule <sup>[LOWS](https://github.com/bitcoin/bitcoin/pull/6769)</sup>:
- MUST send a `warning` and close the connection, or send an
`error` and fail the channel.
- - MUST respond with a `revoke_and_ack` message.
+ - If there are pending splice transactions and the sending node did not
+ send `start_batch` followed by a batch of `commitment_signed` messages:
+ - MUST send an `error` and fail the channel.
+ - If the sending node sent `start_batch` and we are processing a batch of
+ `commitment_signed` messages:
+ - If `funding_txid` is missing in one of the `commitment_signed` messages:
+ - MUST send an `error` and fail the channel.
+ - If there are pending splice transactions:
+ - MUST validate each `commitment_signed` based on `funding_txid`.
+ - If `commitment_signed` is missing for a funding transaction:
+ - MUST send an `error` and fail the channel.
+ - Otherwise:
+ - MUST respond with a `revoke_and_ack` message.
+ - Otherwise (no pending splice transactions):
+ - MUST ignore `commitment_signed` where `funding_txid` does not match
+ the current funding transaction.
+ - If `commitment_signed` is missing for the current funding transaction:
+ - MUST send an `error` and fail the channel.
+ - Otherwise:
+ - MUST respond with a `revoke_and_ack` message.
+ - Otherwise:
+ - MUST respond with a `revoke_and_ack` message.
#### Rationale
@@ -2519,8 +3194,14 @@ the case of offered HTLCs being timed out or received HTLCs being spent. This
is done to reduce fees by creating smaller scripts compared to explicitly
stating time-locks on HTLC outputs.
-The `option_anchors` allows HTLC transactions to "bring their own fees" by
-attaching other inputs and outputs, hence the modified signature flags.
+Splicing requires us to send and receive additional signatures, as we don't
+know which (if any) of the splice transactions will end up being the new
+channel funding transaction. We use `start_batch` to send a batch of
+`commitment_signed` messages containing signatures for each of the pending
+splice transactions and for the current funding transaction. After sending
+`splice_locked`, we may receive a batch containing obsolete `commitment_signed`
+messages from our peer that they started sending before receiving our
+`splice_locked`: we can safely ignore them by filtering on `funding_txid`.
### Completing the Transition to the Updated State: `revoke_and_ack`
@@ -2549,6 +3230,8 @@ A sending node:
the previous commitment transaction.
- MUST set `next_per_commitment_point` to the values for its next commitment
transaction.
+ - MUST send a single `revoke_and_ack` message, even if it is responding to
+ a batch of `commitment_signed` messages.
A receiving node:
- if `per_commitment_secret` is not a valid secret key or does not generate the previous `per_commitment_point`:
@@ -2566,8 +3249,9 @@ A node:
### Updating Fees: `update_fee`
-An `update_fee` message is sent by the node which is paying the
-Bitcoin fee. Like any update, it's first committed to the receiver's
+For channels that don't use `zero_fee_commitments`, an `update_fee`
+message is sent by the node which is paying the Bitcoin fee.
+Like any update, it's first committed to the receiver's
commitment transaction and then (once acknowledged) committed to the
sender's. Unlike an HTLC, `update_fee` is never closed but simply
replaced.
@@ -2588,6 +3272,9 @@ given in [BOLT #3](03-transactions.md#fee-calculation).
#### Requirements
+When using `zero_fee_commitments`, nodes:
+ - MUST NOT send `update_fee`.
+
The node _responsible_ for paying the Bitcoin fee:
- SHOULD send `update_fee` to ensure the current fee rate is sufficient (by a
significant margin) for timely processing of the commitment transaction.
@@ -2604,8 +3291,12 @@ A sending node:
- if the dust balance of the local transaction at the updated `feerate_per_kw` is greater than `max_dust_htlc_exposure_msat`:
- MAY NOT send `update_fee`
- MAY fail the channel
+ - if a splice is pending:
+ - MUST ensure that requirements are met for all commmitment transactions.
A receiving node:
+ - if `zero_fee_commitments` is used:
+ - MUST send an `error` and fail the channel.
- if the `update_fee` is too low for timely processing, OR is unreasonably large:
- MUST send a `warning` and close the connection, or send an
`error` and fail the channel.
@@ -2623,6 +3314,8 @@ A receiving node:
- MAY fail the channel
- if the dust balance of the local transaction at the updated `feerate_per_kw` is greater than `max_dust_htlc_exposure_msat`:
- MAY fail the channel
+ - if a splice is pending:
+ - MUST ensure that requirements are met for all commmitment transactions.
#### Rationale
@@ -2630,7 +3323,9 @@ Bitcoin fees are required for unilateral closes to be effective.
With `option_anchors`, `feerate_per_kw` is not as critical anymore to guarantee
confirmation as it was in the legacy commitment format, but it still needs to
be enough to be able to enter the mempool (satisfy min relay fee and mempool
-min fee).
+min fee). With `zero_fee_commitments`, transactions can enter the mempool
+as a package with a child transaction paying the fees: channel transactions
+thus don't need to directly include a fee, so this message isn't used.
For the legacy commitment format, there is no general method for the
broadcasting node to use child-pays-for-parent to increase its effective fee.
@@ -2651,6 +3346,9 @@ be trimmed at the updated feerate, this could overflow the configured
`max_dust_htlc_exposure_msat`. Whether to close the channel preemptively
or not is left as a matter of node policy.
+If splicing is supported, there can be more than one commitment transaction
+at a time: proposed changes must be valid for all of them.
+
## Message Retransmission
Because communication transports are unreliable, and may need to be
@@ -2683,9 +3381,14 @@ messages are), they are independent of requirements here.
1. `tlv_stream`: `channel_reestablish_tlvs`
2. types:
- 1. type: 0 (`next_funding`)
+ 1. type: 1 (`next_funding`)
2. data:
* [`sha256`:`next_funding_txid`]
+ * [`byte`:`retransmit_flags`]
+ 1. type: 5 (`my_current_funding_locked`)
+ 2. data:
+ * [`sha256`:`my_current_funding_locked_txid`]
+ * [`byte`:`retransmit_flags`]
`next_commitment_number`: A commitment number is a 48-bit
incrementing counter for each commitment transaction; counters
@@ -2693,6 +3396,22 @@ are independent for each peer in the channel and start at 0.
They're only explicitly relayed to the other node in the case of
re-establishment, otherwise they are implicit.
+The `next_funding.retransmit_flags` bitfield is used to let the
+receiving peer know which messages they must retransmit for the
+corresponding `next_funding_txid` after the reconnection:
+
+| Bit Position | Name |
+| ------------- | --------------------|
+| 0 | `commitment_signed` |
+
+The `my_current_funding_locked.retransmit_flags` bitfield is used
+to let our peer know which messages we expect them to retransmit
+after the reconnection:
+
+| Bit Position | Name |
+| ------------- | --------------------------|
+| 0 | `announcement_signatures` |
+
### Requirements
A funding node:
@@ -2739,13 +3458,35 @@ The sending node:
- MUST set `your_last_per_commitment_secret` to the last `per_commitment_secret` it received
- if it has sent `commitment_signed` for an interactive transaction construction but
it has not received `tx_signatures`:
+ - MUST include the `next_funding` TLV.
- MUST set `next_funding_txid` to the txid of that interactive transaction.
+ - if it has not received `commitment_signed` for this `next_funding_txid`:
+ - MUST set the `commitment_signed` bit in `retransmit_flags`.
- otherwise:
- - MUST NOT set `next_funding_txid`.
+ - MUST NOT include the `next_funding` TLV.
+ - if `option_splice` was negotiated:
+ - if a splice transaction reached acceptable depth while disconnected:
+ - MUST include `my_current_funding_locked` with the txid of the latest such transaction.
+ - otherwise, if it has already sent `splice_locked` for any transaction:
+ - MUST include `my_current_funding_locked` with the txid of the last `splice_locked` it sent.
+ - otherwise, if it has already sent `channel_ready`:
+ - MUST include `my_current_funding_locked` with the txid of the channel funding transaction.
+ - otherwise (it has never sent `channel_ready` or `splice_locked`):
+ - MUST NOT include `my_current_funding_locked`.
+ - if `my_current_funding_locked` is included:
+ - if `announce_channel` is set for this channel:
+ - if it has not received `announcement_signatures` for that transaction:
+ - MUST set the `announcement_signatures` bit to `1` in `retransmit_flags`.
+ - otherwise:
+ - MUST set the `announcement_signatures` bit to `0` in `retransmit_flags`.
A node:
+ - if `next_commitment_number` is zero:
+ - MUST immediately fail the channel and broadcast any relevant latest commitment
+ transaction.
- if `next_commitment_number` is 1 in both the `channel_reestablish` it
- sent and received:
+ sent and received, and none of those `channel_reestablish` messages
+ contain `my_current_funding_locked` or `next_funding` for a splice transaction:
- MUST retransmit `channel_ready`.
- otherwise:
- MUST NOT retransmit `channel_ready`, but MAY send `channel_ready` with
@@ -2756,12 +3497,8 @@ A node:
the last `commitment_signed` message the receiving node has sent:
- MUST reuse the same commitment number for its next `commitment_signed`.
- otherwise:
- - if `next_commitment_number` is not 1 greater than the
- commitment number of the last `commitment_signed` message the receiving
- node has sent:
- - SHOULD send an `error` and fail the channel.
- - if it has not sent `commitment_signed`, AND `next_commitment_number`
- is not equal to 1:
+ - if `next_commitment_number` is not equal to the commitment number of the
+ next `commitment_signed` that the receiving node would send:
- SHOULD send an `error` and fail the channel.
- if `next_revocation_number` is equal to the commitment number of
the last `revoke_and_ack` the receiving node sent, AND the receiving node
@@ -2791,19 +3528,34 @@ A node:
- SHOULD send an `error` and fail the channel.
A receiving node:
- - if `next_funding_txid` is set:
+ - if the `next_funding` TLV is set:
- if `next_funding_txid` matches the latest interactive funding transaction:
- if it has not received `tx_signatures` for that funding transaction:
- - MUST retransmit its `commitment_signed` for that funding transaction.
+ - if the `commitment_signed` bit is set in `retransmit_flags`:
+ - MUST retransmit its `commitment_signed` for that funding transaction.
- if it has already received `commitment_signed` and it should sign first,
as specified in the [`tx_signatures` requirements](#the-tx_signatures-message):
- MUST send its `tx_signatures` for that funding transaction.
- if it has already received `tx_signatures` for that funding transaction:
- MUST send its `tx_signatures` for that funding transaction.
+ - if it also sets `next_funding` in its own `channel_reestablish`, but the
+ values don't match:
+ - MUST send an `error` and fail the channel.
- otherwise:
- MUST send `tx_abort` to let the sending node know that they can forget
this funding transaction.
+A receiving node:
+ - if splice transactions are pending and `my_current_funding_locked` matches one of
+ those splice transactions, for which it hasn't received `splice_locked` yet:
+ - MUST process `my_current_funding_locked` as if it was receiving `splice_locked`
+ for this `txid`.
+ - if `my_current_funding_locked` is included with the `announcement_signatures` bit
+ set in the `retransmit_flags`:
+ - if `announce_channel` is set for this channel and the receiving node is ready
+ to send `announcement_signatures` for the corresponding splice transaction:
+ - MUST retransmit `announcement_signatures`.
+
A node:
- MUST NOT assume that previously-transmitted messages were lost,
- if it has sent a previous `commitment_signed` message:
@@ -2858,20 +3610,10 @@ commitment number 0 is created during opening.
`commitment_signed` for commitment number 1 is send and then
the revocation for commitment number 0 is received.
-`channel_ready` is implicitly acknowledged by the start of normal
-operation, which is known to have begun after a `commitment_signed` has been
-received — hence, the test for a `next_commitment_number` greater
-than 1.
-
-A previous draft insisted that the funder "MUST remember ...if it has
-broadcast the funding transaction, otherwise it MUST NOT": this was in
-fact an impossible requirement. A node must either firstly commit to
-disk and secondly broadcast the transaction or vice versa. The new
-language reflects this reality: it's surely better to remember a
-channel which hasn't been broadcast than to forget one which has!
-Similarly, for the fundee's `funding_signed` message: it's better to
-remember a channel that never opens (and times out) than to let the
-funder open it while the fundee has forgotten it.
+`channel_ready` is implicitly acknowledged by the start of normal operation,
+which is known to have begun after a `commitment_signed` has been received
+(hence, the test for a `next_commitment_number` greater than 1) or after a
+splice transaction has been created.
A node, which has somehow fallen
behind (e.g. has been restored from old backup), can detect that it has fallen
@@ -2883,11 +3625,22 @@ transaction to the chain. The other node should wait for that `error` to give
the fallen-behind node an opportunity to fix its state first (e.g by restarting
with a different backup).
-`next_funding_txid` allows peers to finalize the signing steps of an
+The `next_funding` TLV allows peers to finalize the signing steps of an
interactive transaction construction, or safely abort that transaction
if it was not signed by one of the peers, who has thus already removed
it from its state.
+`my_current_funding_locked` is equivalent to sending `splice_locked`, but is
+handled atomically during `channel_reestablish` (instead of requiring a
+retransmission of the `splice_locked` message). This is useful to avoid race
+conditions with channel updates (for more details about this race condition,
+see [this example](./bolt02/splicing-test.md#disconnection-with-concurrent-splice_locked)).
+It handles the case where the `splice_locked` message was lost during the
+disconnection, or when a splice transaction reaches acceptable depth while
+peers are disconnected. It also allows requesting a retransmission of the
+`announcement_signatures` message for the latest splice transaction, in case
+it wasn't received before disconnecting.
+
# Authors
[ FIXME: Insert Author List ]
diff --git a/flake.lock b/flake.lock
@@ -152,16 +152,19 @@
"nixpkgs"
],
"ppad-base16": "ppad-base16",
+ "ppad-bolt9": [
+ "ppad-bolt9"
+ ],
"ppad-nixpkgs": [
"ppad-nixpkgs"
]
},
"locked": {
- "lastModified": 1783709539,
- "narHash": "sha256-bXqV4/qYZFbZeG8PHlnr+PVyTZ3E0ZIi+mgCu49iamw=",
+ "lastModified": 1791625140,
+ "narHash": "sha256-DgMZKJlpLQcrNLSuzOM+bF2QQKsaVKigzSjkyOEockQ=",
"ref": "master",
- "rev": "507af14c14be9fbaa27992357aa25e40c443daee",
- "revCount": 33,
+ "rev": "b4b4b507bf0be00435a15c448ef2366ed0c22581",
+ "revCount": 43,
"type": "git",
"url": "git://git.ppad.tech/bolt1.git"
},
@@ -171,6 +174,37 @@
"url": "git://git.ppad.tech/bolt1.git"
}
},
+ "ppad-bolt9": {
+ "inputs": {
+ "flake-utils": [
+ "ppad-bolt9",
+ "ppad-nixpkgs",
+ "flake-utils"
+ ],
+ "nixpkgs": [
+ "ppad-bolt9",
+ "ppad-nixpkgs",
+ "nixpkgs"
+ ],
+ "ppad-nixpkgs": [
+ "ppad-nixpkgs"
+ ]
+ },
+ "locked": {
+ "lastModified": 1791624953,
+ "narHash": "sha256-DWafVJvu2LTXkAI/zH0Q0BqTrjLo0c7hyTvaW/9N0VM=",
+ "ref": "master",
+ "rev": "280946ab905a374c8c6d4a37678a4cc362551ab9",
+ "revCount": 39,
+ "type": "git",
+ "url": "git://git.ppad.tech/bolt9.git"
+ },
+ "original": {
+ "ref": "master",
+ "type": "git",
+ "url": "git://git.ppad.tech/bolt9.git"
+ }
+ },
"ppad-nixpkgs": {
"inputs": {
"flake-utils": "flake-utils",
@@ -245,11 +279,11 @@
"ppad-sha256": "ppad-sha256"
},
"locked": {
- "lastModified": 1783709517,
- "narHash": "sha256-iNne+qla9/ntt62Z+i9HR4QH99l/tUZCTD8i45sX0iY=",
+ "lastModified": 1791624263,
+ "narHash": "sha256-IJAffs2Cx/IjSTpNPubVlrzHLqRLUFu6XQp9yRIRbdU=",
"ref": "master",
- "rev": "0654d3f60af6e63109bf05224d15905fc5b70fc1",
- "revCount": 31,
+ "rev": "65a561493940b59c5415b4b1409b4e32dae5c08f",
+ "revCount": 33,
"type": "git",
"url": "git://git.ppad.tech/tx.git"
},
@@ -270,6 +304,7 @@
"nixpkgs"
],
"ppad-bolt1": "ppad-bolt1",
+ "ppad-bolt9": "ppad-bolt9",
"ppad-nixpkgs": "ppad-nixpkgs",
"ppad-tx": "ppad-tx"
}
diff --git a/flake.nix b/flake.nix
@@ -7,6 +7,13 @@
url = "git://git.ppad.tech/bolt1.git";
ref = "master";
inputs.ppad-nixpkgs.follows = "ppad-nixpkgs";
+ inputs.ppad-bolt9.follows = "ppad-bolt9";
+ };
+ ppad-bolt9 = {
+ type = "git";
+ url = "git://git.ppad.tech/bolt9.git";
+ ref = "master";
+ inputs.ppad-nixpkgs.follows = "ppad-nixpkgs";
};
ppad-nixpkgs = {
type = "git";
@@ -23,7 +30,8 @@
nixpkgs.follows = "ppad-nixpkgs/nixpkgs";
};
- outputs = { self, nixpkgs, flake-utils, ppad-nixpkgs, ppad-bolt1, ppad-tx }:
+ outputs = { self, nixpkgs, flake-utils, ppad-nixpkgs
+ , ppad-bolt1, ppad-bolt9, ppad-tx }:
flake-utils.lib.eachDefaultSystem (system:
let
lib = "ppad-bolt2";
@@ -34,10 +42,7 @@
clang = pkgs.llvmPackages_19.clang;
bolt1 = ppad-bolt1.packages.${system}.default;
- bolt1-llvm =
- hlib.addBuildTools
- (hlib.enableCabalFlag bolt1 "llvm")
- [ llvm clang ];
+ bolt9 = ppad-bolt9.packages.${system}.default;
tx = ppad-tx.packages.${system}.default;
tx-llvm =
@@ -46,7 +51,8 @@
[ llvm clang ];
hpkgs = pkgs.haskell.packages.ghc910.extend (new: old: {
- ppad-bolt1 = bolt1-llvm;
+ ppad-bolt1 = bolt1;
+ ppad-bolt9 = bolt9;
ppad-tx = tx-llvm;
${lib} = new.callCabal2nix lib ./. {
ppad-bolt1 = new.ppad-bolt1;
diff --git a/lib/Lightning/Protocol/BOLT2.hs b/lib/Lightning/Protocol/BOLT2.hs
@@ -6,128 +6,187 @@
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
--- Peer protocol for the Lightning Network, per
--- [BOLT #2](https://github.com/lightning/bolts/blob/master/02-peer-protocol.md).
+-- The peer protocol of the Lightning Network, per
+-- [BOLT #2](https://github.com/lightning/bolts/blob/master/02-peer-protocol.md):
+-- the messages for channel establishment (v1 and v2), interactive
+-- transaction construction, quiescence, channel close, normal operation
+-- and message retransmission.
+--
+-- Fundamental types (channel ids, points, signatures, amounts, TLV
+-- streams) come from ppad-bolt1, transaction ids from ppad-tx, and
+-- feature vectors from ppad-bolt9.
+--
+-- Each message has a payload codec, @encode_\<msg\>@ and
+-- @decode_\<msg\>@; 'encode_message' and 'decode_message' handle
+-- complete messages, including the type. Decoders consume the whole
+-- payload: bytes after the fixed fields are the message's TLV stream.
+-- Known TLV records are decoded into typed fields, an unknown even
+-- record fails the decode, and unknown odd records are kept in the
+-- message's @_tlvs@ field, so re-encoding a decoded message reproduces
+-- its bytes.
+--
+-- The examples below assume:
+--
+-- >>> :set -XOverloadedStrings
+-- >>> import qualified Data.ByteString as BS
+-- >>> import qualified Lightning.Protocol.BOLT1 as BOLT1
+-- >>> import Lightning.Protocol.BOLT2
+-- >>> let Just cid = BOLT1.channel_id (BS.replicate 32 0xab)
+--
+-- Encode a message, and decode it again:
+--
+-- >>> let fee = UpdateFee cid 2500 BOLT1.empty_tlv_stream
+-- >>> let Right wire = encode_message (MsgUpdateFee fee)
+-- >>> BS.length wire
+-- 38
+-- >>> decode_message wire == Right (MsgUpdateFee fee)
+-- True
+--
+-- Unknown odd TLV records are preserved, and unknown even ones
+-- rejected:
+--
+-- >>> let payload = encode_update_fee fee
+-- >>> fmap update_fee_tlvs (decode_update_fee (payload <> "\x05\x01\x2a"))
+-- Right (TlvStream [TlvRecord {tlv_type = 5, tlv_value = "*"}])
+-- >>> decode_update_fee (payload <> "\x04\x01\x2a")
+-- Left (DecodeTlvError (TlvUnknownEvenType 4))
module Lightning.Protocol.BOLT2 (
- -- * Core types
- -- | Re-exported from "Lightning.Protocol.BOLT2.Types".
- module Lightning.Protocol.BOLT2.Types
-
- -- * Message types
- -- | Re-exported from "Lightning.Protocol.BOLT2.Messages".
- , module Lightning.Protocol.BOLT2.Messages
-
- -- * Codec functions
- -- | Re-exported from "Lightning.Protocol.BOLT2.Codec".
- , module Lightning.Protocol.BOLT2.Codec
-
- -- $messagetypes
-
- -- ** Channel establishment (v1)
- -- $v1establishment
-
- -- ** Channel establishment (v2)
- -- $v2establishment
+ -- * Messages
+ Message(..)
+ , message_type
+
+ -- ** Channel establishment v1
+ , OpenChannel(..)
+ , AcceptChannel(..)
+ , FundingCreated(..)
+ , FundingSigned(..)
+ , ChannelReady(..)
+
+ -- ** Channel establishment v2
+ , OpenChannel2(..)
+ , AcceptChannel2(..)
+
+ -- ** Interactive transaction construction
+ , TxAddInput(..)
+ , TxAddOutput(..)
+ , TxRemoveInput(..)
+ , TxRemoveOutput(..)
+ , TxComplete(..)
+ , TxSignatures(..)
+ , TxInitRbf(..)
+ , TxAckRbf(..)
+ , TxAbort(..)
+
+ -- ** Channel quiescence
+ , Stfu(..)
-- ** Channel close
- -- $close
+ , Shutdown(..)
+ , ClosingComplete(..)
+ , ClosingSig(..)
+ , ClosingSigned(..)
-- ** Normal operation
- -- $normal
-
- -- ** Message reestablishment
- -- $reestablish
+ , UpdateAddHtlc(..)
+ , UpdateFulfillHtlc(..)
+ , UpdateFailHtlc(..)
+ , UpdateFailMalformedHtlc(..)
+ , CommitmentSigned(..)
+ , RevokeAndAck(..)
+ , UpdateFee(..)
+
+ -- ** Message retransmission
+ , ChannelReestablish(..)
+
+ -- * Field types
+ , HtlcId(..)
+ , SerialId(..)
+ , ScriptPubKey
+ , script_pubkey
+ , un_script_pubkey
+ , Witness
+ , witness
+ , un_witness
+ , OnionRoutingPacket
+ , onion_routing_packet
+ , un_onion_routing_packet
+ , OnionHash
+ , onion_hash
+ , un_onion_hash
+ , AttributionData
+ , attribution_data
+ , un_attribution_data
+ , FeeRange(..)
+ , NextFunding(..)
+
+ -- * Encoding and decoding messages
+ , encode_message
+ , decode_message
+ , EncodeError(..)
+ , DecodeError(..)
+
+ -- ** Payloads
+ , encode_open_channel
+ , decode_open_channel
+ , encode_accept_channel
+ , decode_accept_channel
+ , encode_funding_created
+ , decode_funding_created
+ , encode_funding_signed
+ , decode_funding_signed
+ , encode_channel_ready
+ , decode_channel_ready
+ , encode_open_channel2
+ , decode_open_channel2
+ , encode_accept_channel2
+ , decode_accept_channel2
+ , encode_tx_add_input
+ , decode_tx_add_input
+ , encode_tx_add_output
+ , decode_tx_add_output
+ , encode_tx_remove_input
+ , decode_tx_remove_input
+ , encode_tx_remove_output
+ , decode_tx_remove_output
+ , encode_tx_complete
+ , decode_tx_complete
+ , encode_tx_signatures
+ , decode_tx_signatures
+ , encode_tx_init_rbf
+ , decode_tx_init_rbf
+ , encode_tx_ack_rbf
+ , decode_tx_ack_rbf
+ , encode_tx_abort
+ , decode_tx_abort
+ , encode_stfu
+ , decode_stfu
+ , encode_shutdown
+ , decode_shutdown
+ , encode_closing_complete
+ , decode_closing_complete
+ , encode_closing_sig
+ , decode_closing_sig
+ , encode_closing_signed
+ , decode_closing_signed
+ , encode_update_add_htlc
+ , decode_update_add_htlc
+ , encode_update_fulfill_htlc
+ , decode_update_fulfill_htlc
+ , encode_update_fail_htlc
+ , decode_update_fail_htlc
+ , encode_update_fail_malformed_htlc
+ , decode_update_fail_malformed_htlc
+ , encode_commitment_signed
+ , decode_commitment_signed
+ , encode_revoke_and_ack
+ , decode_revoke_and_ack
+ , encode_update_fee
+ , decode_update_fee
+ , encode_channel_reestablish
+ , decode_channel_reestablish
) where
import Lightning.Protocol.BOLT2.Codec
import Lightning.Protocol.BOLT2.Messages
import Lightning.Protocol.BOLT2.Types
-
--- $messagetypes
---
--- BOLT #2 defines the following message types:
---
--- * 2: stfu
--- * 32: open_channel
--- * 33: accept_channel
--- * 34: funding_created
--- * 35: funding_signed
--- * 36: channel_ready
--- * 38: shutdown
--- * 39: closing_signed
--- * 40: closing_complete
--- * 41: closing_sig
--- * 64: open_channel2
--- * 65: accept_channel2
--- * 66: tx_add_input
--- * 67: tx_add_output
--- * 68: tx_remove_input
--- * 69: tx_remove_output
--- * 70: tx_complete
--- * 71: tx_signatures
--- * 72: tx_init_rbf
--- * 73: tx_ack_rbf
--- * 74: tx_abort
--- * 128: update_add_htlc
--- * 130: update_fulfill_htlc
--- * 131: update_fail_htlc
--- * 132: commitment_signed
--- * 133: revoke_and_ack
--- * 134: update_fee
--- * 135: update_fail_malformed_htlc
--- * 136: channel_reestablish
-
--- $v1establishment
---
--- Channel establishment v1 messages:
---
--- * open_channel (32)
--- * accept_channel (33)
--- * funding_created (34)
--- * funding_signed (35)
--- * channel_ready (36)
-
--- $v2establishment
---
--- Channel establishment v2 (interactive-tx) messages:
---
--- * open_channel2 (64)
--- * accept_channel2 (65)
--- * tx_add_input (66)
--- * tx_add_output (67)
--- * tx_remove_input (68)
--- * tx_remove_output (69)
--- * tx_complete (70)
--- * tx_signatures (71)
--- * tx_init_rbf (72)
--- * tx_ack_rbf (73)
--- * tx_abort (74)
-
--- $close
---
--- Channel close messages:
---
--- * stfu (2)
--- * shutdown (38)
--- * closing_signed (39)
--- * closing_complete (40)
--- * closing_sig (41)
-
--- $normal
---
--- Normal operation messages:
---
--- * update_add_htlc (128)
--- * update_fulfill_htlc (130)
--- * update_fail_htlc (131)
--- * commitment_signed (132)
--- * revoke_and_ack (133)
--- * update_fee (134)
--- * update_fail_malformed_htlc (135)
-
--- $reestablish
---
--- Message reestablishment:
---
--- * channel_reestablish (136)
diff --git a/lib/Lightning/Protocol/BOLT2/Codec.hs b/lib/Lightning/Protocol/BOLT2/Codec.hs
@@ -1,7 +1,6 @@
-{-# OPTIONS_HADDOCK prune #-}
+{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DerivingStrategies #-}
-- |
-- Module: Lightning.Protocol.BOLT2.Codec
@@ -9,1348 +8,1381 @@
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
--- Encode/decode functions for BOLT #2 messages.
+-- Encoding and decoding of BOLT #2 messages.
module Lightning.Protocol.BOLT2.Codec (
- -- * Error types
EncodeError(..)
, DecodeError(..)
- -- * Channel establishment v1
- , encodeOpenChannel
- , decodeOpenChannel
- , encodeAcceptChannel
- , decodeAcceptChannel
- , encodeFundingCreated
- , decodeFundingCreated
- , encodeFundingSigned
- , decodeFundingSigned
- , encodeChannelReady
- , decodeChannelReady
-
- -- * Channel establishment v2 (interactive-tx)
- , encodeOpenChannel2
- , decodeOpenChannel2
- , encodeAcceptChannel2
- , decodeAcceptChannel2
- , encodeTxAddInput
- , decodeTxAddInput
- , encodeTxAddOutput
- , decodeTxAddOutput
- , encodeTxRemoveInput
- , decodeTxRemoveInput
- , encodeTxRemoveOutput
- , decodeTxRemoveOutput
- , encodeTxComplete
- , decodeTxComplete
- , encodeTxSignatures
- , decodeTxSignatures
- , encodeTxInitRbf
- , decodeTxInitRbf
- , encodeTxAckRbf
- , decodeTxAckRbf
- , encodeTxAbort
- , decodeTxAbort
-
- -- * Channel close
- , encodeStfu
- , decodeStfu
- , encodeShutdown
- , decodeShutdown
- , encodeClosingSigned
- , decodeClosingSigned
- , encodeClosingComplete
- , decodeClosingComplete
- , encodeClosingSig
- , decodeClosingSig
-
- -- * Normal operation
- , encodeUpdateAddHtlc
- , decodeUpdateAddHtlc
- , encodeUpdateFulfillHtlc
- , decodeUpdateFulfillHtlc
- , encodeUpdateFailHtlc
- , decodeUpdateFailHtlc
- , encodeUpdateFailMalformedHtlc
- , decodeUpdateFailMalformedHtlc
- , encodeCommitmentSigned
- , decodeCommitmentSigned
- , encodeRevokeAndAck
- , decodeRevokeAndAck
- , encodeUpdateFee
- , decodeUpdateFee
-
- -- * Channel reestablishment
- , encodeChannelReestablish
- , decodeChannelReestablish
+ , encode_message
+ , decode_message
+
+ , encode_open_channel
+ , decode_open_channel
+ , encode_accept_channel
+ , decode_accept_channel
+ , encode_funding_created
+ , decode_funding_created
+ , encode_funding_signed
+ , decode_funding_signed
+ , encode_channel_ready
+ , decode_channel_ready
+
+ , encode_open_channel2
+ , decode_open_channel2
+ , encode_accept_channel2
+ , decode_accept_channel2
+ , encode_tx_add_input
+ , decode_tx_add_input
+ , encode_tx_add_output
+ , decode_tx_add_output
+ , encode_tx_remove_input
+ , decode_tx_remove_input
+ , encode_tx_remove_output
+ , decode_tx_remove_output
+ , encode_tx_complete
+ , decode_tx_complete
+ , encode_tx_signatures
+ , decode_tx_signatures
+ , encode_tx_init_rbf
+ , decode_tx_init_rbf
+ , encode_tx_ack_rbf
+ , decode_tx_ack_rbf
+ , encode_tx_abort
+ , decode_tx_abort
+
+ , encode_stfu
+ , decode_stfu
+
+ , encode_shutdown
+ , decode_shutdown
+ , encode_closing_complete
+ , decode_closing_complete
+ , encode_closing_sig
+ , decode_closing_sig
+ , encode_closing_signed
+ , decode_closing_signed
+
+ , encode_update_add_htlc
+ , decode_update_add_htlc
+ , encode_update_fulfill_htlc
+ , decode_update_fulfill_htlc
+ , encode_update_fail_htlc
+ , decode_update_fail_htlc
+ , encode_update_fail_malformed_htlc
+ , decode_update_fail_malformed_htlc
+ , encode_commitment_signed
+ , decode_commitment_signed
+ , encode_revoke_and_ack
+ , decode_revoke_and_ack
+ , encode_update_fee
+ , decode_update_fee
+
+ , encode_channel_reestablish
+ , decode_channel_reestablish
) where
+import Bitcoin.Prim.Tx (TxId(..), mkTxId)
import Control.DeepSeq (NFData)
-import Control.Monad (unless)
import qualified Data.ByteString as BS
-import Data.Word (Word8, Word16, Word32)
+import qualified Data.ByteString.Unsafe as BU
+import Data.Int (Int64)
+import Data.Word (Word8, Word16, Word32, Word64)
import GHC.Generics (Generic)
+import qualified Lightning.Protocol.BOLT1 as BOLT1
import Lightning.Protocol.BOLT1
- ( TlvStream
- , unsafeTlvStream
- , TlvError
- , encodeU16
- , encodeU32
- , encodeU64
- , decodeU16
- , decodeU32
- , decodeU64
- , encodeTlvStream
- , decodeTlvStreamRaw
- )
-import Lightning.Protocol.BOLT2.Types
+ ( ChannelId, Signature, Point, TlvRecord(..), TlvStream, TlvError )
+import qualified Lightning.Protocol.BOLT9 as BOLT9
import Lightning.Protocol.BOLT2.Messages
+import Lightning.Protocol.BOLT2.Types
--- Error types -----------------------------------------------------------------
+-- errors ---------------------------------------------------------------------
--- | Encoding errors.
+-- | Why a message failed to encode.
data EncodeError
- = EncodeLengthOverflow -- ^ Payload exceeds u16 max (65535 bytes)
- deriving stock (Eq, Show, Generic)
+ = EncodeLengthOverflow
+ -- ^ a length-prefixed field or a counted list exceeds 65535
+ | EncodeInvalidTlvs
+ -- ^ a @_tlvs@ field contains a record of a type the message knows
+ | EncodeMessageTooLarge
+ -- ^ the message (type and payload) exceeds 65535 bytes
+ deriving (Eq, Show, Generic)
instance NFData EncodeError
--- | Decoding errors.
+-- | Why a message failed to decode.
data DecodeError
= DecodeInsufficientBytes
- | DecodeInvalidLength
- | DecodeInvalidChannelId
- | DecodeInvalidChainHash
- | DecodeInvalidSignature
+ -- ^ the input ended before a field did
| DecodeInvalidPoint
- | DecodeInvalidTxId
- | DecodeInvalidPaymentHash
- | DecodeInvalidPaymentPreimage
- | DecodeInvalidOnionPacket
- | DecodeInvalidSecret
+ -- ^ a point lacks a compressed-encoding prefix
+ | DecodeInvalidAmount
+ -- ^ an amount exceeds 21 million BTC
| DecodeInvalidInitiator
+ -- ^ the @initiator@ byte of @stfu@ is neither 0 nor 1
| DecodeTlvError !TlvError
- deriving stock (Eq, Show, Generic)
+ -- ^ the message's TLV stream is malformed, or has an unknown even
+ -- type
+ | DecodeInvalidTlvValue !Word64
+ -- ^ a known TLV record (of the given type) has a malformed value
+ | DecodeUnknownEvenType !Word16
+ -- ^ a message type that BOLT #2 doesn't define (even)
+ | DecodeUnknownOddType !Word16
+ -- ^ a message type that BOLT #2 doesn't define (odd)
+ deriving (Eq, Show, Generic)
instance NFData DecodeError
--- Helpers ---------------------------------------------------------------------
-
--- | Decode a single byte.
-decodeU8 :: BS.ByteString -> Maybe (Word8, BS.ByteString)
-decodeU8 !bs
- | BS.null bs = Nothing
- | otherwise = Just (BS.index bs 0, BS.drop 1 bs)
-{-# INLINE decodeU8 #-}
-
--- | Decode fixed-size bytes.
-decodeBytes :: Int -> BS.ByteString -> Maybe (BS.ByteString, BS.ByteString)
-decodeBytes !n !bs
- | BS.length bs < n = Nothing
- | otherwise = Just (BS.take n bs, BS.drop n bs)
-{-# INLINE decodeBytes #-}
-
--- | Decode a ChannelId (32 bytes).
-decodeChannelIdBytes
- :: BS.ByteString -> Either DecodeError (ChannelId, BS.ByteString)
-decodeChannelIdBytes !bs = do
- (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right
- (decodeBytes channelIdLen bs)
- cid <- maybe (Left DecodeInvalidChannelId) Right (channelId raw)
- Right (cid, rest)
-{-# INLINE decodeChannelIdBytes #-}
-
--- | Decode a ChainHash (32 bytes).
-decodeChainHashBytes
- :: BS.ByteString -> Either DecodeError (ChainHash, BS.ByteString)
-decodeChainHashBytes !bs = do
- (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right
- (decodeBytes chainHashLen bs)
- ch <- maybe (Left DecodeInvalidChainHash) Right (chainHash raw)
- Right (ch, rest)
-{-# INLINE decodeChainHashBytes #-}
-
--- | Decode a Signature (64 bytes).
-decodeSignatureBytes
- :: BS.ByteString -> Either DecodeError (Signature, BS.ByteString)
-decodeSignatureBytes !bs = do
- (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right
- (decodeBytes signatureLen bs)
- sig <- maybe (Left DecodeInvalidSignature) Right (signature raw)
- Right (sig, rest)
-{-# INLINE decodeSignatureBytes #-}
-
--- | Decode a Point (33 bytes).
-decodePointBytes
- :: BS.ByteString -> Either DecodeError (Point, BS.ByteString)
-decodePointBytes !bs = do
- (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right
- (decodeBytes pointLen bs)
- pt <- maybe (Left DecodeInvalidPoint) Right (point raw)
- Right (pt, rest)
-{-# INLINE decodePointBytes #-}
-
--- | Decode a TxId (32 bytes).
-decodeTxIdBytes
- :: BS.ByteString -> Either DecodeError (TxId, BS.ByteString)
-decodeTxIdBytes !bs = do
- (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right
- (decodeBytes 32 bs)
- tid <- maybe (Left DecodeInvalidTxId) Right (mkTxId raw)
- Right (tid, rest)
-{-# INLINE decodeTxIdBytes #-}
-
--- | Decode a u16 with error handling.
-decodeU16E :: BS.ByteString -> Either DecodeError (Word16, BS.ByteString)
-decodeU16E !bs = maybe (Left DecodeInsufficientBytes) Right (decodeU16 bs)
-{-# INLINE decodeU16E #-}
-
--- | Decode a u32 with error handling.
-decodeU32E :: BS.ByteString -> Either DecodeError (Word32, BS.ByteString)
-decodeU32E !bs = maybe (Left DecodeInsufficientBytes) Right (decodeU32 bs)
-{-# INLINE decodeU32E #-}
-
--- | Decode a u64 as Satoshi.
-decodeSatoshi
- :: BS.ByteString -> Either DecodeError (Satoshi, BS.ByteString)
-decodeSatoshi !bs = do
- (val, rest) <- maybe (Left DecodeInsufficientBytes) Right (decodeU64 bs)
- Right (Satoshi val, rest)
-{-# INLINE decodeSatoshi #-}
-
--- | Decode a u64 as MilliSatoshi.
-decodeMilliSatoshi
- :: BS.ByteString -> Either DecodeError (MilliSatoshi, BS.ByteString)
-decodeMilliSatoshi !bs = do
- (val, rest) <- maybe (Left DecodeInsufficientBytes) Right (decodeU64 bs)
- Right (MilliSatoshi val, rest)
-{-# INLINE decodeMilliSatoshi #-}
-
--- | Decode optional TLV stream from remaining bytes.
-decodeTlvs :: BS.ByteString -> Either DecodeError TlvStream
-decodeTlvs !bs
- | BS.null bs = Right (unsafeTlvStream [])
- | otherwise = either (Left . DecodeTlvError) Right (decodeTlvStreamRaw bs)
-{-# INLINE decodeTlvs #-}
-
--- | Decode a length-prefixed script (u16 length prefix).
-decodeScriptPubKey
- :: BS.ByteString -> Either DecodeError (ScriptPubKey, BS.ByteString)
-decodeScriptPubKey !bs = do
- (len, rest1) <- decodeU16E bs
- let !scriptLen = fromIntegral len
- unless (BS.length rest1 >= scriptLen) $ Left DecodeInsufficientBytes
- let !script = BS.take scriptLen rest1
- !rest2 = BS.drop scriptLen rest1
- Right (scriptPubKey script, rest2)
-{-# INLINE decodeScriptPubKey #-}
-
--- | Decode a PaymentHash (32 bytes).
-decodePaymentHashBytes
- :: BS.ByteString -> Either DecodeError (PaymentHash, BS.ByteString)
-decodePaymentHashBytes !bs = do
- (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right
- (decodeBytes paymentHashLen bs)
- ph <- maybe (Left DecodeInvalidPaymentHash) Right (paymentHash raw)
- Right (ph, rest)
-{-# INLINE decodePaymentHashBytes #-}
-
--- | Decode a PaymentPreimage (32 bytes).
-decodePaymentPreimageBytes
- :: BS.ByteString -> Either DecodeError (PaymentPreimage, BS.ByteString)
-decodePaymentPreimageBytes !bs = do
- (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right
- (decodeBytes paymentPreimageLen bs)
- pp <- maybe (Left DecodeInvalidPaymentPreimage) Right (paymentPreimage raw)
- Right (pp, rest)
-{-# INLINE decodePaymentPreimageBytes #-}
-
--- | Decode an OnionPacket (1366 bytes).
-decodeOnionPacketBytes
- :: BS.ByteString -> Either DecodeError (OnionPacket, BS.ByteString)
-decodeOnionPacketBytes !bs = do
- (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right
- (decodeBytes onionPacketLen bs)
- op <- maybe (Left DecodeInvalidOnionPacket) Right (onionPacket raw)
- Right (op, rest)
-{-# INLINE decodeOnionPacketBytes #-}
-
--- | Decode a PerCommitmentSecret (32 bytes).
-decodePerCommitmentSecretBytes
- :: BS.ByteString
- -> Either DecodeError (PerCommitmentSecret, BS.ByteString)
-decodePerCommitmentSecretBytes !bs = do
- (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right
- (decodeBytes perCommitmentSecretLen bs)
- sec <- maybe (Left DecodeInvalidSecret) Right
- (perCommitmentSecret raw)
- Right (sec, rest)
-{-# INLINE decodePerCommitmentSecretBytes #-}
-
--- | 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
+-- parsing --------------------------------------------------------------------
+
+newtype Parser a = Parser
+ { run_parser :: BS.ByteString -> Either DecodeError (a, BS.ByteString) }
+
+instance Functor Parser where
+ fmap f (Parser p) = Parser $ \bs -> case p bs of
+ Left e -> Left e
+ Right (a, r) -> Right (f a, r)
+ {-# INLINE fmap #-}
+
+instance Applicative Parser where
+ pure a = Parser $ \bs -> Right (a, bs)
+ {-# INLINE pure #-}
+ Parser pf <*> Parser pa = Parser $ \bs -> case pf bs of
+ Left e -> Left e
+ Right (f, r) -> case pa r of
+ Left e -> Left e
+ Right (a, r') -> Right (f a, r')
+ {-# INLINE (<*>) #-}
+
+instance Monad Parser where
+ Parser p >>= k = Parser $ \bs -> case p bs of
+ Left e -> Left e
+ Right (a, r) -> run_parser (k a) r
+ {-# INLINE (>>=) #-}
+
+-- run a parser whose last step consumes the remaining input
+parse :: Parser a -> BS.ByteString -> Either DecodeError a
+parse p bs = fmap fst (run_parser p bs)
+{-# INLINE parse #-}
+
+failure :: DecodeError -> Parser a
+failure e = Parser $ \_ -> Left e
+{-# INLINE failure #-}
+
+-- lift a bolt1 field decoder, whose only failure is truncation
+field :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> Parser a
+field f = Parser $ \bs -> case f bs of
+ Nothing -> Left DecodeInsufficientBytes
+ Just r -> Right r
+{-# INLINE field #-}
+
+bytes :: Int -> Parser BS.ByteString
+bytes n = Parser $ \bs ->
+ if BS.length bs < n
+ then Left DecodeInsufficientBytes
+ else Right (BU.unsafeTake n bs, BU.unsafeDrop n bs)
+{-# INLINE bytes #-}
+
+-- a fixed-size field whose constructor checks only the length
+sized :: Int -> (BS.ByteString -> Maybe a) -> Parser a
+sized n f = do
+ b <- bytes n
+ maybe (failure DecodeInsufficientBytes) pure (f b)
+{-# INLINE sized #-}
+
+u8 :: Parser Word8
+u8 = Parser $ \bs -> case BS.uncons bs of
+ Nothing -> Left DecodeInsufficientBytes
+ Just r -> Right r
+{-# INLINE u8 #-}
+
+u16 :: Parser Word16
+u16 = field BOLT1.decode_u16
+{-# INLINE u16 #-}
+
+u32 :: Parser Word32
+u32 = field BOLT1.decode_u32
+{-# INLINE u32 #-}
+
+u64 :: Parser Word64
+u64 = field BOLT1.decode_u64
+{-# INLINE u64 #-}
+
+chain_hash :: Parser BOLT1.ChainHash
+chain_hash = field BOLT1.decode_chain_hash
+{-# INLINE chain_hash #-}
+
+channel_id :: Parser ChannelId
+channel_id = field BOLT1.decode_channel_id
+{-# INLINE channel_id #-}
+
+signature :: Parser Signature
+signature = field BOLT1.decode_signature
+{-# INLINE signature #-}
+
+payment_hash :: Parser BOLT1.PaymentHash
+payment_hash = field BOLT1.decode_payment_hash
+{-# INLINE payment_hash #-}
+
+payment_preimage :: Parser BOLT1.PaymentPreimage
+payment_preimage = field BOLT1.decode_payment_preimage
+{-# INLINE payment_preimage #-}
+
+per_commitment_secret :: Parser BOLT1.PerCommitmentSecret
+per_commitment_secret = field BOLT1.decode_per_commitment_secret
+{-# INLINE per_commitment_secret #-}
+
+point :: Parser Point
+point = do
+ b <- bytes 33
+ maybe (failure DecodeInvalidPoint) pure (BOLT1.point b)
+{-# INLINE point #-}
+
+satoshi :: Parser BOLT1.Satoshi
+satoshi = do
+ w <- u64
+ maybe (failure DecodeInvalidAmount) pure (BOLT1.satoshi w)
+{-# INLINE satoshi #-}
+
+milli_satoshi :: Parser BOLT1.MilliSatoshi
+milli_satoshi = do
+ w <- u64
+ maybe (failure DecodeInvalidAmount) pure (BOLT1.milli_satoshi w)
+{-# INLINE milli_satoshi #-}
+
+txid :: Parser TxId
+txid = sized 32 mkTxId
+{-# INLINE txid #-}
+
+htlc_id :: Parser HtlcId
+htlc_id = fmap HtlcId u64
+{-# INLINE htlc_id #-}
+
+serial_id :: Parser SerialId
+serial_id = fmap SerialId u64
+{-# INLINE serial_id #-}
+
+prefixed :: Parser BS.ByteString
+prefixed = field BOLT1.decode_u16_prefixed
+{-# INLINE prefixed #-}
+
+script :: Parser ScriptPubKey
+script = do
+ b <- prefixed
+ maybe (failure DecodeInsufficientBytes) pure (script_pubkey b)
+{-# INLINE script #-}
+
+-- n items, each parsed by p
+count :: Int -> Parser a -> Parser [a]
+count n0 p = go n0 []
+ where
+ go !n !acc
+ | n <= 0 = pure (reverse acc)
+ | otherwise = p >>= \a -> go (n - 1) (a : acc)
+{-# INLINE count #-}
+
+-- the TLV stream occupying the rest of the payload, given the message's
+-- known types
+tlvs :: [Word64] -> Parser TlvStream
+tlvs known = Parser $ \bs ->
+ case BOLT1.decode_tlv_stream (`elem` known) bs of
+ Left e -> Left (DecodeTlvError e)
+ Right s -> Right (s, BS.empty)
+{-# INLINE tlvs #-}
+
+-- the unknown records of a stream
+unknown :: [Word64] -> TlvStream -> TlvStream
+unknown known = BOLT1.filter_tlv_stream (`notElem` known)
+{-# INLINE unknown #-}
+
+-- the typed value of a known record, if present
+record :: Word64 -> (BS.ByteString -> Maybe a) -> TlvStream -> Parser (Maybe a)
+record t f s = case BOLT1.lookup_tlv t s of
+ Nothing -> pure Nothing
+ Just v -> maybe (failure (DecodeInvalidTlvValue t)) (pure . Just) (f v)
+{-# INLINE record #-}
+
+-- whether a known record with an empty value is present
+flag :: Word64 -> TlvStream -> Parser Bool
+flag t s = fmap (maybe False (const True)) (record t empty_value s)
+ where
+ empty_value v
+ | BS.null v = Just ()
+ | otherwise = Nothing
+{-# INLINE flag #-}
+
+-- TLV values -----------------------------------------------------------------
+
+-- run a field decoder over a whole TLV value
+whole :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString
+ -> Maybe a
+whole f v = case f v of
+ Just (a, r) | BS.null r -> Just a
+ _ -> Nothing
+{-# INLINE whole #-}
+
+tlv_point :: BS.ByteString -> Maybe Point
+tlv_point v
+ | BS.length v == 33 = BOLT1.point v
+ | otherwise = Nothing
+
+tlv_s64 :: BS.ByteString -> Maybe Int64
+tlv_s64 = whole BOLT1.decode_s64
+
+tlv_fee_range :: BS.ByteString -> Maybe FeeRange
+tlv_fee_range v = do
+ (lo, r0) <- BOLT1.decode_satoshi v
+ hi <- whole BOLT1.decode_satoshi r0
+ pure (FeeRange lo hi)
+
+tlv_next_funding :: BS.ByteString -> Maybe NextFunding
+tlv_next_funding v
+ | BS.length v == 33 = do
+ t <- mkTxId (BU.unsafeTake 32 v)
+ pure (NextFunding t (BU.unsafeIndex v 32))
+ | otherwise = Nothing
+
+-- encoding -------------------------------------------------------------------
+
+u16_prefixed :: BS.ByteString -> Either EncodeError BS.ByteString
+u16_prefixed bs = maybe (Left EncodeLengthOverflow) Right
+ (BOLT1.encode_u16_prefixed bs)
+{-# INLINE u16_prefixed #-}
+
+-- scripts are bounded, so their prefix can't overflow
+script_bytes :: ScriptPubKey -> BS.ByteString
+script_bytes s =
+ let !b = un_script_pubkey s
+ in BOLT1.encode_u16 (fromIntegral (BS.length b)) <> b
+{-# INLINE script_bytes #-}
+
+count_prefix :: [a] -> Either EncodeError BS.ByteString
+count_prefix xs
| n > 65535 = Left EncodeLengthOverflow
- | otherwise = Right $! fromIntegral n
-{-# INLINE checkListCountU16 #-}
-
--- | Decode a u16-prefixed byte string.
-decodeU16Bytes
- :: BS.ByteString -> Either DecodeError (BS.ByteString, BS.ByteString)
-decodeU16Bytes !bs = do
- (len, rest1) <- decodeU16E bs
- let !n = fromIntegral len
- unless (BS.length rest1 >= n) $ Left DecodeInsufficientBytes
- Right (BS.take n rest1, BS.drop n rest1)
-{-# INLINE decodeU16Bytes #-}
-
--- | Decode optional trailing TLV stream.
-decodeOptionalTlvs
- :: BS.ByteString -> Either DecodeError (TlvStream, BS.ByteString)
-decodeOptionalTlvs !bs
- | BS.null bs = Right (unsafeTlvStream [], BS.empty)
- | otherwise = case decodeTlvStreamRaw bs of
- Left e -> Left (DecodeTlvError e)
- Right t -> Right (t, BS.empty)
-{-# INLINE decodeOptionalTlvs #-}
-
--- Channel establishment v1 ----------------------------------------------------
-
--- | Encode an OpenChannel message (type 32).
---
--- Wire format:
--- - chain_hash: 32 bytes
--- - temporary_channel_id: 32 bytes
--- - funding_satoshis: u64
--- - push_msat: u64
--- - dust_limit_satoshis: u64
--- - max_htlc_value_in_flight_msat: u64
--- - channel_reserve_satoshis: u64
--- - htlc_minimum_msat: u64
--- - feerate_per_kw: u32
--- - to_self_delay: u16
--- - max_accepted_htlcs: u16
--- - funding_pubkey: 33 bytes
--- - revocation_basepoint: 33 bytes
--- - payment_basepoint: 33 bytes
--- - delayed_payment_basepoint: 33 bytes
--- - htlc_basepoint: 33 bytes
--- - first_per_commitment_point: 33 bytes
--- - channel_flags: 1 byte
--- - tlvs: TLV stream
-encodeOpenChannel :: OpenChannel -> BS.ByteString
-encodeOpenChannel !msg = mconcat
- [ unChainHash (openChannelChainHash msg)
- , unChannelId (openChannelTempChannelId msg)
- , encodeU64 (unSatoshi (openChannelFundingSatoshi msg))
- , encodeU64 (unMilliSatoshi (openChannelPushMsat msg))
- , encodeU64 (unSatoshi (openChannelDustLimitSatoshi msg))
- , encodeU64 (unMilliSatoshi (openChannelMaxHtlcValueInFlight msg))
- , encodeU64 (unSatoshi (openChannelChannelReserveSat msg))
- , encodeU64 (unMilliSatoshi (openChannelHtlcMinimumMsat msg))
- , encodeU32 (openChannelFeeratePerKw msg)
- , encodeU16 (openChannelToSelfDelay msg)
- , encodeU16 (openChannelMaxAcceptedHtlcs msg)
- , unPoint (openChannelFundingPubkey msg)
- , unPoint (openChannelRevocationBasepoint msg)
- , unPoint (openChannelPaymentBasepoint msg)
- , unPoint (openChannelDelayedPaymentBase msg)
- , unPoint (openChannelHtlcBasepoint msg)
- , unPoint (openChannelFirstPerCommitPoint msg)
- , BS.singleton (openChannelChannelFlags msg)
- , encodeTlvStream (openChannelTlvs msg)
- ]
+ | otherwise = Right (BOLT1.encode_u16 (fromIntegral n))
+ where
+ !n = length xs
+{-# INLINE count_prefix #-}
+
+txid_bytes :: TxId -> BS.ByteString
+txid_bytes (TxId b) = b
+{-# INLINE txid_bytes #-}
+
+word8 :: Word8 -> BS.ByteString
+word8 = BS.singleton
+{-# INLINE word8 #-}
+
+-- encode a message's TLV stream: its typed records plus the unknown
+-- ones, which mustn't use a known type
+encode_tlvs
+ :: [Word64] -> [TlvRecord] -> TlvStream -> Either EncodeError BS.ByteString
+encode_tlvs known recs extra
+ | any ((`elem` known) . tlv_type) others = Left EncodeInvalidTlvs
+ | otherwise = case BOLT1.tlv_stream (recs <> others) of
+ Nothing -> Left EncodeInvalidTlvs
+ Just s -> Right (BOLT1.encode_tlv_stream s)
+ where
+ others = BOLT1.un_tlv_stream extra
+{-# INLINE encode_tlvs #-}
--- | Decode an OpenChannel message (type 32).
-decodeOpenChannel
- :: BS.ByteString -> Either DecodeError (OpenChannel, BS.ByteString)
-decodeOpenChannel !bs = do
- (chainHash', rest1) <- decodeChainHashBytes bs
- (tempChanId, rest2) <- decodeChannelIdBytes rest1
- (fundingSats, rest3) <- decodeSatoshi rest2
- (pushMsat, rest4) <- decodeMilliSatoshi rest3
- (dustLimit, rest5) <- decodeSatoshi rest4
- (maxHtlcVal, rest6) <- decodeMilliSatoshi rest5
- (chanReserve, rest7) <- decodeSatoshi rest6
- (htlcMin, rest8) <- decodeMilliSatoshi rest7
- (feerate, rest9) <- decodeU32E rest8
- (toSelfDelay, rest10) <- decodeU16E rest9
- (maxHtlcs, rest11) <- decodeU16E rest10
- (fundingPk, rest12) <- decodePointBytes rest11
- (revocBase, rest13) <- decodePointBytes rest12
- (paymentBase, rest14) <- decodePointBytes rest13
- (delayedBase, rest15) <- decodePointBytes rest14
- (htlcBase, rest16) <- decodePointBytes rest15
- (firstCommit, rest17) <- decodePointBytes rest16
- (flags, rest18) <- maybe (Left DecodeInsufficientBytes) Right
- (decodeU8 rest17)
- tlvs <- decodeTlvs rest18
- let !msg = OpenChannel
- { openChannelChainHash = chainHash'
- , openChannelTempChannelId = tempChanId
- , openChannelFundingSatoshi = fundingSats
- , openChannelPushMsat = pushMsat
- , openChannelDustLimitSatoshi = dustLimit
- , openChannelMaxHtlcValueInFlight = maxHtlcVal
- , openChannelChannelReserveSat = chanReserve
- , openChannelHtlcMinimumMsat = htlcMin
- , openChannelFeeratePerKw = feerate
- , openChannelToSelfDelay = toSelfDelay
- , openChannelMaxAcceptedHtlcs = maxHtlcs
- , openChannelFundingPubkey = fundingPk
- , openChannelRevocationBasepoint = revocBase
- , openChannelPaymentBasepoint = paymentBase
- , openChannelDelayedPaymentBase = delayedBase
- , openChannelHtlcBasepoint = htlcBase
- , openChannelFirstPerCommitPoint = firstCommit
- , openChannelChannelFlags = flags
- , openChannelTlvs = tlvs
- }
- Right (msg, BS.empty)
-
--- | Encode an AcceptChannel message (type 33).
---
--- Wire format:
--- - temporary_channel_id: 32 bytes
--- - dust_limit_satoshis: u64
--- - max_htlc_value_in_flight_msat: u64
--- - channel_reserve_satoshis: u64
--- - htlc_minimum_msat: u64
--- - minimum_depth: u32
--- - to_self_delay: u16
--- - max_accepted_htlcs: u16
--- - funding_pubkey: 33 bytes
--- - revocation_basepoint: 33 bytes
--- - payment_basepoint: 33 bytes
--- - delayed_payment_basepoint: 33 bytes
--- - htlc_basepoint: 33 bytes
--- - first_per_commitment_point: 33 bytes
--- - tlvs: TLV stream
-encodeAcceptChannel :: AcceptChannel -> BS.ByteString
-encodeAcceptChannel !msg = mconcat
- [ unChannelId (acceptChannelTempChannelId msg)
- , encodeU64 (unSatoshi (acceptChannelDustLimitSatoshi msg))
- , encodeU64 (unMilliSatoshi (acceptChannelMaxHtlcValueInFlight msg))
- , encodeU64 (unSatoshi (acceptChannelChannelReserveSat msg))
- , encodeU64 (unMilliSatoshi (acceptChannelHtlcMinimumMsat msg))
- , encodeU32 (acceptChannelMinimumDepth msg)
- , encodeU16 (acceptChannelToSelfDelay msg)
- , encodeU16 (acceptChannelMaxAcceptedHtlcs msg)
- , unPoint (acceptChannelFundingPubkey msg)
- , unPoint (acceptChannelRevocationBasepoint msg)
- , unPoint (acceptChannelPaymentBasepoint msg)
- , unPoint (acceptChannelDelayedPaymentBase msg)
- , unPoint (acceptChannelHtlcBasepoint msg)
- , unPoint (acceptChannelFirstPerCommitPoint msg)
- , encodeTlvStream (acceptChannelTlvs msg)
- ]
+opt :: Word64 -> (a -> BS.ByteString) -> Maybe a -> [TlvRecord]
+opt t f = maybe [] (\a -> [TlvRecord t (f a)])
+{-# INLINE opt #-}
--- | Decode an AcceptChannel message (type 33).
-decodeAcceptChannel
- :: BS.ByteString -> Either DecodeError (AcceptChannel, BS.ByteString)
-decodeAcceptChannel !bs = do
- (tempChanId, rest1) <- decodeChannelIdBytes bs
- (dustLimit, rest2) <- decodeSatoshi rest1
- (maxHtlcVal, rest3) <- decodeMilliSatoshi rest2
- (chanReserve, rest4) <- decodeSatoshi rest3
- (htlcMin, rest5) <- decodeMilliSatoshi rest4
- (minDepth, rest6) <- decodeU32E rest5
- (toSelfDelay, rest7) <- decodeU16E rest6
- (maxHtlcs, rest8) <- decodeU16E rest7
- (fundingPk, rest9) <- decodePointBytes rest8
- (revocBase, rest10) <- decodePointBytes rest9
- (paymentBase, rest11) <- decodePointBytes rest10
- (delayedBase, rest12) <- decodePointBytes rest11
- (htlcBase, rest13) <- decodePointBytes rest12
- (firstCommit, rest14) <- decodePointBytes rest13
- tlvs <- decodeTlvs rest14
- let !msg = AcceptChannel
- { acceptChannelTempChannelId = tempChanId
- , acceptChannelDustLimitSatoshi = dustLimit
- , acceptChannelMaxHtlcValueInFlight = maxHtlcVal
- , acceptChannelChannelReserveSat = chanReserve
- , acceptChannelHtlcMinimumMsat = htlcMin
- , acceptChannelMinimumDepth = minDepth
- , acceptChannelToSelfDelay = toSelfDelay
- , acceptChannelMaxAcceptedHtlcs = maxHtlcs
- , acceptChannelFundingPubkey = fundingPk
- , acceptChannelRevocationBasepoint = revocBase
- , acceptChannelPaymentBasepoint = paymentBase
- , acceptChannelDelayedPaymentBase = delayedBase
- , acceptChannelHtlcBasepoint = htlcBase
- , acceptChannelFirstPerCommitPoint = firstCommit
- , acceptChannelTlvs = tlvs
- }
- Right (msg, BS.empty)
-
--- | Encode a FundingCreated message (type 34).
---
--- Wire format:
--- - temporary_channel_id: 32 bytes
--- - funding_txid: 32 bytes
--- - funding_output_index: u16
--- - signature: 64 bytes
-encodeFundingCreated :: FundingCreated -> BS.ByteString
-encodeFundingCreated !msg = mconcat
- [ unChannelId (fundingCreatedTempChannelId msg)
- , let (TxId bs) = fundingCreatedFundingTxid msg in bs
- , encodeU16 (fundingCreatedFundingOutIdx msg)
- , unSignature (fundingCreatedSignature msg)
- ]
+opt_flag :: Word64 -> Bool -> [TlvRecord]
+opt_flag t b = if b then [TlvRecord t BS.empty] else []
+{-# INLINE opt_flag #-}
--- | Decode a FundingCreated message (type 34).
-decodeFundingCreated
- :: BS.ByteString -> Either DecodeError (FundingCreated, BS.ByteString)
-decodeFundingCreated !bs = do
- (tempChanId, rest1) <- decodeChannelIdBytes bs
- (fundingTxid, rest2) <- decodeTxIdBytes rest1
- (outIdx, rest3) <- decodeU16E rest2
- (sig, rest4) <- decodeSignatureBytes rest3
- let !msg = FundingCreated
- { fundingCreatedTempChannelId = tempChanId
- , fundingCreatedFundingTxid = fundingTxid
- , fundingCreatedFundingOutIdx = outIdx
- , fundingCreatedSignature = sig
- }
- Right (msg, rest4)
-
--- | Encode a FundingSigned message (type 35).
---
--- Wire format:
--- - channel_id: 32 bytes
--- - signature: 64 bytes
-encodeFundingSigned :: FundingSigned -> BS.ByteString
-encodeFundingSigned !msg = mconcat
- [ unChannelId (fundingSignedChannelId msg)
- , unSignature (fundingSignedSignature msg)
- ]
+fee_range_bytes :: FeeRange -> BS.ByteString
+fee_range_bytes (FeeRange lo hi) =
+ BOLT1.encode_satoshi lo <> BOLT1.encode_satoshi hi
--- | Decode a FundingSigned message (type 35).
-decodeFundingSigned
- :: BS.ByteString -> Either DecodeError (FundingSigned, BS.ByteString)
-decodeFundingSigned !bs = do
- (chanId, rest1) <- decodeChannelIdBytes bs
- (sig, rest2) <- decodeSignatureBytes rest1
- let !msg = FundingSigned
- { fundingSignedChannelId = chanId
- , fundingSignedSignature = sig
- }
- Right (msg, rest2)
-
--- | Encode a ChannelReady message (type 36).
---
--- Wire format:
--- - channel_id: 32 bytes
--- - second_per_commitment_point: 33 bytes
--- - tlvs: TLV stream
-encodeChannelReady :: ChannelReady -> BS.ByteString
-encodeChannelReady !msg = mconcat
- [ unChannelId (channelReadyChannelId msg)
- , unPoint (channelReadySecondPerCommitPoint msg)
- , encodeTlvStream (channelReadyTlvs msg)
- ]
+next_funding_bytes :: NextFunding -> BS.ByteString
+next_funding_bytes (NextFunding t f) = txid_bytes t <> word8 f
--- | Decode a ChannelReady message (type 36).
-decodeChannelReady
- :: BS.ByteString -> Either DecodeError (ChannelReady, BS.ByteString)
-decodeChannelReady !bs = do
- (chanId, rest1) <- decodeChannelIdBytes bs
- (secondCommit, rest2) <- decodePointBytes rest1
- tlvs <- decodeTlvs rest2
- let !msg = ChannelReady
- { channelReadyChannelId = chanId
- , channelReadySecondPerCommitPoint = secondCommit
- , channelReadyTlvs = tlvs
- }
- Right (msg, BS.empty)
-
--- Channel close ---------------------------------------------------------------
-
--- | Encode a Stfu message (type 2).
---
--- Wire format:
--- - channel_id: 32 bytes
--- - initiator: 1 byte
-encodeStfu :: Stfu -> BS.ByteString
-encodeStfu !msg = mconcat
- [ unChannelId (stfuChannelId msg)
- , BS.singleton $! case stfuInitiator msg of
- IsInitiator -> 1
- NotInitiator -> 0
- ]
+-- messages -------------------------------------------------------------------
--- | Decode a Stfu message (type 2).
-decodeStfu :: BS.ByteString -> Either DecodeError (Stfu, BS.ByteString)
-decodeStfu !bs = do
- (chanId, rest1) <- decodeChannelIdBytes bs
- (raw, rest2) <- maybe (Left DecodeInsufficientBytes) Right
- (decodeU8 rest1)
- ini <- case raw of
- 1 -> Right IsInitiator
- 0 -> Right NotInitiator
- _ -> Left DecodeInvalidInitiator
- let !msg = Stfu
- { stfuChannelId = chanId
- , stfuInitiator = ini
- }
- Right (msg, rest2)
-
--- | Encode a Shutdown message (type 38).
---
--- Wire format:
--- - channel_id: 32 bytes
--- - len: u16
--- - scriptpubkey: len bytes
-encodeShutdown :: Shutdown -> Either EncodeError BS.ByteString
-encodeShutdown !msg = do
- let !script = unScriptPubKey (shutdownScriptPubkey msg)
- !scriptLen = BS.length script
- if scriptLen > 65535
- then Left EncodeLengthOverflow
- else Right $ mconcat
- [ unChannelId (shutdownChannelId msg)
- , encodeU16 (fromIntegral scriptLen)
- , script
- ]
-
--- | Decode a Shutdown message (type 38).
-decodeShutdown
- :: BS.ByteString -> Either DecodeError (Shutdown, BS.ByteString)
-decodeShutdown !bs = do
- (chanId, rest1) <- decodeChannelIdBytes bs
- (script, rest2) <- decodeScriptPubKey rest1
- let !msg = Shutdown
- { shutdownChannelId = chanId
- , shutdownScriptPubkey = script
- }
- Right (msg, rest2)
-
--- | Encode a ClosingSigned message (type 39).
+-- | Encode a BOLT #2 message, including its type. Fails if a field
+-- can't be encoded or the result exceeds 65535 bytes.
--
--- Wire format:
--- - channel_id: 32 bytes
--- - fee_satoshis: u64
--- - signature: 64 bytes
--- - tlvs: TLV stream
-encodeClosingSigned :: ClosingSigned -> BS.ByteString
-encodeClosingSigned !msg = mconcat
- [ unChannelId (closingSignedChannelId msg)
- , encodeU64 (unSatoshi (closingSignedFeeSatoshi msg))
- , unSignature (closingSignedSignature msg)
- , encodeTlvStream (closingSignedTlvs msg)
- ]
-
--- | Decode a ClosingSigned message (type 39).
-decodeClosingSigned
- :: BS.ByteString -> Either DecodeError (ClosingSigned, BS.ByteString)
-decodeClosingSigned !bs = do
- (chanId, rest1) <- decodeChannelIdBytes bs
- (feeSats, rest2) <- decodeSatoshi rest1
- (sig, rest3) <- decodeSignatureBytes rest2
- tlvs <- decodeTlvs rest3
- let !msg = ClosingSigned
- { closingSignedChannelId = chanId
- , closingSignedFeeSatoshi = feeSats
- , closingSignedSignature = sig
- , closingSignedTlvs = tlvs
- }
- Right (msg, BS.empty)
-
--- | Encode a ClosingComplete message (type 40).
+-- >>> let stfu = Stfu cid True BOLT1.empty_tlv_stream
+-- >>> fmap BS.length (encode_message (MsgStfu stfu))
+-- Right 35
+encode_message :: Message -> Either EncodeError BS.ByteString
+encode_message m = do
+ payload <- case m of
+ MsgOpenChannel a -> encode_open_channel a
+ MsgAcceptChannel a -> encode_accept_channel a
+ MsgFundingCreated a -> Right (encode_funding_created a)
+ MsgFundingSigned a -> Right (encode_funding_signed a)
+ MsgChannelReady a -> encode_channel_ready a
+ MsgOpenChannel2 a -> encode_open_channel2 a
+ MsgAcceptChannel2 a -> encode_accept_channel2 a
+ MsgTxAddInput a -> encode_tx_add_input a
+ MsgTxAddOutput a -> Right (encode_tx_add_output a)
+ MsgTxRemoveInput a -> Right (encode_tx_remove_input a)
+ MsgTxRemoveOutput a -> Right (encode_tx_remove_output a)
+ MsgTxComplete a -> Right (encode_tx_complete a)
+ MsgTxSignatures a -> encode_tx_signatures a
+ MsgTxInitRbf a -> encode_tx_init_rbf a
+ MsgTxAckRbf a -> encode_tx_ack_rbf a
+ MsgTxAbort a -> encode_tx_abort a
+ MsgStfu a -> Right (encode_stfu a)
+ MsgShutdown a -> Right (encode_shutdown a)
+ MsgClosingComplete a -> encode_closing_complete a
+ MsgClosingSig a -> encode_closing_sig a
+ MsgClosingSigned a -> encode_closing_signed a
+ MsgUpdateAddHtlc a -> encode_update_add_htlc a
+ MsgUpdateFulfillHtlc a -> encode_update_fulfill_htlc a
+ MsgUpdateFailHtlc a -> encode_update_fail_htlc a
+ MsgUpdateFailMalformedHtlc a ->
+ Right (encode_update_fail_malformed_htlc a)
+ MsgCommitmentSigned a -> encode_commitment_signed a
+ MsgRevokeAndAck a -> Right (encode_revoke_and_ack a)
+ MsgUpdateFee a -> Right (encode_update_fee a)
+ MsgChannelReestablish a -> encode_channel_reestablish a
+ case BOLT1.encode_envelope (message_type m) payload of
+ Left _ -> Left EncodeMessageTooLarge
+ Right w -> Right w
+
+-- | Decode a BOLT #2 message, including its type.
--
--- Wire format:
--- - channel_id: 32 bytes
--- - len: u16 (closer script length)
--- - closer_script: len bytes
--- - len: u16 (closee script length)
--- - closee_script: len bytes
--- - fee_satoshis: u64
--- - locktime: u32
--- - tlvs: TLV stream
-encodeClosingComplete :: ClosingComplete -> Either EncodeError BS.ByteString
-encodeClosingComplete !msg = do
- let !closerScript = unScriptPubKey (closingCompleteCloserScript msg)
- !closeeScript = unScriptPubKey (closingCompleteCloseeScript msg)
- !closerLen = BS.length closerScript
- !closeeLen = BS.length closeeScript
- if closerLen > 65535 || closeeLen > 65535
- then Left EncodeLengthOverflow
- else Right $ mconcat
- [ unChannelId (closingCompleteChannelId msg)
- , encodeU16 (fromIntegral closerLen)
- , closerScript
- , encodeU16 (fromIntegral closeeLen)
- , closeeScript
- , encodeU64 (unSatoshi (closingCompleteFeeSatoshi msg))
- , encodeU32 (closingCompleteLocktime msg)
- , encodeTlvStream (closingCompleteTlvs msg)
- ]
-
--- | Decode a ClosingComplete message (type 40).
-decodeClosingComplete
- :: BS.ByteString -> Either DecodeError (ClosingComplete, BS.ByteString)
-decodeClosingComplete !bs = do
- (chanId, rest1) <- decodeChannelIdBytes bs
- (closerScript, rest2) <- decodeScriptPubKey rest1
- (closeeScript, rest3) <- decodeScriptPubKey rest2
- (feeSats, rest4) <- decodeSatoshi rest3
- (locktime, rest5) <- decodeU32E rest4
- tlvs <- decodeTlvs rest5
- let !msg = ClosingComplete
- { closingCompleteChannelId = chanId
- , closingCompleteCloserScript = closerScript
- , closingCompleteCloseeScript = closeeScript
- , closingCompleteFeeSatoshi = feeSats
- , closingCompleteLocktime = locktime
- , closingCompleteTlvs = tlvs
- }
- Right (msg, BS.empty)
-
--- | Encode a ClosingSig message (type 41).
+-- A type that BOLT #2 doesn't define (including the splicing
+-- messages, which this library doesn't implement) yields
+-- 'DecodeUnknownEvenType' or 'DecodeUnknownOddType'.
--
--- Wire format:
--- - channel_id: 32 bytes
--- - len: u16 (closer script length)
--- - closer_script: len bytes
--- - len: u16 (closee script length)
--- - closee_script: len bytes
--- - fee_satoshis: u64
--- - locktime: u32
--- - tlvs: TLV stream
-encodeClosingSig :: ClosingSig -> Either EncodeError BS.ByteString
-encodeClosingSig !msg = do
- let !closerScript = unScriptPubKey (closingSigCloserScript msg)
- !closeeScript = unScriptPubKey (closingSigCloseeScript msg)
- !closerLen = BS.length closerScript
- !closeeLen = BS.length closeeScript
- if closerLen > 65535 || closeeLen > 65535
- then Left EncodeLengthOverflow
- else Right $ mconcat
- [ unChannelId (closingSigChannelId msg)
- , encodeU16 (fromIntegral closerLen)
- , closerScript
- , encodeU16 (fromIntegral closeeLen)
- , closeeScript
- , encodeU64 (unSatoshi (closingSigFeeSatoshi msg))
- , encodeU32 (closingSigLocktime msg)
- , encodeTlvStream (closingSigTlvs msg)
- ]
-
--- | Decode a ClosingSig message (type 41).
-decodeClosingSig
- :: BS.ByteString -> Either DecodeError (ClosingSig, BS.ByteString)
-decodeClosingSig !bs = do
- (chanId, rest1) <- decodeChannelIdBytes bs
- (closerScript, rest2) <- decodeScriptPubKey rest1
- (closeeScript, rest3) <- decodeScriptPubKey rest2
- (feeSats, rest4) <- decodeSatoshi rest3
- (locktime, rest5) <- decodeU32E rest4
- tlvs <- decodeTlvs rest5
- let !msg = ClosingSig
- { closingSigChannelId = chanId
- , closingSigCloserScript = closerScript
- , closingSigCloseeScript = closeeScript
- , closingSigFeeSatoshi = feeSats
- , closingSigLocktime = locktime
- , closingSigTlvs = tlvs
- }
- Right (msg, BS.empty)
-
--- Channel establishment v2 (interactive-tx) -----------------------------------
-
--- | Encode an OpenChannel2 message (type 64).
-encodeOpenChannel2 :: OpenChannel2 -> BS.ByteString
-encodeOpenChannel2 !msg = mconcat
- [ unChainHash (openChannel2ChainHash msg)
- , unChannelId (openChannel2TempChannelId msg)
- , encodeU32 (openChannel2FundingFeeratePerkw msg)
- , encodeU32 (openChannel2CommitFeeratePerkw msg)
- , encodeU64 (unSatoshi (openChannel2FundingSatoshi msg))
- , encodeU64 (unSatoshi (openChannel2DustLimitSatoshi msg))
- , encodeU64 (unMilliSatoshi (openChannel2MaxHtlcValueInFlight msg))
- , encodeU64 (unMilliSatoshi (openChannel2HtlcMinimumMsat msg))
- , encodeU16 (openChannel2ToSelfDelay msg)
- , encodeU16 (openChannel2MaxAcceptedHtlcs msg)
- , encodeU32 (openChannel2Locktime msg)
- , unPoint (openChannel2FundingPubkey msg)
- , unPoint (openChannel2RevocationBasepoint msg)
- , unPoint (openChannel2PaymentBasepoint msg)
- , unPoint (openChannel2DelayedPaymentBase msg)
- , unPoint (openChannel2HtlcBasepoint msg)
- , unPoint (openChannel2FirstPerCommitPoint msg)
- , unPoint (openChannel2SecondPerCommitPoint msg)
- , BS.singleton (openChannel2ChannelFlags msg)
- , encodeTlvStream (openChannel2Tlvs msg)
+-- >>> let wire = "\x00\x02" <> BS.replicate 32 0xab <> "\x01"
+-- >>> fmap message_type (decode_message wire)
+-- Right 2
+-- >>> decode_message "\x00\x50"
+-- Left (DecodeUnknownEvenType 80)
+decode_message :: BS.ByteString -> Either DecodeError Message
+decode_message bs = do
+ (t, payload) <- case BOLT1.decode_envelope bs of
+ Left _ -> Left DecodeInsufficientBytes
+ Right r -> Right r
+ case t of
+ 32 -> MsgOpenChannel <$> decode_open_channel payload
+ 33 -> MsgAcceptChannel <$> decode_accept_channel payload
+ 34 -> MsgFundingCreated <$> decode_funding_created payload
+ 35 -> MsgFundingSigned <$> decode_funding_signed payload
+ 36 -> MsgChannelReady <$> decode_channel_ready payload
+ 64 -> MsgOpenChannel2 <$> decode_open_channel2 payload
+ 65 -> MsgAcceptChannel2 <$> decode_accept_channel2 payload
+ 66 -> MsgTxAddInput <$> decode_tx_add_input payload
+ 67 -> MsgTxAddOutput <$> decode_tx_add_output payload
+ 68 -> MsgTxRemoveInput <$> decode_tx_remove_input payload
+ 69 -> MsgTxRemoveOutput <$> decode_tx_remove_output payload
+ 70 -> MsgTxComplete <$> decode_tx_complete payload
+ 71 -> MsgTxSignatures <$> decode_tx_signatures payload
+ 72 -> MsgTxInitRbf <$> decode_tx_init_rbf payload
+ 73 -> MsgTxAckRbf <$> decode_tx_ack_rbf payload
+ 74 -> MsgTxAbort <$> decode_tx_abort payload
+ 2 -> MsgStfu <$> decode_stfu payload
+ 38 -> MsgShutdown <$> decode_shutdown payload
+ 40 -> MsgClosingComplete <$> decode_closing_complete payload
+ 41 -> MsgClosingSig <$> decode_closing_sig payload
+ 39 -> MsgClosingSigned <$> decode_closing_signed payload
+ 128 -> MsgUpdateAddHtlc <$> decode_update_add_htlc payload
+ 130 -> MsgUpdateFulfillHtlc <$> decode_update_fulfill_htlc payload
+ 131 -> MsgUpdateFailHtlc <$> decode_update_fail_htlc payload
+ 135 -> MsgUpdateFailMalformedHtlc <$>
+ decode_update_fail_malformed_htlc payload
+ 132 -> MsgCommitmentSigned <$> decode_commitment_signed payload
+ 133 -> MsgRevokeAndAck <$> decode_revoke_and_ack payload
+ 134 -> MsgUpdateFee <$> decode_update_fee payload
+ 136 -> MsgChannelReestablish <$> decode_channel_reestablish payload
+ _ | even t -> Left (DecodeUnknownEvenType t)
+ | otherwise -> Left (DecodeUnknownOddType t)
+
+-- open_channel ---------------------------------------------------------------
+
+open_channel_known :: [Word64]
+open_channel_known = [0, 1]
+
+-- | Encode an t'OpenChannel' payload.
+encode_open_channel :: OpenChannel -> Either EncodeError BS.ByteString
+encode_open_channel m = do
+ ts <- encode_tlvs open_channel_known
+ ( opt 0 un_script_pubkey (open_channel_upfront_shutdown_script m)
+ <> opt 1 BOLT9.render (open_channel_channel_type m) )
+ (open_channel_tlvs m)
+ pure $ mconcat [
+ BOLT1.un_chain_hash (open_channel_chain_hash m)
+ , BOLT1.un_channel_id (open_channel_temporary_channel_id m)
+ , BOLT1.encode_satoshi (open_channel_funding_satoshis m)
+ , BOLT1.encode_milli_satoshi (open_channel_push_msat m)
+ , BOLT1.encode_satoshi (open_channel_dust_limit_satoshis m)
+ , BOLT1.encode_u64 (open_channel_max_htlc_value_in_flight_msat m)
+ , BOLT1.encode_satoshi (open_channel_channel_reserve_satoshis m)
+ , BOLT1.encode_milli_satoshi (open_channel_htlc_minimum_msat m)
+ , BOLT1.encode_u32 (open_channel_feerate_per_kw m)
+ , BOLT1.encode_u16 (open_channel_to_self_delay m)
+ , BOLT1.encode_u16 (open_channel_max_accepted_htlcs m)
+ , BOLT1.un_point (open_channel_funding_pubkey m)
+ , BOLT1.un_point (open_channel_revocation_basepoint m)
+ , BOLT1.un_point (open_channel_payment_basepoint m)
+ , BOLT1.un_point (open_channel_delayed_payment_basepoint m)
+ , BOLT1.un_point (open_channel_htlc_basepoint m)
+ , BOLT1.un_point (open_channel_first_per_commitment_point m)
+ , word8 (open_channel_channel_flags m)
+ , ts
+ ]
+
+-- | Decode an t'OpenChannel' payload.
+decode_open_channel :: BS.ByteString -> Either DecodeError OpenChannel
+decode_open_channel = parse $ do
+ ch <- chain_hash
+ tcid <- channel_id
+ fund <- satoshi
+ push <- milli_satoshi
+ dust <- satoshi
+ maxv <- u64
+ res <- satoshi
+ hmin <- milli_satoshi
+ fee <- u32
+ delay <- u16
+ maxa <- u16
+ fpk <- point
+ rev <- point
+ pay <- point
+ del <- point
+ htlc <- point
+ pcp <- point
+ flags <- u8
+ s <- tlvs open_channel_known
+ shut <- record 0 script_pubkey s
+ ctype <- record 1 (Just . BOLT9.parse) s
+ pure OpenChannel {
+ open_channel_chain_hash = ch
+ , open_channel_temporary_channel_id = tcid
+ , open_channel_funding_satoshis = fund
+ , open_channel_push_msat = push
+ , open_channel_dust_limit_satoshis = dust
+ , open_channel_max_htlc_value_in_flight_msat = maxv
+ , open_channel_channel_reserve_satoshis = res
+ , open_channel_htlc_minimum_msat = hmin
+ , open_channel_feerate_per_kw = fee
+ , open_channel_to_self_delay = delay
+ , open_channel_max_accepted_htlcs = maxa
+ , open_channel_funding_pubkey = fpk
+ , open_channel_revocation_basepoint = rev
+ , open_channel_payment_basepoint = pay
+ , open_channel_delayed_payment_basepoint = del
+ , open_channel_htlc_basepoint = htlc
+ , open_channel_first_per_commitment_point = pcp
+ , open_channel_channel_flags = flags
+ , open_channel_upfront_shutdown_script = shut
+ , open_channel_channel_type = ctype
+ , open_channel_tlvs = unknown open_channel_known s
+ }
+
+-- accept_channel -------------------------------------------------------------
+
+accept_channel_known :: [Word64]
+accept_channel_known = [0, 1]
+
+-- | Encode an t'AcceptChannel' payload.
+encode_accept_channel :: AcceptChannel -> Either EncodeError BS.ByteString
+encode_accept_channel m = do
+ ts <- encode_tlvs accept_channel_known
+ ( opt 0 un_script_pubkey (accept_channel_upfront_shutdown_script m)
+ <> opt 1 BOLT9.render (accept_channel_channel_type m) )
+ (accept_channel_tlvs m)
+ pure $ mconcat [
+ BOLT1.un_channel_id (accept_channel_temporary_channel_id m)
+ , BOLT1.encode_satoshi (accept_channel_dust_limit_satoshis m)
+ , BOLT1.encode_u64 (accept_channel_max_htlc_value_in_flight_msat m)
+ , BOLT1.encode_satoshi (accept_channel_channel_reserve_satoshis m)
+ , BOLT1.encode_milli_satoshi (accept_channel_htlc_minimum_msat m)
+ , BOLT1.encode_u32 (accept_channel_minimum_depth m)
+ , BOLT1.encode_u16 (accept_channel_to_self_delay m)
+ , BOLT1.encode_u16 (accept_channel_max_accepted_htlcs m)
+ , BOLT1.un_point (accept_channel_funding_pubkey m)
+ , BOLT1.un_point (accept_channel_revocation_basepoint m)
+ , BOLT1.un_point (accept_channel_payment_basepoint m)
+ , BOLT1.un_point (accept_channel_delayed_payment_basepoint m)
+ , BOLT1.un_point (accept_channel_htlc_basepoint m)
+ , BOLT1.un_point (accept_channel_first_per_commitment_point m)
+ , ts
+ ]
+
+-- | Decode an t'AcceptChannel' payload.
+decode_accept_channel :: BS.ByteString -> Either DecodeError AcceptChannel
+decode_accept_channel = parse $ do
+ tcid <- channel_id
+ dust <- satoshi
+ maxv <- u64
+ res <- satoshi
+ hmin <- milli_satoshi
+ depth <- u32
+ delay <- u16
+ maxa <- u16
+ fpk <- point
+ rev <- point
+ pay <- point
+ del <- point
+ htlc <- point
+ pcp <- point
+ s <- tlvs accept_channel_known
+ shut <- record 0 script_pubkey s
+ ctype <- record 1 (Just . BOLT9.parse) s
+ pure AcceptChannel {
+ accept_channel_temporary_channel_id = tcid
+ , accept_channel_dust_limit_satoshis = dust
+ , accept_channel_max_htlc_value_in_flight_msat = maxv
+ , accept_channel_channel_reserve_satoshis = res
+ , accept_channel_htlc_minimum_msat = hmin
+ , accept_channel_minimum_depth = depth
+ , accept_channel_to_self_delay = delay
+ , accept_channel_max_accepted_htlcs = maxa
+ , accept_channel_funding_pubkey = fpk
+ , accept_channel_revocation_basepoint = rev
+ , accept_channel_payment_basepoint = pay
+ , accept_channel_delayed_payment_basepoint = del
+ , accept_channel_htlc_basepoint = htlc
+ , accept_channel_first_per_commitment_point = pcp
+ , accept_channel_upfront_shutdown_script = shut
+ , accept_channel_channel_type = ctype
+ , accept_channel_tlvs = unknown accept_channel_known s
+ }
+
+-- funding_created, funding_signed --------------------------------------------
+
+-- | Encode a t'FundingCreated' payload.
+encode_funding_created :: FundingCreated -> BS.ByteString
+encode_funding_created m = mconcat [
+ BOLT1.un_channel_id (funding_created_temporary_channel_id m)
+ , txid_bytes (funding_created_funding_txid m)
+ , BOLT1.encode_u16 (funding_created_funding_output_index m)
+ , BOLT1.un_signature (funding_created_signature m)
+ , BOLT1.encode_tlv_stream (funding_created_tlvs m)
]
--- | Decode an OpenChannel2 message (type 64).
-decodeOpenChannel2
- :: BS.ByteString -> Either DecodeError (OpenChannel2, BS.ByteString)
-decodeOpenChannel2 !bs = do
- (ch, rest1) <- decodeChainHashBytes bs
- (tempCid, rest2) <- decodeChannelIdBytes rest1
- (fundingFeerate, rest3) <- decodeU32E rest2
- (commitFeerate, rest4) <- decodeU32E rest3
- (fundingSats, rest5) <- decodeSatoshi rest4
- (dustLimit, rest6) <- decodeSatoshi rest5
- (maxHtlcVal, rest7) <- decodeMilliSatoshi rest6
- (htlcMin, rest8) <- decodeMilliSatoshi rest7
- (toSelfDelay, rest9) <- decodeU16E rest8
- (maxHtlcs, rest10) <- decodeU16E rest9
- (locktime, rest11) <- decodeU32E rest10
- (fundingPk, rest12) <- decodePointBytes rest11
- (revBase, rest13) <- decodePointBytes rest12
- (payBase, rest14) <- decodePointBytes rest13
- (delayBase, rest15) <- decodePointBytes rest14
- (htlcBase, rest16) <- decodePointBytes rest15
- (firstPt, rest17) <- decodePointBytes rest16
- (secondPt, rest18) <- decodePointBytes rest17
- (flags, rest19) <- maybe (Left DecodeInsufficientBytes) Right (decodeU8 rest18)
- tlvs <- decodeTlvs rest19
- let !msg = OpenChannel2
- { openChannel2ChainHash = ch
- , openChannel2TempChannelId = tempCid
- , openChannel2FundingFeeratePerkw = fundingFeerate
- , openChannel2CommitFeeratePerkw = commitFeerate
- , openChannel2FundingSatoshi = fundingSats
- , openChannel2DustLimitSatoshi = dustLimit
- , openChannel2MaxHtlcValueInFlight = maxHtlcVal
- , openChannel2HtlcMinimumMsat = htlcMin
- , openChannel2ToSelfDelay = toSelfDelay
- , openChannel2MaxAcceptedHtlcs = maxHtlcs
- , openChannel2Locktime = locktime
- , openChannel2FundingPubkey = fundingPk
- , openChannel2RevocationBasepoint = revBase
- , openChannel2PaymentBasepoint = payBase
- , openChannel2DelayedPaymentBase = delayBase
- , openChannel2HtlcBasepoint = htlcBase
- , openChannel2FirstPerCommitPoint = firstPt
- , openChannel2SecondPerCommitPoint = secondPt
- , openChannel2ChannelFlags = flags
- , openChannel2Tlvs = tlvs
- }
- Right (msg, BS.empty)
-
--- | Encode an AcceptChannel2 message (type 65).
-encodeAcceptChannel2 :: AcceptChannel2 -> BS.ByteString
-encodeAcceptChannel2 !msg = mconcat
- [ unChannelId (acceptChannel2TempChannelId msg)
- , encodeU64 (unSatoshi (acceptChannel2FundingSatoshi msg))
- , encodeU64 (unSatoshi (acceptChannel2DustLimitSatoshi msg))
- , encodeU64 (unMilliSatoshi (acceptChannel2MaxHtlcValueInFlight msg))
- , encodeU64 (unMilliSatoshi (acceptChannel2HtlcMinimumMsat msg))
- , encodeU32 (acceptChannel2MinimumDepth msg)
- , encodeU16 (acceptChannel2ToSelfDelay msg)
- , encodeU16 (acceptChannel2MaxAcceptedHtlcs msg)
- , unPoint (acceptChannel2FundingPubkey msg)
- , unPoint (acceptChannel2RevocationBasepoint msg)
- , unPoint (acceptChannel2PaymentBasepoint msg)
- , unPoint (acceptChannel2DelayedPaymentBase msg)
- , unPoint (acceptChannel2HtlcBasepoint msg)
- , unPoint (acceptChannel2FirstPerCommitPoint msg)
- , unPoint (acceptChannel2SecondPerCommitPoint msg)
- , encodeTlvStream (acceptChannel2Tlvs msg)
+-- | Decode a t'FundingCreated' payload.
+decode_funding_created :: BS.ByteString -> Either DecodeError FundingCreated
+decode_funding_created = parse $
+ FundingCreated <$> channel_id <*> txid <*> u16 <*> signature <*> tlvs []
+
+-- | Encode a t'FundingSigned' payload.
+encode_funding_signed :: FundingSigned -> BS.ByteString
+encode_funding_signed m = mconcat [
+ BOLT1.un_channel_id (funding_signed_channel_id m)
+ , BOLT1.un_signature (funding_signed_signature m)
+ , BOLT1.encode_tlv_stream (funding_signed_tlvs m)
]
--- | Decode an AcceptChannel2 message (type 65).
-decodeAcceptChannel2
- :: BS.ByteString -> Either DecodeError (AcceptChannel2, BS.ByteString)
-decodeAcceptChannel2 !bs = do
- (tempCid, rest1) <- decodeChannelIdBytes bs
- (fundingSats, rest2) <- decodeSatoshi rest1
- (dustLimit, rest3) <- decodeSatoshi rest2
- (maxHtlcVal, rest4) <- decodeMilliSatoshi rest3
- (htlcMin, rest5) <- decodeMilliSatoshi rest4
- (minDepth, rest6) <- decodeU32E rest5
- (toSelfDelay, rest7) <- decodeU16E rest6
- (maxHtlcs, rest8) <- decodeU16E rest7
- (fundingPk, rest9) <- decodePointBytes rest8
- (revBase, rest10) <- decodePointBytes rest9
- (payBase, rest11) <- decodePointBytes rest10
- (delayBase, rest12) <- decodePointBytes rest11
- (htlcBase, rest13) <- decodePointBytes rest12
- (firstPt, rest14) <- decodePointBytes rest13
- (secondPt, rest15) <- decodePointBytes rest14
- tlvs <- decodeTlvs rest15
- let !msg = AcceptChannel2
- { acceptChannel2TempChannelId = tempCid
- , acceptChannel2FundingSatoshi = fundingSats
- , acceptChannel2DustLimitSatoshi = dustLimit
- , acceptChannel2MaxHtlcValueInFlight = maxHtlcVal
- , acceptChannel2HtlcMinimumMsat = htlcMin
- , acceptChannel2MinimumDepth = minDepth
- , acceptChannel2ToSelfDelay = toSelfDelay
- , acceptChannel2MaxAcceptedHtlcs = maxHtlcs
- , acceptChannel2FundingPubkey = fundingPk
- , acceptChannel2RevocationBasepoint = revBase
- , acceptChannel2PaymentBasepoint = payBase
- , acceptChannel2DelayedPaymentBase = delayBase
- , acceptChannel2HtlcBasepoint = htlcBase
- , acceptChannel2FirstPerCommitPoint = firstPt
- , acceptChannel2SecondPerCommitPoint = secondPt
- , acceptChannel2Tlvs = tlvs
- }
- Right (msg, BS.empty)
-
--- | Encode a TxAddInput message (type 66).
-encodeTxAddInput :: TxAddInput -> Either EncodeError BS.ByteString
-encodeTxAddInput !msg = do
- prevTxEnc <- encodeU16BytesE (txAddInputPrevTx msg)
- Right $! mconcat
- [ unChannelId (txAddInputChannelId msg)
- , encodeU64 (unSerialId (txAddInputSerialId msg))
- , prevTxEnc
- , encodeU32 (txAddInputPrevVout msg)
- , encodeU32 (txAddInputSequence msg)
+-- | Decode a t'FundingSigned' payload.
+decode_funding_signed :: BS.ByteString -> Either DecodeError FundingSigned
+decode_funding_signed = parse $
+ FundingSigned <$> channel_id <*> signature <*> tlvs []
+
+-- channel_ready --------------------------------------------------------------
+
+channel_ready_known :: [Word64]
+channel_ready_known = [1]
+
+-- | Encode a t'ChannelReady' payload.
+encode_channel_ready :: ChannelReady -> Either EncodeError BS.ByteString
+encode_channel_ready m = do
+ ts <- encode_tlvs channel_ready_known
+ (opt 1 BOLT1.encode_short_channel_id (channel_ready_alias m))
+ (channel_ready_tlvs m)
+ pure $ mconcat [
+ BOLT1.un_channel_id (channel_ready_channel_id m)
+ , BOLT1.un_point (channel_ready_second_per_commitment_point m)
+ , ts
]
--- | Decode a TxAddInput message (type 66).
-decodeTxAddInput
- :: BS.ByteString -> Either DecodeError (TxAddInput, BS.ByteString)
-decodeTxAddInput !bs = do
- (cid, rest1) <- decodeChannelIdBytes bs
- (sid, rest2) <- maybe (Left DecodeInsufficientBytes) Right
- (decodeU64 rest1)
- (prevTx, rest3) <- decodeU16Bytes rest2
- (prevVout, rest4) <- decodeU32E rest3
- (seqNum, rest5) <- decodeU32E rest4
- let !msg = TxAddInput
- { txAddInputChannelId = cid
- , txAddInputSerialId = serialId sid
- , txAddInputPrevTx = prevTx
- , txAddInputPrevVout = prevVout
- , txAddInputSequence = seqNum
- }
- Right (msg, rest5)
-
--- | Encode a TxAddOutput message (type 67).
-encodeTxAddOutput :: TxAddOutput -> Either EncodeError BS.ByteString
-encodeTxAddOutput !msg = do
- scriptEnc <- encodeU16BytesE (unScriptPubKey (txAddOutputScript msg))
- Right $! mconcat
- [ unChannelId (txAddOutputChannelId msg)
- , encodeU64 (unSerialId (txAddOutputSerialId msg))
- , encodeU64 (unSatoshi (txAddOutputSats msg))
- , scriptEnc
+-- | Decode a t'ChannelReady' payload.
+decode_channel_ready :: BS.ByteString -> Either DecodeError ChannelReady
+decode_channel_ready = parse $ do
+ cid <- channel_id
+ pcp <- point
+ s <- tlvs channel_ready_known
+ alias <- record 1 (whole BOLT1.decode_short_channel_id) s
+ pure (ChannelReady cid pcp alias (unknown channel_ready_known s))
+
+-- open_channel2 --------------------------------------------------------------
+
+opening_known :: [Word64]
+opening_known = [0, 1, 2]
+
+-- | Encode an t'OpenChannel2' payload.
+encode_open_channel2 :: OpenChannel2 -> Either EncodeError BS.ByteString
+encode_open_channel2 m = do
+ ts <- encode_tlvs opening_known
+ ( opt 0 un_script_pubkey (open_channel2_upfront_shutdown_script m)
+ <> opt 1 BOLT9.render (open_channel2_channel_type m)
+ <> opt_flag 2 (open_channel2_require_confirmed_inputs m) )
+ (open_channel2_tlvs m)
+ pure $ mconcat [
+ BOLT1.un_chain_hash (open_channel2_chain_hash m)
+ , BOLT1.un_channel_id (open_channel2_temporary_channel_id m)
+ , BOLT1.encode_u32 (open_channel2_funding_feerate_perkw m)
+ , BOLT1.encode_u32 (open_channel2_commitment_feerate_perkw m)
+ , BOLT1.encode_satoshi (open_channel2_funding_satoshis m)
+ , BOLT1.encode_satoshi (open_channel2_dust_limit_satoshis m)
+ , BOLT1.encode_u64 (open_channel2_max_htlc_value_in_flight_msat m)
+ , BOLT1.encode_milli_satoshi (open_channel2_htlc_minimum_msat m)
+ , BOLT1.encode_u16 (open_channel2_to_self_delay m)
+ , BOLT1.encode_u16 (open_channel2_max_accepted_htlcs m)
+ , BOLT1.encode_u32 (open_channel2_locktime m)
+ , BOLT1.un_point (open_channel2_funding_pubkey m)
+ , BOLT1.un_point (open_channel2_revocation_basepoint m)
+ , BOLT1.un_point (open_channel2_payment_basepoint m)
+ , BOLT1.un_point (open_channel2_delayed_payment_basepoint m)
+ , BOLT1.un_point (open_channel2_htlc_basepoint m)
+ , BOLT1.un_point (open_channel2_first_per_commitment_point m)
+ , BOLT1.un_point (open_channel2_second_per_commitment_point m)
+ , word8 (open_channel2_channel_flags m)
+ , ts
]
--- | Decode a TxAddOutput message (type 67).
-decodeTxAddOutput
- :: BS.ByteString -> Either DecodeError (TxAddOutput, BS.ByteString)
-decodeTxAddOutput !bs = do
- (cid, rest1) <- decodeChannelIdBytes bs
- (sid, rest2) <- maybe (Left DecodeInsufficientBytes) Right
- (decodeU64 rest1)
- (sats, rest3) <- decodeSatoshi rest2
- (scriptBs, rest4) <- decodeU16Bytes rest3
- let !msg = TxAddOutput
- { txAddOutputChannelId = cid
- , txAddOutputSerialId = serialId sid
- , txAddOutputSats = sats
- , txAddOutputScript = scriptPubKey scriptBs
- }
- Right (msg, rest4)
-
--- | Encode a TxRemoveInput message (type 68).
-encodeTxRemoveInput :: TxRemoveInput -> BS.ByteString
-encodeTxRemoveInput !msg = mconcat
- [ unChannelId (txRemoveInputChannelId msg)
- , encodeU64 (unSerialId (txRemoveInputSerialId msg))
+-- | Decode an t'OpenChannel2' payload.
+decode_open_channel2 :: BS.ByteString -> Either DecodeError OpenChannel2
+decode_open_channel2 = parse $ do
+ ch <- chain_hash
+ tcid <- channel_id
+ ffee <- u32
+ cfee <- u32
+ fund <- satoshi
+ dust <- satoshi
+ maxv <- u64
+ hmin <- milli_satoshi
+ delay <- u16
+ maxa <- u16
+ lock <- u32
+ fpk <- point
+ rev <- point
+ pay <- point
+ del <- point
+ htlc <- point
+ pcp1 <- point
+ pcp2 <- point
+ flags <- u8
+ s <- tlvs opening_known
+ shut <- record 0 script_pubkey s
+ ctype <- record 1 (Just . BOLT9.parse) s
+ conf <- flag 2 s
+ pure OpenChannel2 {
+ open_channel2_chain_hash = ch
+ , open_channel2_temporary_channel_id = tcid
+ , open_channel2_funding_feerate_perkw = ffee
+ , open_channel2_commitment_feerate_perkw = cfee
+ , open_channel2_funding_satoshis = fund
+ , open_channel2_dust_limit_satoshis = dust
+ , open_channel2_max_htlc_value_in_flight_msat = maxv
+ , open_channel2_htlc_minimum_msat = hmin
+ , open_channel2_to_self_delay = delay
+ , open_channel2_max_accepted_htlcs = maxa
+ , open_channel2_locktime = lock
+ , open_channel2_funding_pubkey = fpk
+ , open_channel2_revocation_basepoint = rev
+ , open_channel2_payment_basepoint = pay
+ , open_channel2_delayed_payment_basepoint = del
+ , open_channel2_htlc_basepoint = htlc
+ , open_channel2_first_per_commitment_point = pcp1
+ , open_channel2_second_per_commitment_point = pcp2
+ , open_channel2_channel_flags = flags
+ , open_channel2_upfront_shutdown_script = shut
+ , open_channel2_channel_type = ctype
+ , open_channel2_require_confirmed_inputs = conf
+ , open_channel2_tlvs = unknown opening_known s
+ }
+
+-- accept_channel2 ------------------------------------------------------------
+
+-- | Encode an t'AcceptChannel2' payload.
+encode_accept_channel2 :: AcceptChannel2 -> Either EncodeError BS.ByteString
+encode_accept_channel2 m = do
+ ts <- encode_tlvs opening_known
+ ( opt 0 un_script_pubkey (accept_channel2_upfront_shutdown_script m)
+ <> opt 1 BOLT9.render (accept_channel2_channel_type m)
+ <> opt_flag 2 (accept_channel2_require_confirmed_inputs m) )
+ (accept_channel2_tlvs m)
+ pure $ mconcat [
+ BOLT1.un_channel_id (accept_channel2_temporary_channel_id m)
+ , BOLT1.encode_satoshi (accept_channel2_funding_satoshis m)
+ , BOLT1.encode_satoshi (accept_channel2_dust_limit_satoshis m)
+ , BOLT1.encode_u64 (accept_channel2_max_htlc_value_in_flight_msat m)
+ , BOLT1.encode_milli_satoshi (accept_channel2_htlc_minimum_msat m)
+ , BOLT1.encode_u32 (accept_channel2_minimum_depth m)
+ , BOLT1.encode_u16 (accept_channel2_to_self_delay m)
+ , BOLT1.encode_u16 (accept_channel2_max_accepted_htlcs m)
+ , BOLT1.un_point (accept_channel2_funding_pubkey m)
+ , BOLT1.un_point (accept_channel2_revocation_basepoint m)
+ , BOLT1.un_point (accept_channel2_payment_basepoint m)
+ , BOLT1.un_point (accept_channel2_delayed_payment_basepoint m)
+ , BOLT1.un_point (accept_channel2_htlc_basepoint m)
+ , BOLT1.un_point (accept_channel2_first_per_commitment_point m)
+ , BOLT1.un_point (accept_channel2_second_per_commitment_point m)
+ , ts
+ ]
+
+-- | Decode an t'AcceptChannel2' payload.
+decode_accept_channel2 :: BS.ByteString -> Either DecodeError AcceptChannel2
+decode_accept_channel2 = parse $ do
+ tcid <- channel_id
+ fund <- satoshi
+ dust <- satoshi
+ maxv <- u64
+ hmin <- milli_satoshi
+ depth <- u32
+ delay <- u16
+ maxa <- u16
+ fpk <- point
+ rev <- point
+ pay <- point
+ del <- point
+ htlc <- point
+ pcp1 <- point
+ pcp2 <- point
+ s <- tlvs opening_known
+ shut <- record 0 script_pubkey s
+ ctype <- record 1 (Just . BOLT9.parse) s
+ conf <- flag 2 s
+ pure AcceptChannel2 {
+ accept_channel2_temporary_channel_id = tcid
+ , accept_channel2_funding_satoshis = fund
+ , accept_channel2_dust_limit_satoshis = dust
+ , accept_channel2_max_htlc_value_in_flight_msat = maxv
+ , accept_channel2_htlc_minimum_msat = hmin
+ , accept_channel2_minimum_depth = depth
+ , accept_channel2_to_self_delay = delay
+ , accept_channel2_max_accepted_htlcs = maxa
+ , accept_channel2_funding_pubkey = fpk
+ , accept_channel2_revocation_basepoint = rev
+ , accept_channel2_payment_basepoint = pay
+ , accept_channel2_delayed_payment_basepoint = del
+ , accept_channel2_htlc_basepoint = htlc
+ , accept_channel2_first_per_commitment_point = pcp1
+ , accept_channel2_second_per_commitment_point = pcp2
+ , accept_channel2_upfront_shutdown_script = shut
+ , accept_channel2_channel_type = ctype
+ , accept_channel2_require_confirmed_inputs = conf
+ , accept_channel2_tlvs = unknown opening_known s
+ }
+
+-- interactive transaction construction ---------------------------------------
+
+-- | Encode a t'TxAddInput' payload. Fails if @prevtx@ exceeds 65535
+-- bytes.
+encode_tx_add_input :: TxAddInput -> Either EncodeError BS.ByteString
+encode_tx_add_input m = do
+ prev <- u16_prefixed (tx_add_input_prevtx m)
+ let SerialId sid = tx_add_input_serial_id m
+ pure $ mconcat [
+ BOLT1.un_channel_id (tx_add_input_channel_id m)
+ , BOLT1.encode_u64 sid
+ , prev
+ , BOLT1.encode_u32 (tx_add_input_prevtx_vout m)
+ , BOLT1.encode_u32 (tx_add_input_sequence m)
+ , BOLT1.encode_tlv_stream (tx_add_input_tlvs m)
+ ]
+
+-- | Decode a t'TxAddInput' payload.
+decode_tx_add_input :: BS.ByteString -> Either DecodeError TxAddInput
+decode_tx_add_input = parse $
+ TxAddInput <$> channel_id <*> serial_id <*> prefixed <*> u32 <*> u32
+ <*> tlvs []
+
+-- | Encode a t'TxAddOutput' payload.
+encode_tx_add_output :: TxAddOutput -> BS.ByteString
+encode_tx_add_output m =
+ let SerialId sid = tx_add_output_serial_id m
+ in mconcat [
+ BOLT1.un_channel_id (tx_add_output_channel_id m)
+ , BOLT1.encode_u64 sid
+ , BOLT1.encode_satoshi (tx_add_output_sats m)
+ , script_bytes (tx_add_output_script m)
+ , BOLT1.encode_tlv_stream (tx_add_output_tlvs m)
+ ]
+
+-- | Decode a t'TxAddOutput' payload.
+decode_tx_add_output :: BS.ByteString -> Either DecodeError TxAddOutput
+decode_tx_add_output = parse $
+ TxAddOutput <$> channel_id <*> serial_id <*> satoshi <*> script
+ <*> tlvs []
+
+-- | Encode a t'TxRemoveInput' payload.
+encode_tx_remove_input :: TxRemoveInput -> BS.ByteString
+encode_tx_remove_input (TxRemoveInput cid (SerialId sid) ts) = mconcat [
+ BOLT1.un_channel_id cid
+ , BOLT1.encode_u64 sid
+ , BOLT1.encode_tlv_stream ts
]
--- | Decode a TxRemoveInput message (type 68).
-decodeTxRemoveInput
- :: BS.ByteString -> Either DecodeError (TxRemoveInput, BS.ByteString)
-decodeTxRemoveInput !bs = do
- (cid, rest1) <- decodeChannelIdBytes bs
- (sid, rest2) <- maybe (Left DecodeInsufficientBytes) Right
- (decodeU64 rest1)
- let !msg = TxRemoveInput
- { txRemoveInputChannelId = cid
- , txRemoveInputSerialId = serialId sid
- }
- Right (msg, rest2)
-
--- | Encode a TxRemoveOutput message (type 69).
-encodeTxRemoveOutput :: TxRemoveOutput -> BS.ByteString
-encodeTxRemoveOutput !msg = mconcat
- [ unChannelId (txRemoveOutputChannelId msg)
- , encodeU64 (unSerialId (txRemoveOutputSerialId msg))
+-- | Decode a t'TxRemoveInput' payload.
+decode_tx_remove_input :: BS.ByteString -> Either DecodeError TxRemoveInput
+decode_tx_remove_input = parse $
+ TxRemoveInput <$> channel_id <*> serial_id <*> tlvs []
+
+-- | Encode a t'TxRemoveOutput' payload.
+encode_tx_remove_output :: TxRemoveOutput -> BS.ByteString
+encode_tx_remove_output (TxRemoveOutput cid (SerialId sid) ts) = mconcat [
+ BOLT1.un_channel_id cid
+ , BOLT1.encode_u64 sid
+ , BOLT1.encode_tlv_stream ts
]
--- | Decode a TxRemoveOutput message (type 69).
-decodeTxRemoveOutput
- :: BS.ByteString -> Either DecodeError (TxRemoveOutput, BS.ByteString)
-decodeTxRemoveOutput !bs = do
- (cid, rest1) <- decodeChannelIdBytes bs
- (sid, rest2) <- maybe (Left DecodeInsufficientBytes) Right
- (decodeU64 rest1)
- let !msg = TxRemoveOutput
- { txRemoveOutputChannelId = cid
- , txRemoveOutputSerialId = serialId sid
- }
- Right (msg, rest2)
-
--- | Encode a TxComplete message (type 70).
-encodeTxComplete :: TxComplete -> BS.ByteString
-encodeTxComplete !msg = unChannelId (txCompleteChannelId msg)
-
--- | Decode a TxComplete message (type 70).
-decodeTxComplete
- :: BS.ByteString -> Either DecodeError (TxComplete, BS.ByteString)
-decodeTxComplete !bs = do
- (cid, rest) <- decodeChannelIdBytes bs
- let !msg = TxComplete { txCompleteChannelId = cid }
- Right (msg, rest)
-
--- | 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)
-decodeWitness !bs = do
- (wdata, rest) <- decodeU16Bytes bs
- Right (Witness wdata, rest)
-
--- | Encode a TxSignatures message (type 71).
-encodeTxSignatures :: TxSignatures -> Either EncodeError BS.ByteString
-encodeTxSignatures !msg = do
- let !witnesses = txSignaturesWitnesses msg
- numWit <- checkListCountU16 (length witnesses)
- encodedWits <- traverse encodeWitnessE witnesses
- Right $! mconcat $
- [ unChannelId (txSignaturesChannelId msg)
- , let (TxId bs) = txSignaturesTxid msg in bs
- , encodeU16 numWit
- ] ++ encodedWits
-
--- | Decode a TxSignatures message (type 71).
-decodeTxSignatures
- :: BS.ByteString -> Either DecodeError (TxSignatures, BS.ByteString)
-decodeTxSignatures !bs = do
- (cid, rest1) <- decodeChannelIdBytes bs
- (tid, rest2) <- decodeTxIdBytes rest1
- (numWit, rest3) <- decodeU16E rest2
- (witnesses, rest4) <- decodeWitnesses (fromIntegral numWit) rest3
- let !msg = TxSignatures
- { txSignaturesChannelId = cid
- , txSignaturesTxid = tid
- , txSignaturesWitnesses = witnesses
- }
- Right (msg, rest4)
+-- | Decode a t'TxRemoveOutput' payload.
+decode_tx_remove_output
+ :: BS.ByteString -> Either DecodeError TxRemoveOutput
+decode_tx_remove_output = parse $
+ TxRemoveOutput <$> channel_id <*> serial_id <*> tlvs []
+
+-- | Encode a t'TxComplete' payload.
+encode_tx_complete :: TxComplete -> BS.ByteString
+encode_tx_complete (TxComplete cid ts) =
+ BOLT1.un_channel_id cid <> BOLT1.encode_tlv_stream ts
+
+-- | Decode a t'TxComplete' payload.
+decode_tx_complete :: BS.ByteString -> Either DecodeError TxComplete
+decode_tx_complete = parse $ TxComplete <$> channel_id <*> tlvs []
+
+-- | Encode a t'TxSignatures' payload. Fails if there are more than 65535
+-- witnesses.
+encode_tx_signatures :: TxSignatures -> Either EncodeError BS.ByteString
+encode_tx_signatures m = do
+ let ws = tx_signatures_witnesses m
+ n <- count_prefix ws
+ pure $ mconcat [
+ BOLT1.un_channel_id (tx_signatures_channel_id m)
+ , txid_bytes (tx_signatures_txid m)
+ , n
+ , mconcat [ BOLT1.encode_u16 (fromIntegral (BS.length w)) <> w
+ | w <- map un_witness ws ]
+ , BOLT1.encode_tlv_stream (tx_signatures_tlvs m)
+ ]
+
+-- | Decode a t'TxSignatures' payload.
+decode_tx_signatures :: BS.ByteString -> Either DecodeError TxSignatures
+decode_tx_signatures = parse $ do
+ cid <- channel_id
+ t <- txid
+ n <- u16
+ ws <- count (fromIntegral n) wit
+ TxSignatures cid t ws <$> tlvs []
where
- decodeWitnesses :: Int -> BS.ByteString
- -> Either DecodeError ([Witness], BS.ByteString)
- decodeWitnesses 0 !rest = Right ([], rest)
- decodeWitnesses !n !rest = do
- (w, rest') <- decodeWitness rest
- (ws, rest'') <- decodeWitnesses (n - 1) rest'
- Right (w : ws, rest'')
-
--- | Encode a TxInitRbf message (type 72).
-encodeTxInitRbf :: TxInitRbf -> BS.ByteString
-encodeTxInitRbf !msg = mconcat
- [ unChannelId (txInitRbfChannelId msg)
- , encodeU32 (txInitRbfLocktime msg)
- , encodeU32 (txInitRbfFeerate msg)
- , encodeTlvStream (txInitRbfTlvs msg)
+ wit = do
+ b <- prefixed
+ maybe (failure DecodeInsufficientBytes) pure (witness b)
+
+rbf_known :: [Word64]
+rbf_known = [0, 2]
+
+-- | Encode a t'TxInitRbf' payload.
+encode_tx_init_rbf :: TxInitRbf -> Either EncodeError BS.ByteString
+encode_tx_init_rbf m = do
+ ts <- encode_tlvs rbf_known
+ ( opt 0 BOLT1.encode_s64 (tx_init_rbf_funding_output_contribution m)
+ <> opt_flag 2 (tx_init_rbf_require_confirmed_inputs m) )
+ (tx_init_rbf_tlvs m)
+ pure $ mconcat [
+ BOLT1.un_channel_id (tx_init_rbf_channel_id m)
+ , BOLT1.encode_u32 (tx_init_rbf_locktime m)
+ , BOLT1.encode_u32 (tx_init_rbf_feerate m)
+ , ts
+ ]
+
+-- | Decode a t'TxInitRbf' payload.
+decode_tx_init_rbf :: BS.ByteString -> Either DecodeError TxInitRbf
+decode_tx_init_rbf = parse $ do
+ cid <- channel_id
+ lock <- u32
+ fee <- u32
+ s <- tlvs rbf_known
+ contrib <- record 0 tlv_s64 s
+ conf <- flag 2 s
+ pure (TxInitRbf cid lock fee contrib conf (unknown rbf_known s))
+
+-- | Encode a t'TxAckRbf' payload.
+encode_tx_ack_rbf :: TxAckRbf -> Either EncodeError BS.ByteString
+encode_tx_ack_rbf m = do
+ ts <- encode_tlvs rbf_known
+ ( opt 0 BOLT1.encode_s64 (tx_ack_rbf_funding_output_contribution m)
+ <> opt_flag 2 (tx_ack_rbf_require_confirmed_inputs m) )
+ (tx_ack_rbf_tlvs m)
+ pure (BOLT1.un_channel_id (tx_ack_rbf_channel_id m) <> ts)
+
+-- | Decode a t'TxAckRbf' payload.
+decode_tx_ack_rbf :: BS.ByteString -> Either DecodeError TxAckRbf
+decode_tx_ack_rbf = parse $ do
+ cid <- channel_id
+ s <- tlvs rbf_known
+ contrib <- record 0 tlv_s64 s
+ conf <- flag 2 s
+ pure (TxAckRbf cid contrib conf (unknown rbf_known s))
+
+-- | Encode a t'TxAbort' payload. Fails if @data@ exceeds 65535 bytes.
+encode_tx_abort :: TxAbort -> Either EncodeError BS.ByteString
+encode_tx_abort (TxAbort cid dat ts) = do
+ dat' <- u16_prefixed dat
+ pure (BOLT1.un_channel_id cid <> dat' <> BOLT1.encode_tlv_stream ts)
+
+-- | Decode a t'TxAbort' payload.
+decode_tx_abort :: BS.ByteString -> Either DecodeError TxAbort
+decode_tx_abort = parse $ TxAbort <$> channel_id <*> prefixed <*> tlvs []
+
+-- stfu -----------------------------------------------------------------------
+
+-- | Encode a t'Stfu' payload.
+encode_stfu :: Stfu -> BS.ByteString
+encode_stfu (Stfu cid ini ts) = mconcat [
+ BOLT1.un_channel_id cid
+ , word8 (if ini then 1 else 0)
+ , BOLT1.encode_tlv_stream ts
]
--- | Decode a TxInitRbf message (type 72).
-decodeTxInitRbf
- :: BS.ByteString -> Either DecodeError (TxInitRbf, BS.ByteString)
-decodeTxInitRbf !bs = do
- (cid, rest1) <- decodeChannelIdBytes bs
- (locktime, rest2) <- decodeU32E rest1
- (feerate, rest3) <- decodeU32E rest2
- tlvs <- decodeTlvs rest3
- let !msg = TxInitRbf
- { txInitRbfChannelId = cid
- , txInitRbfLocktime = locktime
- , txInitRbfFeerate = feerate
- , txInitRbfTlvs = tlvs
- }
- Right (msg, BS.empty)
-
--- | Encode a TxAckRbf message (type 73).
-encodeTxAckRbf :: TxAckRbf -> BS.ByteString
-encodeTxAckRbf !msg = mconcat
- [ unChannelId (txAckRbfChannelId msg)
- , encodeTlvStream (txAckRbfTlvs msg)
+-- | Decode a t'Stfu' payload. The @initiator@ byte must be 0 or 1.
+decode_stfu :: BS.ByteString -> Either DecodeError Stfu
+decode_stfu = parse $ do
+ cid <- channel_id
+ b <- u8
+ ini <- case b of
+ 0 -> pure False
+ 1 -> pure True
+ _ -> failure DecodeInvalidInitiator
+ Stfu cid ini <$> tlvs []
+
+-- shutdown -------------------------------------------------------------------
+
+-- | Encode a t'Shutdown' payload.
+encode_shutdown :: Shutdown -> BS.ByteString
+encode_shutdown (Shutdown cid spk ts) = mconcat [
+ BOLT1.un_channel_id cid
+ , script_bytes spk
+ , BOLT1.encode_tlv_stream ts
]
--- | Decode a TxAckRbf message (type 73).
-decodeTxAckRbf
- :: BS.ByteString -> Either DecodeError (TxAckRbf, BS.ByteString)
-decodeTxAckRbf !bs = do
- (cid, rest1) <- decodeChannelIdBytes bs
- tlvs <- decodeTlvs rest1
- let !msg = TxAckRbf
- { txAckRbfChannelId = cid
- , txAckRbfTlvs = tlvs
- }
- Right (msg, BS.empty)
-
--- | Encode a TxAbort message (type 74).
-encodeTxAbort :: TxAbort -> Either EncodeError BS.ByteString
-encodeTxAbort !msg = do
- dataEnc <- encodeU16BytesE (txAbortData msg)
- Right $! mconcat
- [ unChannelId (txAbortChannelId msg)
- , dataEnc
+-- | Decode a t'Shutdown' payload.
+decode_shutdown :: BS.ByteString -> Either DecodeError Shutdown
+decode_shutdown = parse $ Shutdown <$> channel_id <*> script <*> tlvs []
+
+-- closing_complete, closing_sig ----------------------------------------------
+
+closing_known :: [Word64]
+closing_known = [1, 2, 3]
+
+closing_records
+ :: Maybe Signature -> Maybe Signature -> Maybe Signature -> [TlvRecord]
+closing_records a b c =
+ opt 1 BOLT1.un_signature a
+ <> opt 2 BOLT1.un_signature b
+ <> opt 3 BOLT1.un_signature c
+
+-- | Encode a t'ClosingComplete' payload.
+encode_closing_complete :: ClosingComplete -> Either EncodeError BS.ByteString
+encode_closing_complete m = do
+ ts <- encode_tlvs closing_known
+ (closing_records
+ (closing_complete_closer_output_only m)
+ (closing_complete_closee_output_only m)
+ (closing_complete_closer_and_closee_outputs m))
+ (closing_complete_tlvs m)
+ pure $ mconcat [
+ BOLT1.un_channel_id (closing_complete_channel_id m)
+ , script_bytes (closing_complete_closer_scriptpubkey m)
+ , script_bytes (closing_complete_closee_scriptpubkey m)
+ , BOLT1.encode_satoshi (closing_complete_fee_satoshis m)
+ , BOLT1.encode_u32 (closing_complete_locktime m)
+ , ts
]
--- | Decode a TxAbort message (type 74).
-decodeTxAbort
- :: BS.ByteString -> Either DecodeError (TxAbort, BS.ByteString)
-decodeTxAbort !bs = do
- (cid, rest1) <- decodeChannelIdBytes bs
- (dat, rest2) <- decodeU16Bytes rest1
- let !msg = TxAbort
- { txAbortChannelId = cid
- , txAbortData = dat
- }
- Right (msg, rest2)
-
--- Normal operation ------------------------------------------------------------
-
--- | Encode an UpdateAddHtlc message (type 128).
-encodeUpdateAddHtlc :: UpdateAddHtlc -> BS.ByteString
-encodeUpdateAddHtlc !m = mconcat
- [ unChannelId (updateAddHtlcChannelId m)
- , encodeU64 (unHtlcId (updateAddHtlcId m))
- , encodeU64 (unMilliSatoshi (updateAddHtlcAmountMsat m))
- , unPaymentHash (updateAddHtlcPaymentHash m)
- , encodeU32 (updateAddHtlcCltvExpiry m)
- , unOnionPacket (updateAddHtlcOnionPacket m)
- , encodeTlvStream (updateAddHtlcTlvs m)
- ]
-{-# INLINABLE encodeUpdateAddHtlc #-}
-
--- | Decode an UpdateAddHtlc message (type 128).
-decodeUpdateAddHtlc
- :: BS.ByteString -> Either DecodeError (UpdateAddHtlc, BS.ByteString)
-decodeUpdateAddHtlc !bs = do
- (cid, rest1) <- decodeChannelIdBytes bs
- (hid, rest2) <- maybe (Left DecodeInsufficientBytes) Right
- (decodeU64 rest1)
- (amtMsat, rest3) <- maybe (Left DecodeInsufficientBytes) Right
- (decodeU64 rest2)
- (pHash, rest4) <- decodePaymentHashBytes rest3
- (cltvExp, rest5) <- decodeU32E rest4
- (onion, rest6) <- decodeOnionPacketBytes rest5
- (tlvs, rest7) <- decodeOptionalTlvs rest6
- let !msg = UpdateAddHtlc
- { updateAddHtlcChannelId = cid
- , updateAddHtlcId = htlcId hid
- , updateAddHtlcAmountMsat = MilliSatoshi amtMsat
- , updateAddHtlcPaymentHash = pHash
- , updateAddHtlcCltvExpiry = cltvExp
- , updateAddHtlcOnionPacket = onion
- , updateAddHtlcTlvs = tlvs
- }
- Right (msg, rest7)
-{-# INLINABLE decodeUpdateAddHtlc #-}
-
--- | Encode an UpdateFulfillHtlc message (type 130).
-encodeUpdateFulfillHtlc :: UpdateFulfillHtlc -> BS.ByteString
-encodeUpdateFulfillHtlc !m = mconcat
- [ unChannelId (updateFulfillHtlcChannelId m)
- , encodeU64 (unHtlcId (updateFulfillHtlcId m))
- , unPaymentPreimage (updateFulfillHtlcPaymentPreimage m)
- , encodeTlvStream (updateFulfillHtlcTlvs m)
- ]
+-- | Decode a t'ClosingComplete' payload.
+decode_closing_complete
+ :: BS.ByteString -> Either DecodeError ClosingComplete
+decode_closing_complete = parse $ do
+ cid <- channel_id
+ closer <- script
+ closee <- script
+ fee <- satoshi
+ lock <- u32
+ s <- tlvs closing_known
+ a <- record 1 BOLT1.signature s
+ b <- record 2 BOLT1.signature s
+ c <- record 3 BOLT1.signature s
+ pure (ClosingComplete cid closer closee fee lock a b c
+ (unknown closing_known s))
+
+-- | Encode a t'ClosingSig' payload.
+encode_closing_sig :: ClosingSig -> Either EncodeError BS.ByteString
+encode_closing_sig m = do
+ ts <- encode_tlvs closing_known
+ (closing_records
+ (closing_sig_closer_output_only m)
+ (closing_sig_closee_output_only m)
+ (closing_sig_closer_and_closee_outputs m))
+ (closing_sig_tlvs m)
+ pure $ mconcat [
+ BOLT1.un_channel_id (closing_sig_channel_id m)
+ , script_bytes (closing_sig_closer_scriptpubkey m)
+ , script_bytes (closing_sig_closee_scriptpubkey m)
+ , BOLT1.encode_satoshi (closing_sig_fee_satoshis m)
+ , BOLT1.encode_u32 (closing_sig_locktime m)
+ , ts
+ ]
--- | Decode an UpdateFulfillHtlc message (type 130).
-decodeUpdateFulfillHtlc
- :: BS.ByteString -> Either DecodeError (UpdateFulfillHtlc, BS.ByteString)
-decodeUpdateFulfillHtlc !bs = do
- (cid, rest1) <- decodeChannelIdBytes bs
- (hid, rest2) <- maybe (Left DecodeInsufficientBytes) Right
- (decodeU64 rest1)
- (preimage, rest3) <- decodePaymentPreimageBytes rest2
- (tlvs, rest4) <- decodeOptionalTlvs rest3
- let !msg = UpdateFulfillHtlc
- { updateFulfillHtlcChannelId = cid
- , updateFulfillHtlcId = htlcId hid
- , updateFulfillHtlcPaymentPreimage = preimage
- , updateFulfillHtlcTlvs = tlvs
- }
- Right (msg, rest4)
-
--- | Encode an UpdateFailHtlc message (type 131).
-encodeUpdateFailHtlc :: UpdateFailHtlc -> Either EncodeError BS.ByteString
-encodeUpdateFailHtlc !m = do
- reasonEnc <- encodeU16BytesE (updateFailHtlcReason m)
- Right $! mconcat
- [ unChannelId (updateFailHtlcChannelId m)
- , encodeU64 (unHtlcId (updateFailHtlcId m))
- , reasonEnc
- , encodeTlvStream (updateFailHtlcTlvs m)
+-- | Decode a t'ClosingSig' payload.
+decode_closing_sig :: BS.ByteString -> Either DecodeError ClosingSig
+decode_closing_sig = parse $ do
+ cid <- channel_id
+ closer <- script
+ closee <- script
+ fee <- satoshi
+ lock <- u32
+ s <- tlvs closing_known
+ a <- record 1 BOLT1.signature s
+ b <- record 2 BOLT1.signature s
+ c <- record 3 BOLT1.signature s
+ pure (ClosingSig cid closer closee fee lock a b c
+ (unknown closing_known s))
+
+-- closing_signed -------------------------------------------------------------
+
+closing_signed_known :: [Word64]
+closing_signed_known = [1]
+
+-- | Encode a t'ClosingSigned' payload.
+encode_closing_signed :: ClosingSigned -> Either EncodeError BS.ByteString
+encode_closing_signed m = do
+ ts <- encode_tlvs closing_signed_known
+ (opt 1 fee_range_bytes (closing_signed_fee_range m))
+ (closing_signed_tlvs m)
+ pure $ mconcat [
+ BOLT1.un_channel_id (closing_signed_channel_id m)
+ , BOLT1.encode_satoshi (closing_signed_fee_satoshis m)
+ , BOLT1.un_signature (closing_signed_signature m)
+ , ts
]
--- | Decode an UpdateFailHtlc message (type 131).
-decodeUpdateFailHtlc
- :: BS.ByteString -> Either DecodeError (UpdateFailHtlc, BS.ByteString)
-decodeUpdateFailHtlc !bs = do
- (cid, rest1) <- decodeChannelIdBytes bs
- (hid, rest2) <- maybe (Left DecodeInsufficientBytes) Right
- (decodeU64 rest1)
- (reason, rest3) <- decodeU16Bytes rest2
- (tlvs, rest4) <- decodeOptionalTlvs rest3
- let !msg = UpdateFailHtlc
- { updateFailHtlcChannelId = cid
- , updateFailHtlcId = htlcId hid
- , updateFailHtlcReason = reason
- , updateFailHtlcTlvs = tlvs
- }
- Right (msg, rest4)
-
--- | Encode an UpdateFailMalformedHtlc message (type 135).
-encodeUpdateFailMalformedHtlc :: UpdateFailMalformedHtlc -> BS.ByteString
-encodeUpdateFailMalformedHtlc !m = mconcat
- [ unChannelId (updateFailMalformedHtlcChannelId m)
- , encodeU64 (unHtlcId (updateFailMalformedHtlcId m))
- , unPaymentHash (updateFailMalformedHtlcSha256Onion m)
- , encodeU16 (updateFailMalformedHtlcFailureCode m)
- ]
+-- | Decode a t'ClosingSigned' payload.
+decode_closing_signed :: BS.ByteString -> Either DecodeError ClosingSigned
+decode_closing_signed = parse $ do
+ cid <- channel_id
+ fee <- satoshi
+ sig <- signature
+ s <- tlvs closing_signed_known
+ range <- record 1 tlv_fee_range s
+ pure (ClosingSigned cid fee sig range (unknown closing_signed_known s))
+
+-- update_add_htlc ------------------------------------------------------------
+
+update_add_htlc_known :: [Word64]
+update_add_htlc_known = [0]
+
+-- | Encode an t'UpdateAddHtlc' payload.
+encode_update_add_htlc :: UpdateAddHtlc -> Either EncodeError BS.ByteString
+encode_update_add_htlc m = do
+ ts <- encode_tlvs update_add_htlc_known
+ (opt 0 BOLT1.un_point (update_add_htlc_path_key m))
+ (update_add_htlc_tlvs m)
+ let HtlcId hid = update_add_htlc_id m
+ pure $ mconcat [
+ BOLT1.un_channel_id (update_add_htlc_channel_id m)
+ , BOLT1.encode_u64 hid
+ , BOLT1.encode_milli_satoshi (update_add_htlc_amount_msat m)
+ , BOLT1.un_payment_hash (update_add_htlc_payment_hash m)
+ , BOLT1.encode_u32 (update_add_htlc_cltv_expiry m)
+ , un_onion_routing_packet (update_add_htlc_onion_routing_packet m)
+ , ts
+ ]
--- | Decode an UpdateFailMalformedHtlc message (type 135).
-decodeUpdateFailMalformedHtlc
- :: BS.ByteString -> Either DecodeError (UpdateFailMalformedHtlc, BS.ByteString)
-decodeUpdateFailMalformedHtlc !bs = do
- (cid, rest1) <- decodeChannelIdBytes bs
- (hid, rest2) <- maybe (Left DecodeInsufficientBytes) Right
- (decodeU64 rest1)
- (sha256Onion, rest3) <- decodePaymentHashBytes rest2
- (failCode, rest4) <- decodeU16E rest3
- let !msg = UpdateFailMalformedHtlc
- { updateFailMalformedHtlcChannelId = cid
- , updateFailMalformedHtlcId = htlcId hid
- , updateFailMalformedHtlcSha256Onion = sha256Onion
- , updateFailMalformedHtlcFailureCode = failCode
- }
- Right (msg, rest4)
-
--- | Encode a CommitmentSigned message (type 132).
-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
-{-# INLINABLE encodeCommitmentSigned #-}
-
--- | Decode a CommitmentSigned message (type 132).
-decodeCommitmentSigned
- :: BS.ByteString -> Either DecodeError (CommitmentSigned, BS.ByteString)
-decodeCommitmentSigned !bs = do
- (cid, rest1) <- decodeChannelIdBytes bs
- (sig, rest2) <- decodeSignatureBytes rest1
- (numHtlcs, rest3) <- decodeU16E rest2
- (htlcSigs, rest4) <- decodeSignatures (fromIntegral numHtlcs) rest3
- let !msg = CommitmentSigned
- { commitmentSignedChannelId = cid
- , commitmentSignedSignature = sig
- , commitmentSignedHtlcSignatures = htlcSigs
- }
- Right (msg, rest4)
- where
- decodeSignatures :: Int -> BS.ByteString
- -> Either DecodeError ([Signature], BS.ByteString)
- decodeSignatures !n !input = go n input []
- where
- go :: Int -> BS.ByteString -> [Signature]
- -> Either DecodeError ([Signature], BS.ByteString)
- go 0 !remaining !acc = Right (reverse acc, remaining)
- go !count !remaining !acc = do
- (s, rest) <- decodeSignatureBytes remaining
- go (count - 1) rest (s : acc)
-{-# INLINABLE decodeCommitmentSigned #-}
-
--- | Encode a RevokeAndAck message (type 133).
-encodeRevokeAndAck :: RevokeAndAck -> BS.ByteString
-encodeRevokeAndAck !m = mconcat
- [ unChannelId (revokeAndAckChannelId m)
- , unPerCommitmentSecret (revokeAndAckPerCommitmentSecret m)
- , unPoint (revokeAndAckNextPerCommitPoint m)
- ]
+-- | Decode an t'UpdateAddHtlc' payload.
+decode_update_add_htlc :: BS.ByteString -> Either DecodeError UpdateAddHtlc
+decode_update_add_htlc = parse $ do
+ cid <- channel_id
+ hid <- htlc_id
+ amt <- milli_satoshi
+ ph <- payment_hash
+ cltv <- u32
+ onion <- sized 1366 onion_routing_packet
+ s <- tlvs update_add_htlc_known
+ pk <- record 0 tlv_point s
+ pure (UpdateAddHtlc cid hid amt ph cltv onion pk
+ (unknown update_add_htlc_known s))
+
+-- update_fulfill_htlc --------------------------------------------------------
+
+update_fulfill_htlc_known :: [Word64]
+update_fulfill_htlc_known = [1, 3]
+
+-- | Encode an t'UpdateFulfillHtlc' payload.
+encode_update_fulfill_htlc
+ :: UpdateFulfillHtlc -> Either EncodeError BS.ByteString
+encode_update_fulfill_htlc m = do
+ ts <- encode_tlvs update_fulfill_htlc_known
+ ( opt 1 un_attribution_data (update_fulfill_htlc_attribution_data m)
+ <> opt 3 id (update_fulfill_htlc_fulfillment_payload m) )
+ (update_fulfill_htlc_tlvs m)
+ let HtlcId hid = update_fulfill_htlc_id m
+ pure $ mconcat [
+ BOLT1.un_channel_id (update_fulfill_htlc_channel_id m)
+ , BOLT1.encode_u64 hid
+ , BOLT1.un_payment_preimage (update_fulfill_htlc_payment_preimage m)
+ , ts
+ ]
+
+-- | Decode an t'UpdateFulfillHtlc' payload.
+decode_update_fulfill_htlc
+ :: BS.ByteString -> Either DecodeError UpdateFulfillHtlc
+decode_update_fulfill_htlc = parse $ do
+ cid <- channel_id
+ hid <- htlc_id
+ pre <- payment_preimage
+ s <- tlvs update_fulfill_htlc_known
+ att <- record 1 attribution_data s
+ pay <- record 3 Just s
+ pure (UpdateFulfillHtlc cid hid pre att pay
+ (unknown update_fulfill_htlc_known s))
+
+-- update_fail_htlc -----------------------------------------------------------
+
+update_fail_htlc_known :: [Word64]
+update_fail_htlc_known = [1]
+
+-- | Encode an t'UpdateFailHtlc' payload. Fails if @reason@ exceeds 65535
+-- bytes.
+encode_update_fail_htlc :: UpdateFailHtlc -> Either EncodeError BS.ByteString
+encode_update_fail_htlc m = do
+ reason <- u16_prefixed (update_fail_htlc_reason m)
+ ts <- encode_tlvs update_fail_htlc_known
+ (opt 1 un_attribution_data (update_fail_htlc_attribution_data m))
+ (update_fail_htlc_tlvs m)
+ let HtlcId hid = update_fail_htlc_id m
+ pure $ mconcat [
+ BOLT1.un_channel_id (update_fail_htlc_channel_id m)
+ , BOLT1.encode_u64 hid
+ , reason
+ , ts
+ ]
--- | Decode a RevokeAndAck message (type 133).
-decodeRevokeAndAck
- :: BS.ByteString -> Either DecodeError (RevokeAndAck, BS.ByteString)
-decodeRevokeAndAck !bs = do
- (cid, rest1) <- decodeChannelIdBytes bs
- (sec, rest2) <- decodePerCommitmentSecretBytes rest1
- (nextPoint, rest3) <- decodePointBytes rest2
- let !msg = RevokeAndAck
- { revokeAndAckChannelId = cid
- , revokeAndAckPerCommitmentSecret = sec
- , revokeAndAckNextPerCommitPoint = nextPoint
- }
- Right (msg, rest3)
-
--- | Encode an UpdateFee message (type 134).
-encodeUpdateFee :: UpdateFee -> BS.ByteString
-encodeUpdateFee !m = mconcat
- [ unChannelId (updateFeeChannelId m)
- , encodeU32 (updateFeeFeeratePerKw m)
+-- | Decode an t'UpdateFailHtlc' payload.
+decode_update_fail_htlc :: BS.ByteString -> Either DecodeError UpdateFailHtlc
+decode_update_fail_htlc = parse $ do
+ cid <- channel_id
+ hid <- htlc_id
+ reason <- prefixed
+ s <- tlvs update_fail_htlc_known
+ att <- record 1 attribution_data s
+ pure (UpdateFailHtlc cid hid reason att (unknown update_fail_htlc_known s))
+
+-- update_fail_malformed_htlc -------------------------------------------------
+
+-- | Encode an t'UpdateFailMalformedHtlc' payload.
+encode_update_fail_malformed_htlc :: UpdateFailMalformedHtlc -> BS.ByteString
+encode_update_fail_malformed_htlc
+ (UpdateFailMalformedHtlc cid (HtlcId hid) oh code ts) = mconcat [
+ BOLT1.un_channel_id cid
+ , BOLT1.encode_u64 hid
+ , un_onion_hash oh
+ , BOLT1.encode_u16 code
+ , BOLT1.encode_tlv_stream ts
+ ]
+
+-- | Decode an t'UpdateFailMalformedHtlc' payload.
+decode_update_fail_malformed_htlc
+ :: BS.ByteString -> Either DecodeError UpdateFailMalformedHtlc
+decode_update_fail_malformed_htlc = parse $
+ UpdateFailMalformedHtlc <$> channel_id <*> htlc_id <*> sized 32 onion_hash
+ <*> u16 <*> tlvs []
+
+-- commitment_signed ----------------------------------------------------------
+
+commitment_signed_known :: [Word64]
+commitment_signed_known = [1]
+
+-- | Encode a t'CommitmentSigned' payload. Fails if there are more than
+-- 65535 HTLC signatures.
+encode_commitment_signed
+ :: CommitmentSigned -> Either EncodeError BS.ByteString
+encode_commitment_signed m = do
+ let sigs = commitment_signed_htlc_signatures m
+ n <- count_prefix sigs
+ ts <- encode_tlvs commitment_signed_known
+ (opt 1 txid_bytes (commitment_signed_funding_txid m))
+ (commitment_signed_tlvs m)
+ pure $ mconcat [
+ BOLT1.un_channel_id (commitment_signed_channel_id m)
+ , BOLT1.un_signature (commitment_signed_signature m)
+ , n
+ , mconcat (map BOLT1.un_signature sigs)
+ , ts
+ ]
+
+-- | Decode a t'CommitmentSigned' payload.
+decode_commitment_signed
+ :: BS.ByteString -> Either DecodeError CommitmentSigned
+decode_commitment_signed = parse $ do
+ cid <- channel_id
+ sig <- signature
+ n <- u16
+ sigs <- count (fromIntegral n) signature
+ s <- tlvs commitment_signed_known
+ fund <- record 1 mkTxId s
+ pure (CommitmentSigned cid sig sigs fund (unknown commitment_signed_known s))
+
+-- revoke_and_ack, update_fee -------------------------------------------------
+
+-- | Encode a t'RevokeAndAck' payload.
+encode_revoke_and_ack :: RevokeAndAck -> BS.ByteString
+encode_revoke_and_ack (RevokeAndAck cid sec pcp ts) = mconcat [
+ BOLT1.un_channel_id cid
+ , BOLT1.un_per_commitment_secret sec
+ , BOLT1.un_point pcp
+ , BOLT1.encode_tlv_stream ts
]
--- | Decode an UpdateFee message (type 134).
-decodeUpdateFee
- :: BS.ByteString -> Either DecodeError (UpdateFee, BS.ByteString)
-decodeUpdateFee !bs = do
- (cid, rest1) <- decodeChannelIdBytes bs
- (feerate, rest2) <- decodeU32E rest1
- let !msg = UpdateFee
- { updateFeeChannelId = cid
- , updateFeeFeeratePerKw = feerate
- }
- Right (msg, rest2)
-
--- Channel reestablishment -----------------------------------------------------
-
--- | Encode a ChannelReestablish message (type 136).
-encodeChannelReestablish :: ChannelReestablish -> BS.ByteString
-encodeChannelReestablish !m = mconcat
- [ unChannelId (channelReestablishChannelId m)
- , encodeU64 (channelReestablishNextCommitNum m)
- , encodeU64 (channelReestablishNextRevocationNum m)
- , unPerCommitmentSecret (channelReestablishYourLastCommitSecret m)
- , unPoint (channelReestablishMyCurrentCommitPoint m)
- , encodeTlvStream (channelReestablishTlvs m)
+-- | Decode a t'RevokeAndAck' payload.
+decode_revoke_and_ack :: BS.ByteString -> Either DecodeError RevokeAndAck
+decode_revoke_and_ack = parse $
+ RevokeAndAck <$> channel_id <*> per_commitment_secret <*> point <*> tlvs []
+
+-- | Encode an t'UpdateFee' payload.
+encode_update_fee :: UpdateFee -> BS.ByteString
+encode_update_fee (UpdateFee cid fee ts) = mconcat [
+ BOLT1.un_channel_id cid
+ , BOLT1.encode_u32 fee
+ , BOLT1.encode_tlv_stream ts
]
--- | Decode a ChannelReestablish message (type 136).
-decodeChannelReestablish
- :: BS.ByteString -> Either DecodeError (ChannelReestablish, BS.ByteString)
-decodeChannelReestablish !bs = do
- (cid, rest1) <- decodeChannelIdBytes bs
- (nextCommit, rest2) <- maybe (Left DecodeInsufficientBytes) Right
- (decodeU64 rest1)
- (nextRevoke, rest3) <- maybe (Left DecodeInsufficientBytes) Right
- (decodeU64 rest2)
- (sec, rest4) <- decodePerCommitmentSecretBytes rest3
- (myPoint, rest5) <- decodePointBytes rest4
- (tlvs, rest6) <- decodeOptionalTlvs rest5
- let !msg = ChannelReestablish
- { channelReestablishChannelId = cid
- , channelReestablishNextCommitNum = nextCommit
- , channelReestablishNextRevocationNum = nextRevoke
- , channelReestablishYourLastCommitSecret = sec
- , channelReestablishMyCurrentCommitPoint = myPoint
- , channelReestablishTlvs = tlvs
- }
- Right (msg, rest6)
+-- | Decode an t'UpdateFee' payload.
+decode_update_fee :: BS.ByteString -> Either DecodeError UpdateFee
+decode_update_fee = parse $ UpdateFee <$> channel_id <*> u32 <*> tlvs []
+
+-- channel_reestablish --------------------------------------------------------
+
+channel_reestablish_known :: [Word64]
+channel_reestablish_known = [1]
+
+-- | Encode a t'ChannelReestablish' payload.
+encode_channel_reestablish
+ :: ChannelReestablish -> Either EncodeError BS.ByteString
+encode_channel_reestablish m = do
+ ts <- encode_tlvs channel_reestablish_known
+ (opt 1 next_funding_bytes (channel_reestablish_next_funding m))
+ (channel_reestablish_tlvs m)
+ pure $ mconcat [
+ BOLT1.un_channel_id (channel_reestablish_channel_id m)
+ , BOLT1.encode_u64 (channel_reestablish_next_commitment_number m)
+ , BOLT1.encode_u64 (channel_reestablish_next_revocation_number m)
+ , BOLT1.un_per_commitment_secret
+ (channel_reestablish_your_last_per_commitment_secret m)
+ , BOLT1.un_point (channel_reestablish_my_current_per_commitment_point m)
+ , ts
+ ]
+
+-- | Decode a t'ChannelReestablish' payload.
+decode_channel_reestablish
+ :: BS.ByteString -> Either DecodeError ChannelReestablish
+decode_channel_reestablish = parse $ do
+ cid <- channel_id
+ nc <- u64
+ nr <- u64
+ sec <- per_commitment_secret
+ pcp <- point
+ s <- tlvs channel_reestablish_known
+ next <- record 1 tlv_next_funding s
+ pure (ChannelReestablish cid nc nr sec pcp next
+ (unknown channel_reestablish_known s))
diff --git a/lib/Lightning/Protocol/BOLT2/Messages.hs b/lib/Lightning/Protocol/BOLT2/Messages.hs
@@ -1,7 +1,5 @@
-{-# OPTIONS_HADDOCK prune #-}
-{-# LANGUAGE BangPatterns #-}
+{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DerivingStrategies #-}
-- |
-- Module: Lightning.Protocol.BOLT2.Messages
@@ -9,27 +7,18 @@
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
--- Message types for BOLT #2 peer protocol.
---
--- This module defines per-message record types and a top-level Message
--- sum type for all BOLT #2 messages.
+-- The messages defined by BOLT #2.
module Lightning.Protocol.BOLT2.Messages (
- -- * Message type codes
- MsgType(..)
- , msgTypeWord
-
- -- * Top-level message type
- , Message(..)
+ Message(..)
+ , message_type
- -- * Channel establishment v1
, OpenChannel(..)
, AcceptChannel(..)
, FundingCreated(..)
, FundingSigned(..)
, ChannelReady(..)
- -- * Channel establishment v2
, OpenChannel2(..)
, AcceptChannel2(..)
, TxAddInput(..)
@@ -42,14 +31,13 @@ module Lightning.Protocol.BOLT2.Messages (
, TxAckRbf(..)
, TxAbort(..)
- -- * Channel close
, Stfu(..)
+
, Shutdown(..)
- , ClosingSigned(..)
, ClosingComplete(..)
, ClosingSig(..)
+ , ClosingSigned(..)
- -- * Normal operation
, UpdateAddHtlc(..)
, UpdateFulfillHtlc(..)
, UpdateFailHtlc(..)
@@ -58,544 +46,556 @@ module Lightning.Protocol.BOLT2.Messages (
, RevokeAndAck(..)
, UpdateFee(..)
- -- * Reestablishment
, ChannelReestablish(..)
-
- -- * Witness data
- , Witness(..)
) where
+import Bitcoin.Prim.Tx (TxId)
import Control.DeepSeq (NFData)
import qualified Data.ByteString as BS
+import Data.Int (Int64)
import Data.Word (Word8, Word16, Word32, Word64)
import GHC.Generics (Generic)
-import Lightning.Protocol.BOLT1 (TlvStream)
+import Lightning.Protocol.BOLT1
+ ( ChainHash, ChannelId, Signature, Point, PaymentHash, PaymentPreimage
+ , PerCommitmentSecret, ShortChannelId, Satoshi, MilliSatoshi, TlvStream )
+import qualified Lightning.Protocol.BOLT9 as BOLT9
import Lightning.Protocol.BOLT2.Types
--- Message type codes ----------------------------------------------------------
-
--- | BOLT #2 message type codes.
-data MsgType
- = MsgStfu -- ^ 2
- | MsgOpenChannel -- ^ 32
- | MsgAcceptChannel -- ^ 33
- | MsgFundingCreated -- ^ 34
- | MsgFundingSigned -- ^ 35
- | MsgChannelReady -- ^ 36
- | MsgShutdown -- ^ 38
- | MsgClosingSigned -- ^ 39
- | MsgClosingComplete -- ^ 40
- | MsgClosingSig -- ^ 41
- | MsgOpenChannel2 -- ^ 64
- | MsgAcceptChannel2 -- ^ 65
- | MsgTxAddInput -- ^ 66
- | MsgTxAddOutput -- ^ 67
- | MsgTxRemoveInput -- ^ 68
- | MsgTxRemoveOutput -- ^ 69
- | MsgTxComplete -- ^ 70
- | MsgTxSignatures -- ^ 71
- | MsgTxInitRbf -- ^ 72
- | MsgTxAckRbf -- ^ 73
- | MsgTxAbort -- ^ 74
- | MsgUpdateAddHtlc -- ^ 128
- | MsgUpdateFulfillHtlc -- ^ 130
- | MsgUpdateFailHtlc -- ^ 131
- | MsgCommitmentSigned -- ^ 132
- | MsgRevokeAndAck -- ^ 133
- | MsgUpdateFee -- ^ 134
- | MsgUpdateFailMalformedHtlc -- ^ 135
- | MsgChannelReestablish -- ^ 136
- deriving stock (Eq, Ord, Show, Generic)
-
-instance NFData MsgType
-
--- | Get the numeric type code for a message type.
-msgTypeWord :: MsgType -> Word16
-msgTypeWord MsgStfu = 2
-msgTypeWord MsgOpenChannel = 32
-msgTypeWord MsgAcceptChannel = 33
-msgTypeWord MsgFundingCreated = 34
-msgTypeWord MsgFundingSigned = 35
-msgTypeWord MsgChannelReady = 36
-msgTypeWord MsgShutdown = 38
-msgTypeWord MsgClosingSigned = 39
-msgTypeWord MsgClosingComplete = 40
-msgTypeWord MsgClosingSig = 41
-msgTypeWord MsgOpenChannel2 = 64
-msgTypeWord MsgAcceptChannel2 = 65
-msgTypeWord MsgTxAddInput = 66
-msgTypeWord MsgTxAddOutput = 67
-msgTypeWord MsgTxRemoveInput = 68
-msgTypeWord MsgTxRemoveOutput = 69
-msgTypeWord MsgTxComplete = 70
-msgTypeWord MsgTxSignatures = 71
-msgTypeWord MsgTxInitRbf = 72
-msgTypeWord MsgTxAckRbf = 73
-msgTypeWord MsgTxAbort = 74
-msgTypeWord MsgUpdateAddHtlc = 128
-msgTypeWord MsgUpdateFulfillHtlc = 130
-msgTypeWord MsgUpdateFailHtlc = 131
-msgTypeWord MsgCommitmentSigned = 132
-msgTypeWord MsgRevokeAndAck = 133
-msgTypeWord MsgUpdateFee = 134
-msgTypeWord MsgUpdateFailMalformedHtlc = 135
-msgTypeWord MsgChannelReestablish = 136
-{-# INLINE msgTypeWord #-}
-
--- Channel establishment v1 ----------------------------------------------------
-
--- | The open_channel message (type 32).
---
--- Contains information about a node and indicates its desire to set up
--- a new channel.
+-- channel establishment v1 ---------------------------------------------------
+
+-- | The @open_channel@ message (type 32).
data OpenChannel = OpenChannel
- { openChannelChainHash :: !ChainHash
- , openChannelTempChannelId :: !ChannelId
- , openChannelFundingSatoshi :: {-# UNPACK #-} !Satoshi
- , openChannelPushMsat :: {-# UNPACK #-} !MilliSatoshi
- , openChannelDustLimitSatoshi :: {-# UNPACK #-} !Satoshi
- , openChannelMaxHtlcValueInFlight :: {-# UNPACK #-} !MilliSatoshi
- , openChannelChannelReserveSat :: {-# UNPACK #-} !Satoshi
- , openChannelHtlcMinimumMsat :: {-# UNPACK #-} !MilliSatoshi
- , openChannelFeeratePerKw :: {-# UNPACK #-} !Word32
- , openChannelToSelfDelay :: {-# UNPACK #-} !Word16
- , openChannelMaxAcceptedHtlcs :: {-# UNPACK #-} !Word16
- , openChannelFundingPubkey :: !Point
- , openChannelRevocationBasepoint :: !Point
- , openChannelPaymentBasepoint :: !Point
- , openChannelDelayedPaymentBase :: !Point
- , openChannelHtlcBasepoint :: !Point
- , openChannelFirstPerCommitPoint :: !Point
- , openChannelChannelFlags :: {-# UNPACK #-} !Word8
- , openChannelTlvs :: !TlvStream
- } deriving stock (Eq, Show, Generic)
+ { open_channel_chain_hash :: !ChainHash
+ , open_channel_temporary_channel_id :: !ChannelId
+ , open_channel_funding_satoshis :: {-# UNPACK #-} !Satoshi
+ , open_channel_push_msat :: {-# UNPACK #-} !MilliSatoshi
+ , open_channel_dust_limit_satoshis :: {-# UNPACK #-} !Satoshi
+ , open_channel_max_htlc_value_in_flight_msat :: {-# UNPACK #-} !Word64
+ -- ^ a cap, often @maxBound@, so not a bounded amount
+ , open_channel_channel_reserve_satoshis :: {-# UNPACK #-} !Satoshi
+ , open_channel_htlc_minimum_msat :: {-# UNPACK #-} !MilliSatoshi
+ , open_channel_feerate_per_kw :: {-# UNPACK #-} !Word32
+ , open_channel_to_self_delay :: {-# UNPACK #-} !Word16
+ , open_channel_max_accepted_htlcs :: {-# UNPACK #-} !Word16
+ , open_channel_funding_pubkey :: !Point
+ , open_channel_revocation_basepoint :: !Point
+ , open_channel_payment_basepoint :: !Point
+ , open_channel_delayed_payment_basepoint :: !Point
+ , open_channel_htlc_basepoint :: !Point
+ , open_channel_first_per_commitment_point :: !Point
+ , open_channel_channel_flags :: {-# UNPACK #-} !Word8
+ -- ^ bit 0: @announce_channel@
+ , open_channel_upfront_shutdown_script :: !(Maybe ScriptPubKey)
+ -- ^ TLV type 0; an empty script commits to no particular script
+ , open_channel_channel_type :: !(Maybe BOLT9.FeatureVector)
+ -- ^ TLV type 1
+ , open_channel_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData OpenChannel
--- | The accept_channel message (type 33).
---
--- Contains information about a node and indicates its acceptance of
--- the new channel.
+-- | The @accept_channel@ message (type 33).
data AcceptChannel = AcceptChannel
- { acceptChannelTempChannelId :: !ChannelId
- , acceptChannelDustLimitSatoshi :: {-# UNPACK #-} !Satoshi
- , acceptChannelMaxHtlcValueInFlight :: {-# UNPACK #-} !MilliSatoshi
- , acceptChannelChannelReserveSat :: {-# UNPACK #-} !Satoshi
- , acceptChannelHtlcMinimumMsat :: {-# UNPACK #-} !MilliSatoshi
- , acceptChannelMinimumDepth :: {-# UNPACK #-} !Word32
- , acceptChannelToSelfDelay :: {-# UNPACK #-} !Word16
- , acceptChannelMaxAcceptedHtlcs :: {-# UNPACK #-} !Word16
- , acceptChannelFundingPubkey :: !Point
- , acceptChannelRevocationBasepoint :: !Point
- , acceptChannelPaymentBasepoint :: !Point
- , acceptChannelDelayedPaymentBase :: !Point
- , acceptChannelHtlcBasepoint :: !Point
- , acceptChannelFirstPerCommitPoint :: !Point
- , acceptChannelTlvs :: !TlvStream
- } deriving stock (Eq, Show, Generic)
+ { accept_channel_temporary_channel_id :: !ChannelId
+ , accept_channel_dust_limit_satoshis :: {-# UNPACK #-} !Satoshi
+ , accept_channel_max_htlc_value_in_flight_msat :: {-# UNPACK #-} !Word64
+ -- ^ a cap, often @maxBound@, so not a bounded amount
+ , accept_channel_channel_reserve_satoshis :: {-# UNPACK #-} !Satoshi
+ , accept_channel_htlc_minimum_msat
+ :: {-# UNPACK #-} !MilliSatoshi
+ , accept_channel_minimum_depth :: {-# UNPACK #-} !Word32
+ , accept_channel_to_self_delay :: {-# UNPACK #-} !Word16
+ , accept_channel_max_accepted_htlcs :: {-# UNPACK #-} !Word16
+ , accept_channel_funding_pubkey :: !Point
+ , accept_channel_revocation_basepoint :: !Point
+ , accept_channel_payment_basepoint :: !Point
+ , accept_channel_delayed_payment_basepoint :: !Point
+ , accept_channel_htlc_basepoint :: !Point
+ , accept_channel_first_per_commitment_point :: !Point
+ , accept_channel_upfront_shutdown_script :: !(Maybe ScriptPubKey)
+ -- ^ TLV type 0; an empty script commits to no particular script
+ , accept_channel_channel_type
+ :: !(Maybe BOLT9.FeatureVector)
+ -- ^ TLV type 1
+ , accept_channel_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData AcceptChannel
--- | The funding_created message (type 34).
---
--- Describes the outpoint which the funder has created for the initial
--- commitment transactions.
+-- | The @funding_created@ message (type 34).
data FundingCreated = FundingCreated
- { fundingCreatedTempChannelId :: !ChannelId
- , fundingCreatedFundingTxid :: !TxId
- , fundingCreatedFundingOutIdx :: {-# UNPACK #-} !Word16
- , fundingCreatedSignature :: !Signature
- } deriving stock (Eq, Show, Generic)
+ { funding_created_temporary_channel_id :: !ChannelId
+ , funding_created_funding_txid :: !TxId
+ , funding_created_funding_output_index :: {-# UNPACK #-} !Word16
+ , funding_created_signature :: !Signature
+ , funding_created_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData FundingCreated
--- | The funding_signed message (type 35).
---
--- Gives the funder the signature for the first commitment transaction.
+-- | The @funding_signed@ message (type 35).
data FundingSigned = FundingSigned
- { fundingSignedChannelId :: !ChannelId
- , fundingSignedSignature :: !Signature
- } deriving stock (Eq, Show, Generic)
+ { funding_signed_channel_id :: !ChannelId
+ , funding_signed_signature :: !Signature
+ , funding_signed_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData FundingSigned
--- | The channel_ready message (type 36).
---
--- Indicates that the funding transaction has sufficient confirms for
--- channel use.
+-- | The @channel_ready@ message (type 36).
data ChannelReady = ChannelReady
- { channelReadyChannelId :: !ChannelId
- , channelReadySecondPerCommitPoint :: !Point
- , channelReadyTlvs :: !TlvStream
- } deriving stock (Eq, Show, Generic)
+ { channel_ready_channel_id :: !ChannelId
+ , channel_ready_second_per_commitment_point :: !Point
+ , channel_ready_alias :: !(Maybe ShortChannelId)
+ -- ^ the @short_channel_id@ record (TLV type 1)
+ , channel_ready_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData ChannelReady
--- Channel establishment v2 ----------------------------------------------------
+-- channel establishment v2 ---------------------------------------------------
--- | The open_channel2 message (type 64).
---
--- Initiates the v2 channel establishment workflow.
+-- | The @open_channel2@ message (type 64).
data OpenChannel2 = OpenChannel2
- { openChannel2ChainHash :: !ChainHash
- , openChannel2TempChannelId :: !ChannelId
- , openChannel2FundingFeeratePerkw :: {-# UNPACK #-} !Word32
- , openChannel2CommitFeeratePerkw :: {-# UNPACK #-} !Word32
- , openChannel2FundingSatoshi :: {-# UNPACK #-} !Satoshi
- , openChannel2DustLimitSatoshi :: {-# UNPACK #-} !Satoshi
- , openChannel2MaxHtlcValueInFlight :: {-# UNPACK #-} !MilliSatoshi
- , openChannel2HtlcMinimumMsat :: {-# UNPACK #-} !MilliSatoshi
- , openChannel2ToSelfDelay :: {-# UNPACK #-} !Word16
- , openChannel2MaxAcceptedHtlcs :: {-# UNPACK #-} !Word16
- , openChannel2Locktime :: {-# UNPACK #-} !Word32
- , openChannel2FundingPubkey :: !Point
- , openChannel2RevocationBasepoint :: !Point
- , openChannel2PaymentBasepoint :: !Point
- , openChannel2DelayedPaymentBase :: !Point
- , openChannel2HtlcBasepoint :: !Point
- , openChannel2FirstPerCommitPoint :: !Point
- , openChannel2SecondPerCommitPoint :: !Point
- , openChannel2ChannelFlags :: {-# UNPACK #-} !Word8
- , openChannel2Tlvs :: !TlvStream
- } deriving stock (Eq, Show, Generic)
+ { open_channel2_chain_hash :: !ChainHash
+ , open_channel2_temporary_channel_id :: !ChannelId
+ , open_channel2_funding_feerate_perkw :: {-# UNPACK #-} !Word32
+ , open_channel2_commitment_feerate_perkw :: {-# UNPACK #-} !Word32
+ , open_channel2_funding_satoshis :: {-# UNPACK #-} !Satoshi
+ , open_channel2_dust_limit_satoshis :: {-# UNPACK #-} !Satoshi
+ , open_channel2_max_htlc_value_in_flight_msat :: {-# UNPACK #-} !Word64
+ -- ^ a cap, often @maxBound@, so not a bounded amount
+ , open_channel2_htlc_minimum_msat
+ :: {-# UNPACK #-} !MilliSatoshi
+ , open_channel2_to_self_delay :: {-# UNPACK #-} !Word16
+ , open_channel2_max_accepted_htlcs :: {-# UNPACK #-} !Word16
+ , open_channel2_locktime :: {-# UNPACK #-} !Word32
+ , open_channel2_funding_pubkey :: !Point
+ , open_channel2_revocation_basepoint :: !Point
+ , open_channel2_payment_basepoint :: !Point
+ , open_channel2_delayed_payment_basepoint :: !Point
+ , open_channel2_htlc_basepoint :: !Point
+ , open_channel2_first_per_commitment_point :: !Point
+ , open_channel2_second_per_commitment_point :: !Point
+ , open_channel2_channel_flags :: {-# UNPACK #-} !Word8
+ -- ^ bit 0: @announce_channel@
+ , open_channel2_upfront_shutdown_script :: !(Maybe ScriptPubKey)
+ -- ^ TLV type 0; an empty script commits to no particular script
+ , open_channel2_channel_type
+ :: !(Maybe BOLT9.FeatureVector)
+ -- ^ TLV type 1
+ , open_channel2_require_confirmed_inputs :: !Bool
+ -- ^ TLV type 2
+ , open_channel2_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData OpenChannel2
--- | The accept_channel2 message (type 65).
---
--- Indicates acceptance of the v2 channel.
+-- | The @accept_channel2@ message (type 65).
data AcceptChannel2 = AcceptChannel2
- { acceptChannel2TempChannelId :: !ChannelId
- , acceptChannel2FundingSatoshi :: {-# UNPACK #-} !Satoshi
- , acceptChannel2DustLimitSatoshi :: {-# UNPACK #-} !Satoshi
- , acceptChannel2MaxHtlcValueInFlight :: {-# UNPACK #-} !MilliSatoshi
- , acceptChannel2HtlcMinimumMsat :: {-# UNPACK #-} !MilliSatoshi
- , acceptChannel2MinimumDepth :: {-# UNPACK #-} !Word32
- , acceptChannel2ToSelfDelay :: {-# UNPACK #-} !Word16
- , acceptChannel2MaxAcceptedHtlcs :: {-# UNPACK #-} !Word16
- , acceptChannel2FundingPubkey :: !Point
- , acceptChannel2RevocationBasepoint :: !Point
- , acceptChannel2PaymentBasepoint :: !Point
- , acceptChannel2DelayedPaymentBase :: !Point
- , acceptChannel2HtlcBasepoint :: !Point
- , acceptChannel2FirstPerCommitPoint :: !Point
- , acceptChannel2SecondPerCommitPoint :: !Point
- , acceptChannel2Tlvs :: !TlvStream
- } deriving stock (Eq, Show, Generic)
+ { accept_channel2_temporary_channel_id :: !ChannelId
+ , accept_channel2_funding_satoshis :: {-# UNPACK #-} !Satoshi
+ , accept_channel2_dust_limit_satoshis :: {-# UNPACK #-} !Satoshi
+ , accept_channel2_max_htlc_value_in_flight_msat :: {-# UNPACK #-} !Word64
+ -- ^ a cap, often @maxBound@, so not a bounded amount
+ , accept_channel2_htlc_minimum_msat
+ :: {-# UNPACK #-} !MilliSatoshi
+ , accept_channel2_minimum_depth :: {-# UNPACK #-} !Word32
+ , accept_channel2_to_self_delay :: {-# UNPACK #-} !Word16
+ , accept_channel2_max_accepted_htlcs :: {-# UNPACK #-} !Word16
+ , accept_channel2_funding_pubkey :: !Point
+ , accept_channel2_revocation_basepoint :: !Point
+ , accept_channel2_payment_basepoint :: !Point
+ , accept_channel2_delayed_payment_basepoint :: !Point
+ , accept_channel2_htlc_basepoint :: !Point
+ , accept_channel2_first_per_commitment_point :: !Point
+ , accept_channel2_second_per_commitment_point :: !Point
+ , accept_channel2_upfront_shutdown_script
+ :: !(Maybe ScriptPubKey)
+ -- ^ TLV type 0; an empty script commits to no particular script
+ , accept_channel2_channel_type
+ :: !(Maybe BOLT9.FeatureVector)
+ -- ^ TLV type 1
+ , accept_channel2_require_confirmed_inputs :: !Bool
+ -- ^ TLV type 2
+ , accept_channel2_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData AcceptChannel2
--- Interactive transaction construction ----------------------------------------
-
--- | The tx_add_input message (type 66).
---
--- Adds a transaction input to the collaborative transaction.
+-- | The @tx_add_input@ message (type 66).
data TxAddInput = TxAddInput
- { txAddInputChannelId :: !ChannelId
- , txAddInputSerialId :: !SerialId
- , txAddInputPrevTx :: !BS.ByteString
- , txAddInputPrevVout :: {-# UNPACK #-} !Word32
- , txAddInputSequence :: {-# UNPACK #-} !Word32
- } deriving stock (Eq, Show, Generic)
+ { tx_add_input_channel_id :: !ChannelId
+ , tx_add_input_serial_id :: !SerialId
+ , tx_add_input_prevtx :: !BS.ByteString
+ -- ^ the serialized previous transaction
+ , tx_add_input_prevtx_vout :: {-# UNPACK #-} !Word32
+ , tx_add_input_sequence :: {-# UNPACK #-} !Word32
+ , tx_add_input_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData TxAddInput
--- | The tx_add_output message (type 67).
---
--- Adds a transaction output to the collaborative transaction.
+-- | The @tx_add_output@ message (type 67).
data TxAddOutput = TxAddOutput
- { txAddOutputChannelId :: !ChannelId
- , txAddOutputSerialId :: !SerialId
- , txAddOutputSats :: {-# UNPACK #-} !Satoshi
- , txAddOutputScript :: !ScriptPubKey
- } deriving stock (Eq, Show, Generic)
+ { tx_add_output_channel_id :: !ChannelId
+ , tx_add_output_serial_id :: !SerialId
+ , tx_add_output_sats :: {-# UNPACK #-} !Satoshi
+ , tx_add_output_script :: !ScriptPubKey
+ , tx_add_output_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData TxAddOutput
--- | The tx_remove_input message (type 68).
---
--- Removes a previously added input from the collaborative transaction.
+-- | The @tx_remove_input@ message (type 68).
data TxRemoveInput = TxRemoveInput
- { txRemoveInputChannelId :: !ChannelId
- , txRemoveInputSerialId :: !SerialId
- } deriving stock (Eq, Show, Generic)
+ { tx_remove_input_channel_id :: !ChannelId
+ , tx_remove_input_serial_id :: !SerialId
+ , tx_remove_input_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData TxRemoveInput
--- | The tx_remove_output message (type 69).
---
--- Removes a previously added output from the collaborative transaction.
+-- | The @tx_remove_output@ message (type 69).
data TxRemoveOutput = TxRemoveOutput
- { txRemoveOutputChannelId :: !ChannelId
- , txRemoveOutputSerialId :: !SerialId
- } deriving stock (Eq, Show, Generic)
+ { tx_remove_output_channel_id :: !ChannelId
+ , tx_remove_output_serial_id :: !SerialId
+ , tx_remove_output_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData TxRemoveOutput
--- | The tx_complete message (type 70).
---
--- Signals the conclusion of a peer's transaction contributions.
+-- | The @tx_complete@ message (type 70).
data TxComplete = TxComplete
- { txCompleteChannelId :: !ChannelId
- } deriving stock (Eq, Show, Generic)
+ { tx_complete_channel_id :: !ChannelId
+ , tx_complete_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData TxComplete
--- | Witness data for tx_signatures.
-data Witness = Witness
- { witnessData :: !BS.ByteString
- } deriving stock (Eq, Show, Generic)
-
-instance NFData Witness
-
--- | The tx_signatures message (type 71).
---
--- Contains signatures for the collaborative transaction.
+-- | The @tx_signatures@ message (type 71).
data TxSignatures = TxSignatures
- { txSignaturesChannelId :: !ChannelId
- , txSignaturesTxid :: !TxId
- , txSignaturesWitnesses :: ![Witness]
- } deriving stock (Eq, Show, Generic)
+ { tx_signatures_channel_id :: !ChannelId
+ , tx_signatures_txid :: !TxId
+ , tx_signatures_witnesses :: ![Witness]
+ -- ^ ordered by the @serial_id@ of the inputs they spend
+ , tx_signatures_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData TxSignatures
--- | The tx_init_rbf message (type 72).
---
--- Initiates a replacement of the transaction after it's been completed.
+-- | The @tx_init_rbf@ message (type 72).
data TxInitRbf = TxInitRbf
- { txInitRbfChannelId :: !ChannelId
- , txInitRbfLocktime :: {-# UNPACK #-} !Word32
- , txInitRbfFeerate :: {-# UNPACK #-} !Word32
- , txInitRbfTlvs :: !TlvStream
- } deriving stock (Eq, Show, Generic)
+ { tx_init_rbf_channel_id :: !ChannelId
+ , tx_init_rbf_locktime :: {-# UNPACK #-} !Word32
+ , tx_init_rbf_feerate :: {-# UNPACK #-} !Word32
+ , tx_init_rbf_funding_output_contribution :: !(Maybe Int64)
+ -- ^ TLV type 0, in satoshis
+ , tx_init_rbf_require_confirmed_inputs :: !Bool
+ -- ^ TLV type 2
+ , tx_init_rbf_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData TxInitRbf
--- | The tx_ack_rbf message (type 73).
---
--- Acknowledges an RBF attempt.
+-- | The @tx_ack_rbf@ message (type 73).
data TxAckRbf = TxAckRbf
- { txAckRbfChannelId :: !ChannelId
- , txAckRbfTlvs :: !TlvStream
- } deriving stock (Eq, Show, Generic)
+ { tx_ack_rbf_channel_id :: !ChannelId
+ , tx_ack_rbf_funding_output_contribution :: !(Maybe Int64)
+ -- ^ TLV type 0, in satoshis
+ , tx_ack_rbf_require_confirmed_inputs :: !Bool
+ -- ^ TLV type 2
+ , tx_ack_rbf_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData TxAckRbf
--- | The tx_abort message (type 74).
---
--- Aborts the collaborative transaction negotiation.
+-- | The @tx_abort@ message (type 74).
data TxAbort = TxAbort
- { txAbortChannelId :: !ChannelId
- , txAbortData :: !BS.ByteString
- } deriving stock (Eq, Show, Generic)
+ { tx_abort_channel_id :: !ChannelId
+ , tx_abort_data :: !BS.ByteString
+ , tx_abort_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData TxAbort
--- Channel close ---------------------------------------------------------------
+-- channel quiescence ---------------------------------------------------------
--- | The stfu message (type 2).
---
--- Indicates "SomeThing Fundamental is Underway" - used for channel
--- quiescence.
+-- | The @stfu@ message (type 2).
data Stfu = Stfu
- { stfuChannelId :: !ChannelId
- , stfuInitiator :: !Initiator
- } deriving stock (Eq, Show, Generic)
+ { stfu_channel_id :: !ChannelId
+ , stfu_initiator :: !Bool
+ -- ^ whether the sender initiated quiescence (sent as 1 or 0)
+ , stfu_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData Stfu
--- | The shutdown message (type 38).
---
--- Initiates closing of the channel.
+-- channel close --------------------------------------------------------------
+
+-- | The @shutdown@ message (type 38).
data Shutdown = Shutdown
- { shutdownChannelId :: !ChannelId
- , shutdownScriptPubkey :: !ScriptPubKey
- } deriving stock (Eq, Show, Generic)
+ { shutdown_channel_id :: !ChannelId
+ , shutdown_scriptpubkey :: !ScriptPubKey
+ , shutdown_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData Shutdown
--- | The closing_signed message (type 39).
---
--- Used in legacy closing negotiation.
-data ClosingSigned = ClosingSigned
- { closingSignedChannelId :: !ChannelId
- , closingSignedFeeSatoshi :: {-# UNPACK #-} !Satoshi
- , closingSignedSignature :: !Signature
- , closingSignedTlvs :: !TlvStream
- } deriving stock (Eq, Show, Generic)
-
-instance NFData ClosingSigned
-
--- | The closing_complete message (type 40).
---
--- Proposes a closing transaction in the new closing protocol.
+-- | The @closing_complete@ message (type 40).
data ClosingComplete = ClosingComplete
- { closingCompleteChannelId :: !ChannelId
- , closingCompleteCloserScript :: !ScriptPubKey
- , closingCompleteCloseeScript :: !ScriptPubKey
- , closingCompleteFeeSatoshi :: {-# UNPACK #-} !Satoshi
- , closingCompleteLocktime :: {-# UNPACK #-} !Word32
- , closingCompleteTlvs :: !TlvStream
- } deriving stock (Eq, Show, Generic)
+ { closing_complete_channel_id :: !ChannelId
+ , closing_complete_closer_scriptpubkey :: !ScriptPubKey
+ , closing_complete_closee_scriptpubkey :: !ScriptPubKey
+ , closing_complete_fee_satoshis :: {-# UNPACK #-} !Satoshi
+ , closing_complete_locktime :: {-# UNPACK #-} !Word32
+ , closing_complete_closer_output_only :: !(Maybe Signature)
+ -- ^ TLV type 1
+ , closing_complete_closee_output_only :: !(Maybe Signature)
+ -- ^ TLV type 2
+ , closing_complete_closer_and_closee_outputs :: !(Maybe Signature)
+ -- ^ TLV type 3
+ , closing_complete_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData ClosingComplete
--- | The closing_sig message (type 41).
---
--- Signs a closing transaction in the new closing protocol.
+-- | The @closing_sig@ message (type 41). A valid @closing_sig@ carries
+-- exactly one signature, in a field set in the @closing_complete@ it
+-- answers; checking that is left to the caller.
data ClosingSig = ClosingSig
- { closingSigChannelId :: !ChannelId
- , closingSigCloserScript :: !ScriptPubKey
- , closingSigCloseeScript :: !ScriptPubKey
- , closingSigFeeSatoshi :: {-# UNPACK #-} !Satoshi
- , closingSigLocktime :: {-# UNPACK #-} !Word32
- , closingSigTlvs :: !TlvStream
- } deriving stock (Eq, Show, Generic)
+ { closing_sig_channel_id :: !ChannelId
+ , closing_sig_closer_scriptpubkey :: !ScriptPubKey
+ , closing_sig_closee_scriptpubkey :: !ScriptPubKey
+ , closing_sig_fee_satoshis :: {-# UNPACK #-} !Satoshi
+ , closing_sig_locktime :: {-# UNPACK #-} !Word32
+ , closing_sig_closer_output_only :: !(Maybe Signature)
+ -- ^ TLV type 1
+ , closing_sig_closee_output_only :: !(Maybe Signature)
+ -- ^ TLV type 2
+ , closing_sig_closer_and_closee_outputs :: !(Maybe Signature)
+ -- ^ TLV type 3
+ , closing_sig_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData ClosingSig
--- Normal operation ------------------------------------------------------------
+-- | The legacy @closing_signed@ message (type 39), used when
+-- @option_simple_close@ is not negotiated.
+data ClosingSigned = ClosingSigned
+ { closing_signed_channel_id :: !ChannelId
+ , closing_signed_fee_satoshis :: {-# UNPACK #-} !Satoshi
+ , closing_signed_signature :: !Signature
+ , closing_signed_fee_range :: !(Maybe FeeRange)
+ -- ^ TLV type 1
+ , closing_signed_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
--- | The update_add_htlc message (type 128).
---
--- Offers an HTLC to the other node, redeemable in return for a payment
--- preimage.
+instance NFData ClosingSigned
+
+-- normal operation -----------------------------------------------------------
+
+-- | The @update_add_htlc@ message (type 128).
data UpdateAddHtlc = UpdateAddHtlc
- { updateAddHtlcChannelId :: !ChannelId
- , updateAddHtlcId :: !HtlcId
- , updateAddHtlcAmountMsat :: {-# UNPACK #-} !MilliSatoshi
- , updateAddHtlcPaymentHash :: !PaymentHash
- , updateAddHtlcCltvExpiry :: {-# UNPACK #-} !Word32
- , updateAddHtlcOnionPacket :: !OnionPacket
- , updateAddHtlcTlvs :: !TlvStream
- } deriving stock (Eq, Show, Generic)
+ { update_add_htlc_channel_id :: !ChannelId
+ , update_add_htlc_id :: !HtlcId
+ , update_add_htlc_amount_msat :: {-# UNPACK #-} !MilliSatoshi
+ , update_add_htlc_payment_hash :: !PaymentHash
+ , update_add_htlc_cltv_expiry :: {-# UNPACK #-} !Word32
+ , update_add_htlc_onion_routing_packet :: !OnionRoutingPacket
+ , update_add_htlc_path_key :: !(Maybe Point)
+ -- ^ the @blinded_path@ record (TLV type 0)
+ , update_add_htlc_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData UpdateAddHtlc
--- | The update_fulfill_htlc message (type 130).
---
--- Supplies the preimage to fulfill an HTLC.
+-- | The @update_fulfill_htlc@ message (type 130).
data UpdateFulfillHtlc = UpdateFulfillHtlc
- { updateFulfillHtlcChannelId :: !ChannelId
- , updateFulfillHtlcId :: !HtlcId
- , updateFulfillHtlcPaymentPreimage :: !PaymentPreimage
- , updateFulfillHtlcTlvs :: !TlvStream
- } deriving stock (Eq, Show, Generic)
+ { update_fulfill_htlc_channel_id :: !ChannelId
+ , update_fulfill_htlc_id :: !HtlcId
+ , update_fulfill_htlc_payment_preimage :: !PaymentPreimage
+ , update_fulfill_htlc_attribution_data :: !(Maybe AttributionData)
+ -- ^ TLV type 1
+ , update_fulfill_htlc_fulfillment_payload :: !(Maybe BS.ByteString)
+ -- ^ TLV type 3
+ , update_fulfill_htlc_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData UpdateFulfillHtlc
--- | The update_fail_htlc message (type 131).
---
--- Indicates an HTLC has failed.
+-- | The @update_fail_htlc@ message (type 131).
data UpdateFailHtlc = UpdateFailHtlc
- { updateFailHtlcChannelId :: !ChannelId
- , updateFailHtlcId :: !HtlcId
- , updateFailHtlcReason :: !BS.ByteString
- , updateFailHtlcTlvs :: !TlvStream
- } deriving stock (Eq, Show, Generic)
+ { update_fail_htlc_channel_id :: !ChannelId
+ , update_fail_htlc_id :: !HtlcId
+ , update_fail_htlc_reason :: !BS.ByteString
+ , update_fail_htlc_attribution_data :: !(Maybe AttributionData)
+ -- ^ TLV type 1
+ , update_fail_htlc_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData UpdateFailHtlc
--- | The update_fail_malformed_htlc message (type 135).
---
--- Indicates an HTLC could not be parsed.
+-- | The @update_fail_malformed_htlc@ message (type 135).
data UpdateFailMalformedHtlc = UpdateFailMalformedHtlc
- { updateFailMalformedHtlcChannelId :: !ChannelId
- , updateFailMalformedHtlcId :: !HtlcId
- , updateFailMalformedHtlcSha256Onion :: !PaymentHash
- , updateFailMalformedHtlcFailureCode :: {-# UNPACK #-} !Word16
- } deriving stock (Eq, Show, Generic)
+ { update_fail_malformed_htlc_channel_id :: !ChannelId
+ , update_fail_malformed_htlc_id :: !HtlcId
+ , update_fail_malformed_htlc_sha256_of_onion :: !OnionHash
+ , update_fail_malformed_htlc_failure_code :: {-# UNPACK #-} !Word16
+ , update_fail_malformed_htlc_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData UpdateFailMalformedHtlc
--- | The commitment_signed message (type 132).
---
--- Applies pending changes and provides signatures for the commitment
--- transaction.
+-- | The @commitment_signed@ message (type 132).
data CommitmentSigned = CommitmentSigned
- { commitmentSignedChannelId :: !ChannelId
- , commitmentSignedSignature :: !Signature
- , commitmentSignedHtlcSignatures :: ![Signature]
- } deriving stock (Eq, Show, Generic)
+ { commitment_signed_channel_id :: !ChannelId
+ , commitment_signed_signature :: !Signature
+ , commitment_signed_htlc_signatures :: ![Signature]
+ , commitment_signed_funding_txid :: !(Maybe TxId)
+ -- ^ TLV type 1
+ , commitment_signed_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData CommitmentSigned
--- | The revoke_and_ack message (type 133).
---
--- Revokes the previous commitment transaction and acknowledges receipt
--- of the commitment_signed.
+-- | The @revoke_and_ack@ message (type 133).
data RevokeAndAck = RevokeAndAck
- { revokeAndAckChannelId :: !ChannelId
- , revokeAndAckPerCommitmentSecret :: !PerCommitmentSecret
- , revokeAndAckNextPerCommitPoint :: !Point
- } deriving stock (Eq, Show, Generic)
+ { revoke_and_ack_channel_id :: !ChannelId
+ , revoke_and_ack_per_commitment_secret :: !PerCommitmentSecret
+ , revoke_and_ack_next_per_commitment_point :: !Point
+ , revoke_and_ack_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData RevokeAndAck
--- | The update_fee message (type 134).
---
--- Updates the fee rate for commitment transactions.
+-- | The @update_fee@ message (type 134).
data UpdateFee = UpdateFee
- { updateFeeChannelId :: !ChannelId
- , updateFeeFeeratePerKw :: {-# UNPACK #-} !Word32
- } deriving stock (Eq, Show, Generic)
+ { update_fee_channel_id :: !ChannelId
+ , update_fee_feerate_per_kw :: {-# UNPACK #-} !Word32
+ , update_fee_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData UpdateFee
--- Reestablishment -------------------------------------------------------------
+-- message retransmission -----------------------------------------------------
--- | The channel_reestablish message (type 136).
---
--- Used to re-establish a channel after reconnection.
+-- | The @channel_reestablish@ message (type 136).
data ChannelReestablish = ChannelReestablish
- { channelReestablishChannelId :: !ChannelId
- , channelReestablishNextCommitNum :: {-# UNPACK #-} !Word64
- , channelReestablishNextRevocationNum :: {-# UNPACK #-} !Word64
- , channelReestablishYourLastCommitSecret :: !PerCommitmentSecret
- , channelReestablishMyCurrentCommitPoint :: !Point
- , channelReestablishTlvs :: !TlvStream
- } deriving stock (Eq, Show, Generic)
+ { channel_reestablish_channel_id :: !ChannelId
+ , channel_reestablish_next_commitment_number
+ :: {-# UNPACK #-} !Word64
+ , channel_reestablish_next_revocation_number
+ :: {-# UNPACK #-} !Word64
+ , channel_reestablish_your_last_per_commitment_secret
+ :: !PerCommitmentSecret
+ , channel_reestablish_my_current_per_commitment_point :: !Point
+ , channel_reestablish_next_funding
+ :: !(Maybe NextFunding)
+ -- ^ TLV type 1
+ , channel_reestablish_tlvs :: !TlvStream
+ -- ^ unknown TLV records
+ } deriving (Eq, Show, Generic)
instance NFData ChannelReestablish
--- Top-level message type ------------------------------------------------------
+-- messages -------------------------------------------------------------------
--- | All BOLT #2 messages.
+-- | A BOLT #2 message.
data Message
- -- Channel establishment v1
- = MsgOpenChannelVal !OpenChannel
- | MsgAcceptChannelVal !AcceptChannel
- | MsgFundingCreatedVal !FundingCreated
- | MsgFundingSignedVal !FundingSigned
- | MsgChannelReadyVal !ChannelReady
- -- Channel establishment v2
- | MsgOpenChannel2Val !OpenChannel2
- | MsgAcceptChannel2Val !AcceptChannel2
- | MsgTxAddInputVal !TxAddInput
- | MsgTxAddOutputVal !TxAddOutput
- | MsgTxRemoveInputVal !TxRemoveInput
- | MsgTxRemoveOutputVal !TxRemoveOutput
- | MsgTxCompleteVal !TxComplete
- | MsgTxSignaturesVal !TxSignatures
- | MsgTxInitRbfVal !TxInitRbf
- | MsgTxAckRbfVal !TxAckRbf
- | MsgTxAbortVal !TxAbort
- -- Channel close
- | MsgStfuVal !Stfu
- | MsgShutdownVal !Shutdown
- | MsgClosingSignedVal !ClosingSigned
- | MsgClosingCompleteVal !ClosingComplete
- | MsgClosingSigVal !ClosingSig
- -- Normal operation
- | MsgUpdateAddHtlcVal !UpdateAddHtlc
- | MsgUpdateFulfillHtlcVal !UpdateFulfillHtlc
- | MsgUpdateFailHtlcVal !UpdateFailHtlc
- | MsgUpdateFailMalformedHtlcVal !UpdateFailMalformedHtlc
- | MsgCommitmentSignedVal !CommitmentSigned
- | MsgRevokeAndAckVal !RevokeAndAck
- | MsgUpdateFeeVal !UpdateFee
- -- Reestablishment
- | MsgChannelReestablishVal !ChannelReestablish
- deriving stock (Eq, Show, Generic)
+ = MsgOpenChannel !OpenChannel
+ | MsgAcceptChannel !AcceptChannel
+ | MsgFundingCreated !FundingCreated
+ | MsgFundingSigned !FundingSigned
+ | MsgChannelReady !ChannelReady
+ | MsgOpenChannel2 !OpenChannel2
+ | MsgAcceptChannel2 !AcceptChannel2
+ | MsgTxAddInput !TxAddInput
+ | MsgTxAddOutput !TxAddOutput
+ | MsgTxRemoveInput !TxRemoveInput
+ | MsgTxRemoveOutput !TxRemoveOutput
+ | MsgTxComplete !TxComplete
+ | MsgTxSignatures !TxSignatures
+ | MsgTxInitRbf !TxInitRbf
+ | MsgTxAckRbf !TxAckRbf
+ | MsgTxAbort !TxAbort
+ | MsgStfu !Stfu
+ | MsgShutdown !Shutdown
+ | MsgClosingComplete !ClosingComplete
+ | MsgClosingSig !ClosingSig
+ | MsgClosingSigned !ClosingSigned
+ | MsgUpdateAddHtlc !UpdateAddHtlc
+ | MsgUpdateFulfillHtlc !UpdateFulfillHtlc
+ | MsgUpdateFailHtlc !UpdateFailHtlc
+ | MsgUpdateFailMalformedHtlc !UpdateFailMalformedHtlc
+ | MsgCommitmentSigned !CommitmentSigned
+ | MsgRevokeAndAck !RevokeAndAck
+ | MsgUpdateFee !UpdateFee
+ | MsgChannelReestablish !ChannelReestablish
+ deriving (Eq, Show, Generic)
instance NFData Message
+
+-- | The wire type of a 'Message'.
+--
+-- >>> message_type (MsgTxComplete (TxComplete cid BOLT1.empty_tlv_stream))
+-- 70
+message_type :: Message -> Word16
+message_type m = case m of
+ MsgOpenChannel {} -> 32
+ MsgAcceptChannel {} -> 33
+ MsgFundingCreated {} -> 34
+ MsgFundingSigned {} -> 35
+ MsgChannelReady {} -> 36
+ MsgOpenChannel2 {} -> 64
+ MsgAcceptChannel2 {} -> 65
+ MsgTxAddInput {} -> 66
+ MsgTxAddOutput {} -> 67
+ MsgTxRemoveInput {} -> 68
+ MsgTxRemoveOutput {} -> 69
+ MsgTxComplete {} -> 70
+ MsgTxSignatures {} -> 71
+ MsgTxInitRbf {} -> 72
+ MsgTxAckRbf {} -> 73
+ MsgTxAbort {} -> 74
+ MsgStfu {} -> 2
+ MsgShutdown {} -> 38
+ MsgClosingComplete {} -> 40
+ MsgClosingSig {} -> 41
+ MsgClosingSigned {} -> 39
+ MsgUpdateAddHtlc {} -> 128
+ MsgUpdateFulfillHtlc {} -> 130
+ MsgUpdateFailHtlc {} -> 131
+ MsgUpdateFailMalformedHtlc {} -> 135
+ MsgCommitmentSigned {} -> 132
+ MsgRevokeAndAck {} -> 133
+ MsgUpdateFee {} -> 134
+ MsgChannelReestablish {} -> 136
diff --git a/lib/Lightning/Protocol/BOLT2/Types.hs b/lib/Lightning/Protocol/BOLT2/Types.hs
@@ -1,8 +1,5 @@
-{-# OPTIONS_HADDOCK prune #-}
-{-# LANGUAGE BangPatterns #-}
+{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- |
-- Module: Lightning.Protocol.BOLT2.Types
@@ -10,246 +7,189 @@
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
--- Core types for BOLT #2 peer protocol.
---
--- This module provides newtypes for identifiers, amounts, hashes, and
--- keys used in the Lightning Network peer protocol.
+-- Field types specific to BOLT #2.
module Lightning.Protocol.BOLT2.Types (
- -- * Identifiers (re-exported from BOLT1)
- ChannelId(..)
- , channelId
- , unChannelId
-
- -- * Amounts (re-exported from BOLT1)
- , Satoshi(..)
- , MilliSatoshi(..)
- , satToMsat
- , msatToSat
-
- -- * Cryptographic types (re-exported from BOLT1)
- , Signature(..)
- , signature
- , unSignature
- , Point(..)
- , point
- , unPoint
- , PaymentHash(..)
- , paymentHash
- , unPaymentHash
- , PaymentPreimage(..)
- , paymentPreimage
- , unPaymentPreimage
- , PerCommitmentSecret(..)
- , perCommitmentSecret
- , unPerCommitmentSecret
-
- -- * Chain types (re-exported from BOLT1)
- , ChainHash(..)
- , chainHash
- , unChainHash
- , ShortChannelId(..)
- , shortChannelId
- , scidBlockHeight
- , scidTxIndex
- , scidOutputIndex
-
- -- * Transaction types
- , TxId(..)
- , mkTxId
- , OutPoint(..)
+ HtlcId(..)
+ , SerialId(..)
, ScriptPubKey
- , scriptPubKey
- , unScriptPubKey
-
- -- * Protocol identifiers
- , HtlcId
- , htlcId
- , unHtlcId
- , SerialId
- , serialId
- , unSerialId
-
- -- * Quiescence
- , Initiator(..)
-
- -- * Protocol types
- , FeatureBits
- , featureBits
- , unFeatureBits
- , OnionPacket
- , onionPacket
- , unOnionPacket
-
- -- * Constants
- , channelIdLen
- , signatureLen
- , pointLen
- , chainHashLen
- , shortChannelIdLen
- , paymentHashLen
- , paymentPreimageLen
- , onionPacketLen
- , perCommitmentSecretLen
+ , script_pubkey
+ , un_script_pubkey
+ , Witness
+ , witness
+ , un_witness
+ , OnionRoutingPacket
+ , onion_routing_packet
+ , un_onion_routing_packet
+ , OnionHash
+ , onion_hash
+ , un_onion_hash
+ , AttributionData
+ , attribution_data
+ , un_attribution_data
+ , FeeRange(..)
+ , NextFunding(..)
) where
-import Bitcoin.Prim.Tx (TxId(..), mkTxId, OutPoint(..))
+import Bitcoin.Prim.Tx (TxId)
import Control.DeepSeq (NFData)
import qualified Data.ByteString as BS
-import Data.Word (Word64)
+import Data.Word (Word8, Word64)
import GHC.Generics (Generic)
-import Lightning.Protocol.BOLT1.Prim
- ( ChannelId(..), channelId, unChannelId
- , Satoshi(..), MilliSatoshi(..), satToMsat, msatToSat
- , Signature(..), signature, unSignature
- , Point(..), point, unPoint
- , PaymentHash(..), paymentHash, unPaymentHash
- , PaymentPreimage(..), paymentPreimage, unPaymentPreimage
- , PerCommitmentSecret(..), perCommitmentSecret
- , unPerCommitmentSecret
- , ChainHash(..), chainHash, unChainHash
- , ShortChannelId(..), shortChannelId
- , scidBlockHeight, scidTxIndex, scidOutputIndex
- )
-
--- constants -------------------------------------------------------------------
-
--- | Length of a channel_id in bytes (32).
-channelIdLen :: Int
-channelIdLen = 32
-{-# INLINE channelIdLen #-}
-
--- | Length of a signature in bytes (64, compact format).
-signatureLen :: Int
-signatureLen = 64
-{-# INLINE signatureLen #-}
-
--- | Length of a compressed secp256k1 public key in bytes (33).
-pointLen :: Int
-pointLen = 33
-{-# INLINE pointLen #-}
-
--- | Length of a chain hash in bytes (32).
-chainHashLen :: Int
-chainHashLen = 32
-{-# INLINE chainHashLen #-}
-
--- | Length of a short_channel_id in bytes (8).
-shortChannelIdLen :: Int
-shortChannelIdLen = 8
-{-# INLINE shortChannelIdLen #-}
-
--- | Length of a payment hash in bytes (32).
-paymentHashLen :: Int
-paymentHashLen = 32
-{-# INLINE paymentHashLen #-}
-
--- | Length of a payment preimage in bytes (32).
-paymentPreimageLen :: Int
-paymentPreimageLen = 32
-{-# INLINE paymentPreimageLen #-}
-
--- | Length of an onion routing packet in bytes (1366).
-onionPacketLen :: Int
-onionPacketLen = 1366
-{-# INLINE onionPacketLen #-}
-
--- | Length of a per-commitment secret in bytes (32).
-perCommitmentSecretLen :: Int
-perCommitmentSecretLen = 32
-{-# INLINE perCommitmentSecretLen #-}
-
--- transaction types -----------------------------------------------------------
-
--- | A script pubkey (output script).
-newtype ScriptPubKey = ScriptPubKey BS.ByteString
- deriving stock (Eq, Ord, Show, Generic)
- deriving newtype NFData
-
--- | Construct a 'ScriptPubKey' from a 'BS.ByteString'.
-scriptPubKey :: BS.ByteString -> ScriptPubKey
-scriptPubKey = ScriptPubKey
-{-# INLINE scriptPubKey #-}
-
--- | Extract the underlying 'BS.ByteString' from a 'ScriptPubKey'.
-unScriptPubKey :: ScriptPubKey -> BS.ByteString
-unScriptPubKey (ScriptPubKey bs) = bs
-{-# INLINE unScriptPubKey #-}
-
--- protocol identifiers -------------------------------------------------------
+import Lightning.Protocol.BOLT1 (Satoshi)
--- | An HTLC identifier, unique per channel per direction.
+-- | An HTLC identifier (the @id@ field of the HTLC messages). The
+-- offerer numbers its HTLCs from 0, incrementing by 1.
newtype HtlcId = HtlcId Word64
- deriving stock (Eq, Ord, Show, Generic)
- deriving newtype NFData
+ deriving (Eq, Ord, Show, Generic)
--- | Construct an 'HtlcId' from a 'Word64'.
-htlcId :: Word64 -> HtlcId
-htlcId = HtlcId
-{-# INLINE htlcId #-}
+instance NFData HtlcId
--- | Extract the underlying 'Word64' from an 'HtlcId'.
-unHtlcId :: HtlcId -> Word64
-unHtlcId (HtlcId w) = w
-{-# INLINE unHtlcId #-}
-
--- | A serial identifier for interactive transaction construction.
+-- | The @serial_id@ of an input or output in interactive transaction
+-- construction. The initiator sends even values, the non-initiator
+-- odd ones.
newtype SerialId = SerialId Word64
- deriving stock (Eq, Ord, Show, Generic)
- deriving newtype NFData
-
--- | Construct a 'SerialId' from a 'Word64'.
-serialId :: Word64 -> SerialId
-serialId = SerialId
-{-# INLINE serialId #-}
-
--- | Extract the underlying 'Word64' from a 'SerialId'.
-unSerialId :: SerialId -> Word64
-unSerialId (SerialId w) = w
-{-# INLINE unSerialId #-}
-
--- quiescence -----------------------------------------------------------------
+ deriving (Eq, Ord, Show, Generic)
--- | Role in quiescence (STFU) protocol.
-data Initiator
- = IsInitiator -- ^ This node initiated quiescence.
- | NotInitiator -- ^ This node did not initiate quiescence.
- deriving stock (Eq, Ord, Show, Generic)
+instance NFData SerialId
-instance NFData Initiator
-
--- protocol types --------------------------------------------------------------
-
--- | Feature bits (variable length).
-newtype FeatureBits = FeatureBits BS.ByteString
- deriving stock (Eq, Ord, Show, Generic)
- deriving newtype NFData
-
--- | Construct 'FeatureBits' from a 'BS.ByteString'.
-featureBits :: BS.ByteString -> FeatureBits
-featureBits = FeatureBits
-{-# INLINE featureBits #-}
-
--- | Extract the underlying 'BS.ByteString' from 'FeatureBits'.
-unFeatureBits :: FeatureBits -> BS.ByteString
-unFeatureBits (FeatureBits bs) = bs
-{-# INLINE unFeatureBits #-}
+-- | A scriptPubKey, at most 65535 bytes (the most a u16 length prefix
+-- can describe).
+newtype ScriptPubKey = ScriptPubKey BS.ByteString
+ deriving (Eq, Ord, Show, Generic)
--- | A 1366-byte onion routing packet.
-newtype OnionPacket = OnionPacket BS.ByteString
- deriving stock (Eq, Ord, Show, Generic)
- deriving newtype NFData
+instance NFData ScriptPubKey
--- | Construct an 'OnionPacket' from a 1366-byte 'BS.ByteString'.
+-- | Construct a t'ScriptPubKey', failing above 65535 bytes. The script
+-- itself isn't checked; the forms acceptable in @shutdown@ depend on
+-- negotiated features.
+--
+-- >>> script_pubkey "\x51\x02\x4e\x73"
+-- Just (ScriptPubKey "Q\STXNs")
+-- >>> script_pubkey (BS.replicate 65536 0x00)
+-- Nothing
+script_pubkey :: BS.ByteString -> Maybe ScriptPubKey
+script_pubkey bs
+ | BS.length bs <= 65535 = Just (ScriptPubKey bs)
+ | otherwise = Nothing
+{-# INLINE script_pubkey #-}
+
+-- | The bytes of a t'ScriptPubKey'.
+un_script_pubkey :: ScriptPubKey -> BS.ByteString
+un_script_pubkey (ScriptPubKey bs) = bs
+{-# INLINE un_script_pubkey #-}
+
+-- | The serialized witness of one input in @tx_signatures@ (encoded as
+-- in Bitcoin's wire protocol), at most 65535 bytes.
+newtype Witness = Witness BS.ByteString
+ deriving (Eq, Ord, Show, Generic)
+
+instance NFData Witness
+
+-- | Construct a t'Witness', failing above 65535 bytes. The contents
+-- aren't checked.
+--
+-- >>> witness "\x01\x01\x2a"
+-- Just (Witness "\SOH\SOH*")
+witness :: BS.ByteString -> Maybe Witness
+witness bs
+ | BS.length bs <= 65535 = Just (Witness bs)
+ | otherwise = Nothing
+{-# INLINE witness #-}
+
+-- | The bytes of a t'Witness'.
+un_witness :: Witness -> BS.ByteString
+un_witness (Witness bs) = bs
+{-# INLINE un_witness #-}
+
+-- | The 1366-byte @onion_routing_packet@ of @update_add_htlc@, kept
+-- opaque (BOLT #4 defines its structure).
+newtype OnionRoutingPacket = OnionRoutingPacket BS.ByteString
+ deriving (Eq, Ord, Show, Generic)
+
+instance NFData OnionRoutingPacket
+
+-- | Construct an t'OnionRoutingPacket' from exactly 1366 bytes.
+--
+-- >>> let bs = BS.replicate 1366 0x00
+-- >>> fmap un_onion_routing_packet (onion_routing_packet bs) == Just bs
+-- True
+-- >>> onion_routing_packet (BS.take 1365 bs)
+-- Nothing
+onion_routing_packet :: BS.ByteString -> Maybe OnionRoutingPacket
+onion_routing_packet bs
+ | BS.length bs == 1366 = Just (OnionRoutingPacket bs)
+ | otherwise = Nothing
+{-# INLINE onion_routing_packet #-}
+
+-- | The bytes of an t'OnionRoutingPacket'.
+un_onion_routing_packet :: OnionRoutingPacket -> BS.ByteString
+un_onion_routing_packet (OnionRoutingPacket bs) = bs
+{-# INLINE un_onion_routing_packet #-}
+
+-- | The SHA256 hash of an onion routing packet (the @sha256_of_onion@
+-- field of @update_fail_malformed_htlc@).
+newtype OnionHash = OnionHash BS.ByteString
+ deriving (Eq, Ord, Show, Generic)
+
+instance NFData OnionHash
+
+-- | Construct an t'OnionHash' from exactly 32 bytes.
+--
+-- >>> onion_hash (BS.replicate 31 0x00)
+-- Nothing
+onion_hash :: BS.ByteString -> Maybe OnionHash
+onion_hash bs
+ | BS.length bs == 32 = Just (OnionHash bs)
+ | otherwise = Nothing
+{-# INLINE onion_hash #-}
+
+-- | The bytes of an t'OnionHash'.
+un_onion_hash :: OnionHash -> BS.ByteString
+un_onion_hash (OnionHash bs) = bs
+{-# INLINE un_onion_hash #-}
+
+-- | The 920-byte @attribution_data@ of @update_fulfill_htlc@ and
+-- @update_fail_htlc@: twenty u32 HTLC hold times followed by 210
+-- four-byte truncated HMACs. Kept opaque (BOLT #4 defines its use).
+newtype AttributionData = AttributionData BS.ByteString
+ deriving (Eq, Ord, Show, Generic)
+
+instance NFData AttributionData
+
+-- | Construct an t'AttributionData' from exactly 920 bytes.
--
--- Returns 'Nothing' if the input is not exactly 1366 bytes.
-onionPacket :: BS.ByteString -> Maybe OnionPacket
-onionPacket !bs
- | BS.length bs == onionPacketLen = Just $! OnionPacket bs
- | otherwise = Nothing
-{-# INLINABLE onionPacket #-}
-
--- | Extract the underlying 'BS.ByteString' from an 'OnionPacket'.
-unOnionPacket :: OnionPacket -> BS.ByteString
-unOnionPacket (OnionPacket bs) = bs
-{-# INLINE unOnionPacket #-}
+-- >>> let bs = BS.replicate 920 0x00
+-- >>> fmap un_attribution_data (attribution_data bs) == Just bs
+-- True
+-- >>> attribution_data (BS.drop 1 bs)
+-- Nothing
+attribution_data :: BS.ByteString -> Maybe AttributionData
+attribution_data bs
+ | BS.length bs == 920 = Just (AttributionData bs)
+ | otherwise = Nothing
+{-# INLINE attribution_data #-}
+
+-- | The bytes of an t'AttributionData'.
+un_attribution_data :: AttributionData -> BS.ByteString
+un_attribution_data (AttributionData bs) = bs
+{-# INLINE un_attribution_data #-}
+
+-- | The @fee_range@ of @closing_signed@: the fees the sender is
+-- prepared to pay for the closing transaction.
+data FeeRange = FeeRange
+ { fee_range_min_fee_satoshis :: {-# UNPACK #-} !Satoshi
+ , fee_range_max_fee_satoshis :: {-# UNPACK #-} !Satoshi
+ } deriving (Eq, Show, Generic)
+
+instance NFData FeeRange
+
+-- | The @next_funding@ record of @channel_reestablish@: an interactive
+-- funding transaction whose signatures are still being exchanged.
+data NextFunding = NextFunding
+ { next_funding_txid :: !TxId
+ , next_funding_retransmit_flags :: {-# UNPACK #-} !Word8
+ -- ^ bit 0: the sender wants @commitment_signed@ retransmitted
+ } deriving (Eq, Show, Generic)
+
+instance NFData NextFunding
diff --git a/ppad-bolt2.cabal b/ppad-bolt2.cabal
@@ -1,6 +1,6 @@
cabal-version: 3.0
name: ppad-bolt2
-version: 0.0.1
+version: 0.1.0
synopsis: Peer protocol per BOLT #2
license: MIT
license-file: LICENSE
@@ -8,7 +8,7 @@ author: Jared Tobin
maintainer: jared@ppad.tech
category: Cryptography
build-type: Simple
-tested-with: GHC == 9.10.3
+tested-with: GHC == { 9.10.3 }
extra-doc-files: CHANGELOG
description:
Peer protocol, per
@@ -25,6 +25,7 @@ library
-Wall
exposed-modules:
Lightning.Protocol.BOLT2
+ other-modules:
Lightning.Protocol.BOLT2.Codec
Lightning.Protocol.BOLT2.Messages
Lightning.Protocol.BOLT2.Types
@@ -32,8 +33,9 @@ library
base >= 4.9 && < 5
, bytestring >= 0.9 && < 0.13
, deepseq >= 1.4 && < 1.6
- , ppad-bolt1 >= 0.0.1 && < 0.1
- , ppad-tx >= 0.1 && < 0.2
+ , ppad-bolt1 >= 0.1 && < 0.2
+ , ppad-bolt9 >= 0.1 && < 0.2
+ , ppad-tx >= 0.2 && < 0.3
test-suite bolt2-tests
type: exitcode-stdio-1.0
@@ -42,7 +44,7 @@ test-suite bolt2-tests
main-is: Main.hs
ghc-options:
- -rtsopts -Wall -O2
+ -rtsopts -Wall
build-depends:
base
@@ -50,6 +52,8 @@ test-suite bolt2-tests
, ppad-base16
, ppad-bolt1
, ppad-bolt2
+ , ppad-bolt9
+ , ppad-tx
, tasty
, tasty-hunit
, tasty-quickcheck
@@ -59,31 +63,35 @@ benchmark bolt2-bench
default-language: Haskell2010
hs-source-dirs: bench
main-is: Main.hs
+ other-modules: Fixtures
ghc-options:
- -rtsopts -O2 -Wall -fno-warn-orphans
+ -rtsopts -O2 -Wall
build-depends:
base
, bytestring
, criterion
- , deepseq
, ppad-bolt1
, ppad-bolt2
+ , ppad-bolt9
+ , ppad-tx
benchmark bolt2-weigh
type: exitcode-stdio-1.0
default-language: Haskell2010
hs-source-dirs: bench
main-is: Weight.hs
+ other-modules: Fixtures
ghc-options:
- -rtsopts -O2 -Wall -fno-warn-orphans
+ -rtsopts -O2 -Wall
build-depends:
base
, bytestring
- , deepseq
, ppad-bolt1
, ppad-bolt2
+ , ppad-bolt9
+ , ppad-tx
, weigh
diff --git a/test/Main.hs b/test/Main.hs
@@ -2,1330 +2,1307 @@
module Main where
+import qualified Bitcoin.Prim.Tx as Tx
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
-import Data.Maybe (fromJust)
-import Data.Word (Word8, Word16, Word32, Word64)
-import Lightning.Protocol.BOLT1 (TlvStream, unsafeTlvStream)
+import qualified Data.ByteString.Char8 as B8
+import Data.Int (Int64)
+import Data.Word (Word8, Word64)
+import qualified Lightning.Protocol.BOLT1 as BOLT1
+import Lightning.Protocol.BOLT1 (TlvRecord(..), TlvError(..))
import Lightning.Protocol.BOLT2
+import qualified Lightning.Protocol.BOLT9 as BOLT9
import Test.Tasty
import Test.Tasty.HUnit
-import Test.Tasty.QuickCheck
+import Test.Tasty.QuickCheck hiding (witness)
main :: IO ()
main = defaultMain $ testGroup "ppad-bolt2" [
- v1_establishment_tests
- , v2_establishment_tests
- , close_tests
- , normal_operation_tests
- , reestablish_tests
- , error_tests
- , property_tests
+ known_answers
+ , tlv_handling
+ , decoding_failures
+ , encoding_failures
+ , field_types
+ , properties
]
--- Test data helpers -----------------------------------------------------------
-
--- | Create a valid ChannelId (32 bytes).
-testChannelId :: ChannelId
-testChannelId = fromJust $ channelId (BS.replicate 32 0xab)
-
--- | Create a valid ChainHash (32 bytes).
-testChainHash :: ChainHash
-testChainHash = fromJust $ chainHash (BS.replicate 32 0x01)
-
--- | Create a valid Point (33 bytes).
-testPoint :: Point
-testPoint = fromJust $ point (BS.pack $ 0x02 : replicate 32 0xff)
-
--- | Create a second valid Point (33 bytes).
-testPoint2 :: Point
-testPoint2 = fromJust $ point (BS.pack $ 0x03 : replicate 32 0xee)
-
--- | Create a valid Signature (64 bytes).
-testSignature :: Signature
-testSignature = fromJust $ signature (BS.replicate 64 0xcc)
-
--- | Create a valid TxId (32 bytes).
-testTxId :: TxId
-testTxId = fromJust $ mkTxId (BS.replicate 32 0xdd)
-
--- | Create a valid PaymentHash (32 bytes).
-testPaymentHash :: PaymentHash
-testPaymentHash = fromJust $ paymentHash (BS.replicate 32 0xaa)
-
--- | Create a valid PaymentPreimage (32 bytes).
-testPaymentPreimage :: PaymentPreimage
-testPaymentPreimage = fromJust $ paymentPreimage (BS.replicate 32 0xbb)
-
--- | Create a valid OnionPacket (1366 bytes).
-testOnionPacket :: OnionPacket
-testOnionPacket = fromJust $ onionPacket (BS.replicate 1366 0x00)
-
--- | Create a valid PerCommitmentSecret (32 bytes).
-testSecret :: PerCommitmentSecret
-testSecret = fromJust $
- perCommitmentSecret (BS.replicate 32 0x11)
-
--- | Empty TLV stream for messages.
-emptyTlvs :: TlvStream
-emptyTlvs = unsafeTlvStream []
-
--- V1 Channel Establishment Tests ----------------------------------------------
-
-v1_establishment_tests :: TestTree
-v1_establishment_tests = testGroup "V1 Channel Establishment" [
- testGroup "OpenChannel" [
- testCase "encode/decode roundtrip" $ do
- let msg = OpenChannel
- { openChannelChainHash = testChainHash
- , openChannelTempChannelId = testChannelId
- , openChannelFundingSatoshi = Satoshi 1000000
- , openChannelPushMsat = MilliSatoshi 500000
- , openChannelDustLimitSatoshi = Satoshi 546
- , openChannelMaxHtlcValueInFlight = MilliSatoshi 100000000
- , openChannelChannelReserveSat = Satoshi 10000
- , openChannelHtlcMinimumMsat = MilliSatoshi 1000
- , openChannelFeeratePerKw = 2500
- , openChannelToSelfDelay = 144
- , openChannelMaxAcceptedHtlcs = 483
- , openChannelFundingPubkey = testPoint
- , openChannelRevocationBasepoint = testPoint
- , openChannelPaymentBasepoint = testPoint
- , openChannelDelayedPaymentBase = testPoint
- , openChannelHtlcBasepoint = testPoint
- , openChannelFirstPerCommitPoint = testPoint
- , openChannelChannelFlags = 0x01
- , openChannelTlvs = emptyTlvs
- }
- encoded = encodeOpenChannel msg
- case decodeOpenChannel encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "AcceptChannel" [
- testCase "encode/decode roundtrip" $ do
- let msg = AcceptChannel
- { acceptChannelTempChannelId = testChannelId
- , acceptChannelDustLimitSatoshi = Satoshi 546
- , acceptChannelMaxHtlcValueInFlight = MilliSatoshi 100000000
- , acceptChannelChannelReserveSat = Satoshi 10000
- , acceptChannelHtlcMinimumMsat = MilliSatoshi 1000
- , acceptChannelMinimumDepth = 3
- , acceptChannelToSelfDelay = 144
- , acceptChannelMaxAcceptedHtlcs = 483
- , acceptChannelFundingPubkey = testPoint
- , acceptChannelRevocationBasepoint = testPoint
- , acceptChannelPaymentBasepoint = testPoint
- , acceptChannelDelayedPaymentBase = testPoint
- , acceptChannelHtlcBasepoint = testPoint
- , acceptChannelFirstPerCommitPoint = testPoint
- , acceptChannelTlvs = emptyTlvs
- }
- encoded = encodeAcceptChannel msg
- case decodeAcceptChannel encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "FundingCreated" [
- testCase "encode/decode roundtrip" $ do
- let msg = FundingCreated
- { fundingCreatedTempChannelId = testChannelId
- , fundingCreatedFundingTxid = testTxId
- , fundingCreatedFundingOutIdx = 0
- , fundingCreatedSignature = testSignature
- }
- encoded = encodeFundingCreated msg
- case decodeFundingCreated encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- , testCase "roundtrip with non-zero output index" $ do
- let msg = FundingCreated
- { fundingCreatedTempChannelId = testChannelId
- , fundingCreatedFundingTxid = testTxId
- , fundingCreatedFundingOutIdx = 42
- , fundingCreatedSignature = testSignature
- }
- encoded = encodeFundingCreated msg
- case decodeFundingCreated encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "FundingSigned" [
- testCase "encode/decode roundtrip" $ do
- let msg = FundingSigned
- { fundingSignedChannelId = testChannelId
- , fundingSignedSignature = testSignature
- }
- encoded = encodeFundingSigned msg
- case decodeFundingSigned encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "ChannelReady" [
- testCase "encode/decode roundtrip" $ do
- let msg = ChannelReady
- { channelReadyChannelId = testChannelId
- , channelReadySecondPerCommitPoint = testPoint
- , channelReadyTlvs = emptyTlvs
- }
- encoded = encodeChannelReady msg
- case decodeChannelReady encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
+-- helpers --------------------------------------------------------------------
+
+rep :: Int -> String -> String
+rep n = concat . replicate n
+
+hx :: String -> Maybe BS.ByteString
+hx = B16.decode . B8.pack
+
+-- decode a hex literal, failing the test if it isn't valid hex
+unhex :: String -> IO BS.ByteString
+unhex s = maybe (assertFailure ("invalid hex literal: " ++ s)) pure (hx s)
+
+-- unwrap a fixture, failing the test if it couldn't be constructed
+just :: String -> Maybe a -> IO a
+just what = maybe (assertFailure ("invalid fixture: " ++ what)) pure
+
+empty :: BOLT1.TlvStream
+empty = BOLT1.empty_tlv_stream
+
+-- the unknown TLV records of a message
+message_tlvs :: Message -> BOLT1.TlvStream
+message_tlvs m = case m of
+ MsgOpenChannel a -> open_channel_tlvs a
+ MsgAcceptChannel a -> accept_channel_tlvs a
+ MsgFundingCreated a -> funding_created_tlvs a
+ MsgFundingSigned a -> funding_signed_tlvs a
+ MsgChannelReady a -> channel_ready_tlvs a
+ MsgOpenChannel2 a -> open_channel2_tlvs a
+ MsgAcceptChannel2 a -> accept_channel2_tlvs a
+ MsgTxAddInput a -> tx_add_input_tlvs a
+ MsgTxAddOutput a -> tx_add_output_tlvs a
+ MsgTxRemoveInput a -> tx_remove_input_tlvs a
+ MsgTxRemoveOutput a -> tx_remove_output_tlvs a
+ MsgTxComplete a -> tx_complete_tlvs a
+ MsgTxSignatures a -> tx_signatures_tlvs a
+ MsgTxInitRbf a -> tx_init_rbf_tlvs a
+ MsgTxAckRbf a -> tx_ack_rbf_tlvs a
+ MsgTxAbort a -> tx_abort_tlvs a
+ MsgStfu a -> stfu_tlvs a
+ MsgShutdown a -> shutdown_tlvs a
+ MsgClosingComplete a -> closing_complete_tlvs a
+ MsgClosingSig a -> closing_sig_tlvs a
+ MsgClosingSigned a -> closing_signed_tlvs a
+ MsgUpdateAddHtlc a -> update_add_htlc_tlvs a
+ MsgUpdateFulfillHtlc a -> update_fulfill_htlc_tlvs a
+ MsgUpdateFailHtlc a -> update_fail_htlc_tlvs a
+ MsgUpdateFailMalformedHtlc a -> update_fail_malformed_htlc_tlvs a
+ MsgCommitmentSigned a -> commitment_signed_tlvs a
+ MsgRevokeAndAck a -> revoke_and_ack_tlvs a
+ MsgUpdateFee a -> update_fee_tlvs a
+ MsgChannelReestablish a -> channel_reestablish_tlvs a
+
+-- field values ---------------------------------------------------------------
+
+-- the bitcoin genesis block hash, in internal byte order
+chain_h :: String
+chain_h = "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"
+
+cid_h, tcid_h, txid_h, secret_h, preimage_h, phash_h :: String
+cid_h = rep 32 "ab"
+tcid_h = rep 32 "cd"
+txid_h = rep 32 "7e"
+secret_h = rep 32 "5e"
+preimage_h = rep 32 "50"
+phash_h = rep 32 "9a"
+
+p1_h, p2_h, p3_h, p4_h, p5_h, p6_h, p7_h :: String
+p1_h = "02" ++ rep 32 "11"
+p2_h = "03" ++ rep 32 "22"
+p3_h = "02" ++ rep 32 "33"
+p4_h = "03" ++ rep 32 "44"
+p5_h = "02" ++ rep 32 "55"
+p6_h = "03" ++ rep 32 "66"
+p7_h = "02" ++ rep 32 "77"
+
+sig1_h, sig2_h, sig3_h :: String
+sig1_h = rep 64 "a1"
+sig2_h = rep 64 "b2"
+sig3_h = rep 64 "c3"
+
+-- version, ephemeral key, hop payloads, hmac
+onion_h :: String
+onion_h = "00" ++ p3_h ++ rep 1300 "44" ++ rep 32 "55"
+
+-- twenty hold times of 100, then 210 truncated hmacs
+attribution_h :: String
+attribution_h = rep 20 "00000064" ++ rep 210 "0badf00d"
+
+p2wpkh_h, p2wsh_h, p2tr_h :: String
+p2wpkh_h = "0014" ++ rep 20 "88"
+p2wsh_h = "0020" ++ rep 32 "99"
+p2tr_h = "5120" ++ rep 32 "ee"
+
+-- the sha256 of the empty string
+onion_hash_h :: String
+onion_hash_h =
+ "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"
+
+f_chain :: Maybe BOLT1.ChainHash
+f_chain = BOLT1.chain_hash =<< hx chain_h
+
+f_cid, f_tcid :: Maybe BOLT1.ChannelId
+f_cid = BOLT1.channel_id =<< hx cid_h
+f_tcid = BOLT1.channel_id =<< hx tcid_h
+
+f_point :: String -> Maybe BOLT1.Point
+f_point h = BOLT1.point =<< hx h
+
+f_sig :: String -> Maybe BOLT1.Signature
+f_sig h = BOLT1.signature =<< hx h
+
+f_txid :: Maybe Tx.TxId
+f_txid = Tx.mkTxId =<< hx txid_h
+
+f_secret :: Maybe BOLT1.PerCommitmentSecret
+f_secret = BOLT1.per_commitment_secret =<< hx secret_h
+
+f_script :: String -> Maybe ScriptPubKey
+f_script h = script_pubkey =<< hx h
+
+f_attribution :: Maybe AttributionData
+f_attribution = attribution_data =<< hx attribution_h
+
+anchors :: BOLT9.FeatureVector
+anchors = BOLT9.channel_type_features
+ (BOLT9.ChannelType BOLT9.BasicAnchors False False)
+
+sat :: Word64 -> Maybe BOLT1.Satoshi
+sat = BOLT1.satoshi
+
+msat :: Word64 -> Maybe BOLT1.MilliSatoshi
+msat = BOLT1.milli_satoshi
+
+-- message layouts ------------------------------------------------------------
+
+-- A message's layout: its type and fixed fields (hex, assembled by hand
+-- from the spec) and its known TLV types, each with a valid value and
+-- some malformed ones.
+data Layout = Layout
+ { lay_name :: String
+ , lay_type :: String
+ , lay_fixed :: [String]
+ , lay_known :: [(Word64, String, [String])]
+ }
+
+open_channel_lay :: Layout
+open_channel_lay = Layout "open_channel" "0020" [
+ chain_h
+ , tcid_h
+ , "00000000000f4240" -- funding_satoshis: 1000000
+ , "00000000000003e8" -- push_msat: 1000
+ , "0000000000000222" -- dust_limit_satoshis: 546
+ , "ffffffffffffffff" -- max_htlc_value_in_flight_msat: u64 max
+ , "0000000000002710" -- channel_reserve_satoshis: 10000
+ , "0000000000000001" -- htlc_minimum_msat: 1
+ , "000000fd" -- feerate_per_kw: 253
+ , "0090" -- to_self_delay: 144
+ , "01e3" -- max_accepted_htlcs: 483
+ , p1_h, p2_h, p3_h, p4_h, p5_h, p6_h
+ , "01" -- channel_flags
+ ] [ (0, p2wpkh_h, []), (1, "401000", []) ]
+
+accept_channel_lay :: Layout
+accept_channel_lay = Layout "accept_channel" "0021" [
+ tcid_h
+ , "0000000000000222" -- dust_limit_satoshis: 546
+ , "0000000005f5e100" -- max_htlc_value_in_flight_msat: 100000000
+ , "0000000000002710" -- channel_reserve_satoshis: 10000
+ , "00000000000003e8" -- htlc_minimum_msat: 1000
+ , "00000003" -- minimum_depth: 3
+ , "0090" -- to_self_delay: 144
+ , "01e3" -- max_accepted_htlcs: 483
+ , p1_h, p2_h, p3_h, p4_h, p5_h, p6_h
+ ] [ (0, "", []), (1, "401000", []) ]
+
+funding_created_lay :: Layout
+funding_created_lay = Layout "funding_created" "0022" [
+ tcid_h
+ , txid_h
+ , "0001" -- funding_output_index: 1
+ , sig1_h
+ ] []
+
+funding_signed_lay :: Layout
+funding_signed_lay = Layout "funding_signed" "0023" [ cid_h, sig1_h ] []
+
+channel_ready_lay :: Layout
+channel_ready_lay = Layout "channel_ready" "0024" [ cid_h, p1_h ]
+ [ (1, "083a8400034d0001", ["083a8400034d00", "083a8400034d000100"]) ]
+
+open_channel2_lay :: Layout
+open_channel2_lay = Layout "open_channel2" "0040" [
+ chain_h
+ , tcid_h
+ , "00000fa0" -- funding_feerate_perkw: 4000
+ , "000000fd" -- commitment_feerate_perkw: 253
+ , "0000000000030d40" -- funding_satoshis: 200000
+ , "0000000000000162" -- dust_limit_satoshis: 354
+ , "ffffffffffffffff" -- max_htlc_value_in_flight_msat: u64 max
+ , "0000000000000001" -- htlc_minimum_msat: 1
+ , "0090" -- to_self_delay: 144
+ , "01e3" -- max_accepted_htlcs: 483
+ , "000c3500" -- locktime: 800000
+ , p1_h, p2_h, p3_h, p4_h, p5_h, p6_h, p7_h
+ , "00" -- channel_flags
+ ] [ (0, p2wpkh_h, []), (1, "401000", []), (2, "", ["00", "01"]) ]
+
+accept_channel2_lay :: Layout
+accept_channel2_lay = Layout "accept_channel2" "0041" [
+ tcid_h
+ , "0000000000000000" -- funding_satoshis: 0
+ , "0000000000000162" -- dust_limit_satoshis: 354
+ , "0000000005f5e100" -- max_htlc_value_in_flight_msat: 100000000
+ , "00000000000003e8" -- htlc_minimum_msat: 1000
+ , "00000006" -- minimum_depth: 6
+ , "0090" -- to_self_delay: 144
+ , "001e" -- max_accepted_htlcs: 30
+ , p1_h, p2_h, p3_h, p4_h, p5_h, p6_h, p7_h
+ ] [ (0, p2wsh_h, []), (1, "401000", []), (2, "", ["00"]) ]
+
+tx_add_input_lay :: Layout
+tx_add_input_lay = Layout "tx_add_input" "0042" [
+ cid_h
+ , "0000000000000002" -- serial_id: 2
+ , "0005", "0102030405" -- prevtx
+ , "00000001" -- prevtx_vout: 1
+ , "fffffffd" -- sequence
+ ] []
+
+tx_add_output_lay :: Layout
+tx_add_output_lay = Layout "tx_add_output" "0043" [
+ cid_h
+ , "0000000000000004" -- serial_id: 4
+ , "0000000000030d40" -- sats: 200000
+ , "0022", p2wsh_h -- script
+ ] []
+
+tx_remove_input_lay :: Layout
+tx_remove_input_lay = Layout "tx_remove_input" "0044"
+ [ cid_h, "0000000000000002" ] []
+
+tx_remove_output_lay :: Layout
+tx_remove_output_lay = Layout "tx_remove_output" "0045"
+ [ cid_h, "0000000000000005" ] []
+
+tx_complete_lay :: Layout
+tx_complete_lay = Layout "tx_complete" "0046" [ cid_h ] []
+
+tx_signatures_lay :: Layout
+tx_signatures_lay = Layout "tx_signatures" "0047" [
+ cid_h
+ , txid_h
+ , "0002" -- num_witnesses
+ , "0006", "0202aaaa01bb" -- two stack items
+ , "0003", "0101cc" -- one stack item
+ ] []
+
+tx_init_rbf_lay :: Layout
+tx_init_rbf_lay = Layout "tx_init_rbf" "0048" [
+ cid_h
+ , "000c3500" -- locktime: 800000
+ , "00001046" -- feerate: 4166
+ ] [ (0, "0000000000030d40", ["00030d40", "000000000000030d40"])
+ , (2, "", ["00"]) ]
+
+tx_ack_rbf_lay :: Layout
+tx_ack_rbf_lay = Layout "tx_ack_rbf" "0049" [ cid_h ]
+ [ (0, "fffffffffffe7960", ["ff"]), (2, "", ["2a2a"]) ]
+
+tx_abort_lay :: Layout
+tx_abort_lay = Layout "tx_abort" "004a" [
+ cid_h
+ , "000c", "6661696c656420636865636b" -- "failed check"
+ ] []
+
+stfu_lay :: Layout
+stfu_lay = Layout "stfu" "0002" [ cid_h, "01" ] []
+
+shutdown_lay :: Layout
+shutdown_lay = Layout "shutdown" "0026" [ cid_h, "0016", p2wpkh_h ] []
+
+closing_complete_lay :: Layout
+closing_complete_lay = Layout "closing_complete" "0028" [
+ cid_h
+ , "0016", p2wpkh_h -- closer_scriptpubkey
+ , "0022", p2tr_h -- closee_scriptpubkey
+ , "00000000000001f4" -- fee_satoshis: 500
+ , "00000000" -- locktime: 0
+ ] [ (t, sig1_h, [rep 63 "a1", rep 65 "a1"]) | t <- [1, 2, 3] ]
+
+closing_sig_lay :: Layout
+closing_sig_lay = Layout "closing_sig" "0029" [
+ cid_h
+ , "0016", p2wpkh_h -- closer_scriptpubkey
+ , "0022", p2tr_h -- closee_scriptpubkey
+ , "00000000000001f4" -- fee_satoshis: 500
+ , "000c3500" -- locktime: 800000
+ ] [ (t, sig3_h, [rep 63 "c3", ""]) | t <- [1, 2, 3] ]
+
+closing_signed_lay :: Layout
+closing_signed_lay = Layout "closing_signed" "0027" [
+ cid_h
+ , "00000000000001f4" -- fee_satoshis: 500
+ , sig1_h
+ ] [ (1, "000000000000006400000000000003e8", [
+ "000000000000006400000000000003"
+ , "000000000000006400000000000003e800"
+ , "0000000000000064ffffffffffffffff" -- max fee above 21M BTC
+ ]) ]
+
+update_add_htlc_lay :: Layout
+update_add_htlc_lay = Layout "update_add_htlc" "0080" [
+ cid_h
+ , "0000000000000000" -- id: 0
+ , "00000000000186a0" -- amount_msat: 100000
+ , phash_h
+ , "000c3550" -- cltv_expiry: 800080
+ , onion_h
+ ] [ (0, p2_h, [ rep 32 "22", p2_h ++ "00", "04" ++ rep 32 "22" ]) ]
+
+update_fulfill_htlc_lay :: Layout
+update_fulfill_htlc_lay = Layout "update_fulfill_htlc" "0082" [
+ cid_h
+ , "0000000000000007" -- id: 7
+ , preimage_h
+ ] [ (1, attribution_h, [ drop 2 attribution_h, attribution_h ++ "00" ])
+ , (3, "deadbeef", []) ]
+
+update_fail_htlc_lay :: Layout
+update_fail_htlc_lay = Layout "update_fail_htlc" "0083" [
+ cid_h
+ , "0000000000000007" -- id: 7
+ , "0004", "01020304" -- reason
+ ] [ (1, attribution_h, [ "" ]) ]
+
+update_fail_malformed_htlc_lay :: Layout
+update_fail_malformed_htlc_lay =
+ Layout "update_fail_malformed_htlc" "0087" [
+ cid_h
+ , "0000000000000003" -- id: 3
+ , onion_hash_h
+ , "c005" -- failure_code: BADONION | PERM | 5
+ ] []
+
+commitment_signed_lay :: Layout
+commitment_signed_lay = Layout "commitment_signed" "0084" [
+ cid_h
+ , sig1_h
+ , "0002" -- num_htlcs
+ , sig2_h, sig3_h
+ ] [ (1, txid_h, [ rep 31 "7e", rep 33 "7e" ]) ]
+
+revoke_and_ack_lay :: Layout
+revoke_and_ack_lay = Layout "revoke_and_ack" "0085"
+ [ cid_h, secret_h, p1_h ] []
+
+update_fee_lay :: Layout
+update_fee_lay = Layout "update_fee" "0086"
+ [ cid_h, "000009c4" ] [] -- feerate_per_kw: 2500
+
+channel_reestablish_lay :: Layout
+channel_reestablish_lay = Layout "channel_reestablish" "0088" [
+ cid_h
+ , "0000000000000005" -- next_commitment_number: 5
+ , "0000000000000004" -- next_revocation_number: 4
+ , secret_h
+ , p1_h
+ ] [ (1, txid_h ++ "01", [ txid_h, txid_h ++ "0100" ]) ]
+
+layouts :: [Layout]
+layouts = [
+ open_channel_lay, accept_channel_lay, funding_created_lay
+ , funding_signed_lay, channel_ready_lay, open_channel2_lay
+ , accept_channel2_lay, tx_add_input_lay, tx_add_output_lay
+ , tx_remove_input_lay, tx_remove_output_lay, tx_complete_lay
+ , tx_signatures_lay, tx_init_rbf_lay, tx_ack_rbf_lay, tx_abort_lay
+ , stfu_lay, shutdown_lay, closing_complete_lay, closing_sig_lay
+ , closing_signed_lay, update_add_htlc_lay, update_fulfill_htlc_lay
+ , update_fail_htlc_lay, update_fail_malformed_htlc_lay
+ , commitment_signed_lay, revoke_and_ack_lay, update_fee_lay
+ , channel_reestablish_lay
]
--- V2 Channel Establishment (Interactive-tx) Tests ----------------------------
-
-v2_establishment_tests :: TestTree
-v2_establishment_tests = testGroup "V2 Channel Establishment" [
- testGroup "OpenChannel2" [
- testCase "encode/decode roundtrip" $ do
- let msg = OpenChannel2
- { openChannel2ChainHash = testChainHash
- , openChannel2TempChannelId = testChannelId
- , openChannel2FundingFeeratePerkw = 2500
- , openChannel2CommitFeeratePerkw = 2000
- , openChannel2FundingSatoshi = Satoshi 1000000
- , openChannel2DustLimitSatoshi = Satoshi 546
- , openChannel2MaxHtlcValueInFlight = MilliSatoshi 100000000
- , openChannel2HtlcMinimumMsat = MilliSatoshi 1000
- , openChannel2ToSelfDelay = 144
- , openChannel2MaxAcceptedHtlcs = 483
- , openChannel2Locktime = 0
- , openChannel2FundingPubkey = testPoint
- , openChannel2RevocationBasepoint = testPoint
- , openChannel2PaymentBasepoint = testPoint
- , openChannel2DelayedPaymentBase = testPoint
- , openChannel2HtlcBasepoint = testPoint
- , openChannel2FirstPerCommitPoint = testPoint
- , openChannel2SecondPerCommitPoint = testPoint2
- , openChannel2ChannelFlags = 0x00
- , openChannel2Tlvs = emptyTlvs
- }
- encoded = encodeOpenChannel2 msg
- case decodeOpenChannel2 encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "AcceptChannel2" [
- testCase "encode/decode roundtrip" $ do
- let msg = AcceptChannel2
- { acceptChannel2TempChannelId = testChannelId
- , acceptChannel2FundingSatoshi = Satoshi 500000
- , acceptChannel2DustLimitSatoshi = Satoshi 546
- , acceptChannel2MaxHtlcValueInFlight = MilliSatoshi 100000000
- , acceptChannel2HtlcMinimumMsat = MilliSatoshi 1000
- , acceptChannel2MinimumDepth = 3
- , acceptChannel2ToSelfDelay = 144
- , acceptChannel2MaxAcceptedHtlcs = 483
- , acceptChannel2FundingPubkey = testPoint
- , acceptChannel2RevocationBasepoint = testPoint
- , acceptChannel2PaymentBasepoint = testPoint
- , acceptChannel2DelayedPaymentBase = testPoint
- , acceptChannel2HtlcBasepoint = testPoint
- , acceptChannel2FirstPerCommitPoint = testPoint
- , acceptChannel2SecondPerCommitPoint = testPoint2
- , acceptChannel2Tlvs = emptyTlvs
- }
- encoded = encodeAcceptChannel2 msg
- case decodeAcceptChannel2 encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "TxAddInput" [
- testCase "encode/decode roundtrip" $ do
- let msg = TxAddInput
- { txAddInputChannelId = testChannelId
- , txAddInputSerialId = serialId 12345
- , txAddInputPrevTx = BS.pack [0x01, 0x02, 0x03, 0x04]
- , txAddInputPrevVout = 0
- , txAddInputSequence = 0xfffffffe
- }
- 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
- , txAddInputSerialId = serialId 0
- , txAddInputPrevTx = BS.empty
- , txAddInputPrevVout = 0
- , txAddInputSequence = 0
- }
- 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
- let msg = TxAddOutput
- { txAddOutputChannelId = testChannelId
- , txAddOutputSerialId = serialId 54321
- , txAddOutputSats = Satoshi 100000
- , txAddOutputScript = scriptPubKey (BS.pack [0x00, 0x14] <>
- BS.replicate 20 0xaa)
- }
- 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
- let msg = TxRemoveInput
- { txRemoveInputChannelId = testChannelId
- , txRemoveInputSerialId = serialId 12345
- }
- encoded = encodeTxRemoveInput msg
- case decodeTxRemoveInput encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "TxRemoveOutput" [
- testCase "encode/decode roundtrip" $ do
- let msg = TxRemoveOutput
- { txRemoveOutputChannelId = testChannelId
- , txRemoveOutputSerialId = serialId 54321
- }
- encoded = encodeTxRemoveOutput msg
- case decodeTxRemoveOutput encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "TxComplete" [
- testCase "encode/decode roundtrip" $ do
- let msg = TxComplete { txCompleteChannelId = testChannelId }
- encoded = encodeTxComplete msg
- case decodeTxComplete encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "TxSignatures" [
- testCase "encode/decode with no witnesses" $ do
- let msg = TxSignatures
- { txSignaturesChannelId = testChannelId
- , txSignaturesTxid = testTxId
- , txSignaturesWitnesses = []
- }
- 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)
- msg = TxSignatures
- { txSignaturesChannelId = testChannelId
- , txSignaturesTxid = testTxId
- , txSignaturesWitnesses = [w1, w2]
- }
- 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
- let msg = TxInitRbf
- { txInitRbfChannelId = testChannelId
- , txInitRbfLocktime = 800000
- , txInitRbfFeerate = 3000
- , txInitRbfTlvs = emptyTlvs
- }
- encoded = encodeTxInitRbf msg
- case decodeTxInitRbf encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "TxAckRbf" [
- testCase "encode/decode roundtrip" $ do
- let msg = TxAckRbf
- { txAckRbfChannelId = testChannelId
- , txAckRbfTlvs = emptyTlvs
- }
- encoded = encodeTxAckRbf msg
- case decodeTxAckRbf encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "TxAbort" [
- testCase "encode/decode roundtrip" $ do
- let msg = TxAbort
- { txAbortChannelId = testChannelId
- , txAbortData = "transaction abort reason"
- }
- 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
- }
- 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
- ]
+-- a TLV record, in hex (for types below 253 and values below 65536
+-- bytes)
+tlv_h :: Word64 -> String -> String
+tlv_h t v = hex2 t ++ len ++ v
+ where
+ n = fromIntegral (length v `div` 2) :: Word64
+ len | n < 253 = hex2 n
+ | otherwise = "fd" ++ hex2 (n `div` 256) ++ hex2 (n `mod` 256)
+
+-- a byte, in hex
+hex2 :: Word64 -> String
+hex2 w = [digit (w `div` 16), digit (w `mod` 16)]
+ where
+ digit d = maybe '?' id (lookup d (zip [0 ..] "0123456789abcdef"))
+
+-- known answers --------------------------------------------------------------
+
+-- Check a message against wire bytes assembled by hand: its payload
+-- decodes to the expected value and re-encodes to the same bytes, and
+-- likewise for the full message.
+kat
+ :: (Eq a, Show a)
+ => String
+ -> Layout
+ -> [String] -- TLV records, hex
+ -> (BS.ByteString -> Either DecodeError a)
+ -> (a -> Either EncodeError BS.ByteString)
+ -> (a -> Message)
+ -> Maybe a
+ -> TestTree
+kat name lay recs dec enc wrap expected = testCase name $ do
+ payload <- unhex (concat (lay_fixed lay ++ recs))
+ wire <- unhex (lay_type lay ++ concat (lay_fixed lay ++ recs))
+ m <- just name expected
+ dec payload @?= Right m
+ enc m @?= Right payload
+ decode_message wire @?= Right (wrap m)
+ encode_message (wrap m) @?= Right wire
+
+known_answers :: TestTree
+known_answers = testGroup "known answers" [
+ kat "open_channel" open_channel_lay
+ [ tlv_h 0 p2wpkh_h, tlv_h 1 "401000" ]
+ decode_open_channel encode_open_channel MsgOpenChannel $ do
+ ch <- f_chain
+ tcid <- f_tcid
+ fund <- sat 1000000
+ push <- msat 1000
+ dust <- sat 546
+ res <- sat 10000
+ hmin <- msat 1
+ [a, b, c, d, e, f] <- traverse f_point
+ [p1_h, p2_h, p3_h, p4_h, p5_h, p6_h]
+ spk <- f_script p2wpkh_h
+ pure (OpenChannel ch tcid fund push dust maxBound res hmin 253 144
+ 483 a b c d e f 1 (Just spk) (Just anchors) empty)
+
+ , kat "open_channel (no TLVs)" open_channel_lay []
+ decode_open_channel encode_open_channel MsgOpenChannel $ do
+ ch <- f_chain
+ tcid <- f_tcid
+ fund <- sat 1000000
+ push <- msat 1000
+ dust <- sat 546
+ res <- sat 10000
+ hmin <- msat 1
+ [a, b, c, d, e, f] <- traverse f_point
+ [p1_h, p2_h, p3_h, p4_h, p5_h, p6_h]
+ pure (OpenChannel ch tcid fund push dust maxBound res hmin 253 144
+ 483 a b c d e f 1 Nothing Nothing empty)
+
+ , kat "accept_channel" accept_channel_lay
+ [ tlv_h 0 "", tlv_h 1 "401000" ]
+ decode_accept_channel encode_accept_channel MsgAcceptChannel $ do
+ tcid <- f_tcid
+ dust <- sat 546
+ res <- sat 10000
+ hmin <- msat 1000
+ [a, b, c, d, e, f] <- traverse f_point
+ [p1_h, p2_h, p3_h, p4_h, p5_h, p6_h]
+ spk <- script_pubkey ""
+ pure (AcceptChannel tcid dust 100000000 res hmin 3 144 483
+ a b c d e f (Just spk) (Just anchors) empty)
+
+ , kat "funding_created" funding_created_lay []
+ decode_funding_created (Right . encode_funding_created)
+ MsgFundingCreated $ do
+ tcid <- f_tcid
+ t <- f_txid
+ s <- f_sig sig1_h
+ pure (FundingCreated tcid t 1 s empty)
+
+ , kat "funding_signed" funding_signed_lay []
+ decode_funding_signed (Right . encode_funding_signed)
+ MsgFundingSigned $ do
+ cid <- f_cid
+ s <- f_sig sig1_h
+ pure (FundingSigned cid s empty)
+
+ , kat "channel_ready" channel_ready_lay
+ [ tlv_h 1 "083a8400034d0001" ]
+ decode_channel_ready encode_channel_ready MsgChannelReady $ do
+ cid <- f_cid
+ pcp <- f_point p1_h
+ alias <- BOLT1.short_channel_id 539268 845 1
+ pure (ChannelReady cid pcp (Just alias) empty)
+
+ , kat "open_channel2" open_channel2_lay
+ [ tlv_h 0 p2wpkh_h, tlv_h 1 "401000", tlv_h 2 "" ]
+ decode_open_channel2 encode_open_channel2 MsgOpenChannel2 $ do
+ ch <- f_chain
+ tcid <- f_tcid
+ fund <- sat 200000
+ dust <- sat 354
+ hmin <- msat 1
+ [a, b, c, d, e, f, g] <- traverse f_point
+ [p1_h, p2_h, p3_h, p4_h, p5_h, p6_h, p7_h]
+ spk <- f_script p2wpkh_h
+ pure (OpenChannel2 ch tcid 4000 253 fund dust maxBound hmin 144 483
+ 800000 a b c d e f g 0 (Just spk) (Just anchors) True
+ empty)
+
+ , kat "accept_channel2" accept_channel2_lay
+ [ tlv_h 0 p2wsh_h, tlv_h 1 "401000", tlv_h 2 "" ]
+ decode_accept_channel2 encode_accept_channel2 MsgAcceptChannel2 $ do
+ tcid <- f_tcid
+ fund <- sat 0
+ dust <- sat 354
+ hmin <- msat 1000
+ [a, b, c, d, e, f, g] <- traverse f_point
+ [p1_h, p2_h, p3_h, p4_h, p5_h, p6_h, p7_h]
+ spk <- f_script p2wsh_h
+ pure (AcceptChannel2 tcid fund dust 100000000 hmin 6 144 30
+ a b c d e f g (Just spk) (Just anchors) True empty)
+
+ , kat "tx_add_input" tx_add_input_lay []
+ decode_tx_add_input encode_tx_add_input MsgTxAddInput $ do
+ cid <- f_cid
+ pure (TxAddInput cid (SerialId 2) "\x01\x02\x03\x04\x05" 1
+ 0xfffffffd empty)
+
+ , kat "tx_add_output" tx_add_output_lay []
+ decode_tx_add_output (Right . encode_tx_add_output)
+ MsgTxAddOutput $ do
+ cid <- f_cid
+ amt <- sat 200000
+ spk <- f_script p2wsh_h
+ pure (TxAddOutput cid (SerialId 4) amt spk empty)
+
+ , kat "tx_remove_input" tx_remove_input_lay []
+ decode_tx_remove_input (Right . encode_tx_remove_input)
+ MsgTxRemoveInput $ do
+ cid <- f_cid
+ pure (TxRemoveInput cid (SerialId 2) empty)
+
+ , kat "tx_remove_output" tx_remove_output_lay []
+ decode_tx_remove_output (Right . encode_tx_remove_output)
+ MsgTxRemoveOutput $ do
+ cid <- f_cid
+ pure (TxRemoveOutput cid (SerialId 5) empty)
+
+ , kat "tx_complete" tx_complete_lay []
+ decode_tx_complete (Right . encode_tx_complete) MsgTxComplete $ do
+ cid <- f_cid
+ pure (TxComplete cid empty)
+
+ , kat "tx_signatures" tx_signatures_lay []
+ decode_tx_signatures encode_tx_signatures MsgTxSignatures $ do
+ cid <- f_cid
+ t <- f_txid
+ w1 <- witness "\x02\x02\xaa\xaa\x01\xbb"
+ w2 <- witness "\x01\x01\xcc"
+ pure (TxSignatures cid t [w1, w2] empty)
+
+ , kat "tx_init_rbf" tx_init_rbf_lay
+ [ tlv_h 0 "0000000000030d40", tlv_h 2 "" ]
+ decode_tx_init_rbf encode_tx_init_rbf MsgTxInitRbf $ do
+ cid <- f_cid
+ pure (TxInitRbf cid 800000 4166 (Just 200000) True empty)
+
+ , kat "tx_ack_rbf" tx_ack_rbf_lay
+ [ tlv_h 0 "fffffffffffe7960", tlv_h 2 "" ]
+ decode_tx_ack_rbf encode_tx_ack_rbf MsgTxAckRbf $ do
+ cid <- f_cid
+ pure (TxAckRbf cid (Just (-100000)) True empty)
+
+ , kat "tx_abort" tx_abort_lay []
+ decode_tx_abort encode_tx_abort MsgTxAbort $ do
+ cid <- f_cid
+ pure (TxAbort cid "failed check" empty)
+
+ , kat "stfu" stfu_lay []
+ decode_stfu (Right . encode_stfu) MsgStfu $ do
+ cid <- f_cid
+ pure (Stfu cid True empty)
+
+ , kat "shutdown" shutdown_lay []
+ decode_shutdown (Right . encode_shutdown) MsgShutdown $ do
+ cid <- f_cid
+ spk <- f_script p2wpkh_h
+ pure (Shutdown cid spk empty)
+
+ , kat "closing_complete" closing_complete_lay
+ [ tlv_h 1 sig1_h, tlv_h 3 sig2_h ]
+ decode_closing_complete encode_closing_complete
+ MsgClosingComplete $ do
+ cid <- f_cid
+ closer <- f_script p2wpkh_h
+ closee <- f_script p2tr_h
+ fee <- sat 500
+ s1 <- f_sig sig1_h
+ s2 <- f_sig sig2_h
+ pure (ClosingComplete cid closer closee fee 0 (Just s1) Nothing
+ (Just s2) empty)
+
+ , kat "closing_complete (closee output only)" closing_complete_lay
+ [ tlv_h 2 sig1_h ]
+ decode_closing_complete encode_closing_complete
+ MsgClosingComplete $ do
+ cid <- f_cid
+ closer <- f_script p2wpkh_h
+ closee <- f_script p2tr_h
+ fee <- sat 500
+ s1 <- f_sig sig1_h
+ pure (ClosingComplete cid closer closee fee 0 Nothing (Just s1)
+ Nothing empty)
+
+ , kat "closing_sig" closing_sig_lay [ tlv_h 3 sig3_h ]
+ decode_closing_sig encode_closing_sig MsgClosingSig $ do
+ cid <- f_cid
+ closer <- f_script p2wpkh_h
+ closee <- f_script p2tr_h
+ fee <- sat 500
+ s3 <- f_sig sig3_h
+ pure (ClosingSig cid closer closee fee 800000 Nothing Nothing
+ (Just s3) empty)
+
+ , kat "closing_signed" closing_signed_lay
+ [ tlv_h 1 "000000000000006400000000000003e8" ]
+ decode_closing_signed encode_closing_signed MsgClosingSigned $ do
+ cid <- f_cid
+ fee <- sat 500
+ s <- f_sig sig1_h
+ lo <- sat 100
+ hi <- sat 1000
+ pure (ClosingSigned cid fee s (Just (FeeRange lo hi)) empty)
+
+ , kat "update_add_htlc" update_add_htlc_lay [ tlv_h 0 p2_h ]
+ decode_update_add_htlc encode_update_add_htlc MsgUpdateAddHtlc $ do
+ cid <- f_cid
+ amt <- msat 100000
+ ph <- BOLT1.payment_hash =<< hx phash_h
+ onion <- onion_routing_packet =<< hx onion_h
+ pk <- f_point p2_h
+ pure (UpdateAddHtlc cid (HtlcId 0) amt ph 800080 onion (Just pk)
+ empty)
+
+ , kat "update_fulfill_htlc" update_fulfill_htlc_lay
+ [ tlv_h 1 attribution_h, tlv_h 3 "deadbeef" ]
+ decode_update_fulfill_htlc encode_update_fulfill_htlc
+ MsgUpdateFulfillHtlc $ do
+ cid <- f_cid
+ pre <- BOLT1.payment_preimage =<< hx preimage_h
+ att <- f_attribution
+ pure (UpdateFulfillHtlc cid (HtlcId 7) pre (Just att)
+ (Just "\xde\xad\xbe\xef") empty)
+
+ , kat "update_fail_htlc" update_fail_htlc_lay [ tlv_h 1 attribution_h ]
+ decode_update_fail_htlc encode_update_fail_htlc MsgUpdateFailHtlc $ do
+ cid <- f_cid
+ att <- f_attribution
+ pure (UpdateFailHtlc cid (HtlcId 7) "\x01\x02\x03\x04" (Just att)
+ empty)
+
+ , kat "update_fail_malformed_htlc" update_fail_malformed_htlc_lay []
+ decode_update_fail_malformed_htlc
+ (Right . encode_update_fail_malformed_htlc)
+ MsgUpdateFailMalformedHtlc $ do
+ cid <- f_cid
+ oh <- onion_hash =<< hx onion_hash_h
+ pure (UpdateFailMalformedHtlc cid (HtlcId 3) oh 0xc005 empty)
+
+ , kat "commitment_signed" commitment_signed_lay [ tlv_h 1 txid_h ]
+ decode_commitment_signed encode_commitment_signed
+ MsgCommitmentSigned $ do
+ cid <- f_cid
+ sigs <- traverse f_sig [sig1_h, sig2_h, sig3_h]
+ t <- f_txid
+ case sigs of
+ (s : hs) -> pure (CommitmentSigned cid s hs (Just t) empty)
+ [] -> Nothing
+
+ , kat "revoke_and_ack" revoke_and_ack_lay []
+ decode_revoke_and_ack (Right . encode_revoke_and_ack)
+ MsgRevokeAndAck $ do
+ cid <- f_cid
+ sec <- f_secret
+ pcp <- f_point p1_h
+ pure (RevokeAndAck cid sec pcp empty)
+
+ , kat "update_fee" update_fee_lay []
+ decode_update_fee (Right . encode_update_fee) MsgUpdateFee $ do
+ cid <- f_cid
+ pure (UpdateFee cid 2500 empty)
+
+ , kat "channel_reestablish" channel_reestablish_lay
+ [ tlv_h 1 (txid_h ++ "01") ]
+ decode_channel_reestablish encode_channel_reestablish
+ MsgChannelReestablish $ do
+ cid <- f_cid
+ sec <- f_secret
+ pcp <- f_point p1_h
+ t <- f_txid
+ pure (ChannelReestablish cid 5 4 sec pcp (Just (NextFunding t 1))
+ empty)
]
--- Channel Close Tests ---------------------------------------------------------
-
-close_tests :: TestTree
-close_tests = testGroup "Channel Close" [
- testGroup "Stfu" [
- testCase "encode/decode IsInitiator" $ do
- let msg = Stfu
- { stfuChannelId = testChannelId
- , stfuInitiator = IsInitiator
- }
- encoded = encodeStfu msg
- case decodeStfu encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- , testCase "encode/decode NotInitiator" $ do
- let msg = Stfu
- { stfuChannelId = testChannelId
- , stfuInitiator = NotInitiator
- }
- encoded = encodeStfu msg
- case decodeStfu encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "Shutdown" [
- testCase "encode/decode with P2WPKH script" $ do
- let script = scriptPubKey (BS.pack [0x00, 0x14] <>
- BS.replicate 20 0xaa)
- msg = Shutdown
- { shutdownChannelId = testChannelId
- , shutdownScriptPubkey = script
- }
- case encodeShutdown msg of
- Left e -> assertFailure $ "encode failed: " ++ show e
- Right encoded -> case decodeShutdown encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- , testCase "encode/decode with P2WSH script" $ do
- let script = scriptPubKey (BS.pack [0x00, 0x20] <>
- BS.replicate 32 0xbb)
- msg = Shutdown
- { shutdownChannelId = testChannelId
- , shutdownScriptPubkey = script
- }
- case encodeShutdown msg of
- Left e -> assertFailure $ "encode failed: " ++ show e
- Right encoded -> case decodeShutdown encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "ClosingSigned" [
- testCase "encode/decode roundtrip" $ do
- let msg = ClosingSigned
- { closingSignedChannelId = testChannelId
- , closingSignedFeeSatoshi = Satoshi 1000
- , closingSignedSignature = testSignature
- , closingSignedTlvs = emptyTlvs
- }
- encoded = encodeClosingSigned msg
- case decodeClosingSigned encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "ClosingComplete" [
- testCase "encode/decode roundtrip" $ do
- let closerScript = scriptPubKey (BS.pack [0x00, 0x14] <>
- BS.replicate 20 0xcc)
- closeeScript = scriptPubKey (BS.pack [0x00, 0x14] <>
- BS.replicate 20 0xdd)
- msg = ClosingComplete
- { closingCompleteChannelId = testChannelId
- , closingCompleteCloserScript = closerScript
- , closingCompleteCloseeScript = closeeScript
- , closingCompleteFeeSatoshi = Satoshi 500
- , closingCompleteLocktime = 0
- , closingCompleteTlvs = emptyTlvs
- }
- case encodeClosingComplete msg of
- Left e -> assertFailure $ "encode failed: " ++ show e
- Right encoded -> case decodeClosingComplete encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "ClosingSig" [
- testCase "encode/decode roundtrip" $ do
- let closerScript = scriptPubKey (BS.pack [0x00, 0x14] <>
- BS.replicate 20 0xee)
- closeeScript = scriptPubKey (BS.pack [0x00, 0x14] <>
- BS.replicate 20 0xff)
- msg = ClosingSig
- { closingSigChannelId = testChannelId
- , closingSigCloserScript = closerScript
- , closingSigCloseeScript = closeeScript
- , closingSigFeeSatoshi = Satoshi 500
- , closingSigLocktime = 100
- , closingSigTlvs = emptyTlvs
- }
- case encodeClosingSig msg of
- Left e -> assertFailure $ "encode failed: " ++ show e
- Right encoded -> case decodeClosingSig encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
+-- TLV handling ---------------------------------------------------------------
+
+-- decode a message (type, fixed fields and TLV records in hex), check
+-- its unknown records, and check that it re-encodes exactly
+reencodes :: Layout -> [String] -> [TlvRecord] -> Assertion
+reencodes lay recs extra = do
+ wire <- unhex (lay_type lay ++ concat (lay_fixed lay ++ recs))
+ case decode_message wire of
+ Left e -> assertFailure ("decode failed: " ++ show e)
+ Right m -> do
+ BOLT1.un_tlv_stream (message_tlvs m) @?= extra
+ encode_message m @?= Right wire
+
+rejects :: Layout -> [String] -> DecodeError -> Assertion
+rejects lay recs err = do
+ wire <- unhex (lay_type lay ++ concat (lay_fixed lay ++ recs))
+ decode_message wire @?= Left err
+
+-- the smallest even type a message doesn't know
+first_unknown_even :: Layout -> Word64
+first_unknown_even lay = case filter (`notElem` known) [0, 2 ..] of
+ (t:_) -> t
+ [] -> 0
+ where
+ known = [ t | (t, _, _) <- lay_known lay ]
+
+tlv_cases :: Layout -> TestTree
+tlv_cases lay = testGroup (lay_name lay) $ [
+ testCase "unknown odd records are preserved" $
+ reencodes lay (valid ++ [tlv_h 43 "2a", tlv_h 201 ""])
+ [TlvRecord 43 "\x2a", TlvRecord 201 ""]
+ , testCase "unknown even records are rejected" $ do
+ let t = first_unknown_even lay
+ rejects lay [tlv_h t ""] (DecodeTlvError (TlvUnknownEvenType t))
+ rejects lay (valid ++ [tlv_h 42 "00"])
+ (DecodeTlvError (TlvUnknownEvenType 42))
+ , testCase "unordered records are rejected" $
+ rejects lay [tlv_h 45 "", tlv_h 43 ""]
+ (DecodeTlvError TlvNotStrictlyIncreasing)
+ , testCase "a huge record length is rejected" $ do
+ -- the length 2^64 - 1 must not wrap
+ rejects lay ["2bffffffffffffffffff2b"] (DecodeTlvError TlvTruncated)
+ ] ++ [
+ testCase ("type " ++ show t ++ " is typed") $ reencodes lay [tlv_h t v] []
+ | (t, v, _) <- lay_known lay
+ ] ++ [
+ testCase ("malformed type " ++ show t ++ " is rejected") $
+ mapM_ (\b -> rejects lay [tlv_h t b] (DecodeInvalidTlvValue t)) bad
+ | (t, _, bad) <- lay_known lay, not (null bad)
+ ]
+ where
+ valid = [ tlv_h t v | (t, v, _) <- lay_known lay ]
+
+tlv_handling :: TestTree
+tlv_handling = testGroup "TLV handling" $ map tlv_cases layouts ++ [
+ testGroup "splicing records" [
+ testCase "tx_add_input shared_input_txid is rejected" $
+ rejects tx_add_input_lay [tlv_h 0 txid_h]
+ (DecodeTlvError (TlvUnknownEvenType 0))
+ , testCase "tx_signatures shared_input_signature is rejected" $
+ rejects tx_signatures_lay [tlv_h 0 sig1_h]
+ (DecodeTlvError (TlvUnknownEvenType 0))
+ , testCase "channel_reestablish my_current_funding_locked is kept" $ do
+ v <- unhex (txid_h ++ "01")
+ reencodes channel_reestablish_lay
+ [tlv_h 1 (txid_h ++ "00"), tlv_h 5 (txid_h ++ "01")]
+ [TlvRecord 5 v]
]
+ , testCase "a non-minimal type is rejected" $
+ rejects update_fee_lay ["fd002b00"]
+ (DecodeTlvError TlvNonMinimalBigSize)
+ , testCase "a repeated type is rejected" $
+ rejects update_fee_lay [tlv_h 43 "", tlv_h 43 ""]
+ (DecodeTlvError TlvNotStrictlyIncreasing)
+ , testCase "trailing bytes that aren't a TLV record are rejected" $ do
+ rejects update_fee_lay ["fd"] (DecodeTlvError TlvTruncated)
+ rejects update_fee_lay ["2b"] (DecodeTlvError TlvTruncated)
+ rejects update_fee_lay ["2b02aa"] (DecodeTlvError TlvTruncated)
+ , testCase "an empty upfront_shutdown_script is kept" $ do
+ wire <- unhex (concat (lay_fixed open_channel_lay ++ [tlv_h 0 ""]))
+ fmap open_channel_upfront_shutdown_script (decode_open_channel wire)
+ @?= Right (script_pubkey "")
+ , testCase "an oversized upfront_shutdown_script is rejected" $ do
+ fixed <- unhex (concat (lay_fixed open_channel_lay))
+ let big = BS.replicate 65536 0x00
+ rec = "\x00\xfe\x00\x01\x00\x00" <> big
+ decode_open_channel (fixed <> rec) @?= Left (DecodeInvalidTlvValue 0)
+ , testCase "channel_type bytes are kept as received" $ do
+ wire <- unhex (concat (lay_fixed open_channel_lay
+ ++ [tlv_h 1 "00401000"]))
+ case decode_open_channel wire of
+ Left e -> assertFailure (show e)
+ Right m -> do
+ fmap BOLT9.render (open_channel_channel_type m)
+ @?= Just "\x00\x40\x10\x00"
+ (BOLT9.channel_type =<< open_channel_channel_type m)
+ @?= Just (BOLT9.ChannelType BOLT9.BasicAnchors False False)
+ encode_open_channel m @?= Right wire
]
--- Normal Operation Tests ------------------------------------------------------
-
-normal_operation_tests :: TestTree
-normal_operation_tests = testGroup "Normal Operation" [
- testGroup "UpdateAddHtlc" [
- testCase "encode/decode roundtrip" $ do
- let msg = UpdateAddHtlc
- { updateAddHtlcChannelId = testChannelId
- , updateAddHtlcId = htlcId 0
- , updateAddHtlcAmountMsat = MilliSatoshi 10000000
- , updateAddHtlcPaymentHash = testPaymentHash
- , updateAddHtlcCltvExpiry = 800144
- , updateAddHtlcOnionPacket = testOnionPacket
- , updateAddHtlcTlvs = emptyTlvs
- }
- encoded = encodeUpdateAddHtlc msg
- case decodeUpdateAddHtlc encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "UpdateFulfillHtlc" [
- testCase "encode/decode roundtrip" $ do
- let msg = UpdateFulfillHtlc
- { updateFulfillHtlcChannelId = testChannelId
- , updateFulfillHtlcId = htlcId 42
- , updateFulfillHtlcPaymentPreimage = testPaymentPreimage
- , updateFulfillHtlcTlvs = emptyTlvs
- }
- encoded = encodeUpdateFulfillHtlc msg
- case decodeUpdateFulfillHtlc encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "UpdateFailHtlc" [
- testCase "encode/decode roundtrip" $ do
- let msg = UpdateFailHtlc
- { updateFailHtlcChannelId = testChannelId
- , updateFailHtlcId = htlcId 42
- , updateFailHtlcReason = BS.replicate 32 0xaa
- , updateFailHtlcTlvs = emptyTlvs
- }
- 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
- , updateFailHtlcId = htlcId 0
- , updateFailHtlcReason = BS.empty
- , updateFailHtlcTlvs = emptyTlvs
- }
- 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
- let msg = UpdateFailMalformedHtlc
- { updateFailMalformedHtlcChannelId = testChannelId
- , updateFailMalformedHtlcId = htlcId 42
- , updateFailMalformedHtlcSha256Onion = testPaymentHash
- , updateFailMalformedHtlcFailureCode = 0x8002
- }
- encoded = encodeUpdateFailMalformedHtlc msg
- case decodeUpdateFailMalformedHtlc encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "CommitmentSigned" [
- testCase "encode/decode with no HTLC signatures" $ do
- let msg = CommitmentSigned
- { commitmentSignedChannelId = testChannelId
- , commitmentSignedSignature = testSignature
- , commitmentSignedHtlcSignatures = []
- }
- 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)
- msg = CommitmentSigned
- { commitmentSignedChannelId = testChannelId
- , commitmentSignedSignature = testSignature
- , commitmentSignedHtlcSignatures = [sig2, sig3]
- }
- 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 = testSecret
- , revokeAndAckNextPerCommitPoint = testPoint
- }
- encoded = encodeRevokeAndAck msg
- case decodeRevokeAndAck encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "UpdateFee" [
- testCase "encode/decode roundtrip" $ do
- let msg = UpdateFee
- { updateFeeChannelId = testChannelId
- , updateFeeFeeratePerKw = 5000
- }
- encoded = encodeUpdateFee msg
- case decodeUpdateFee encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
+-- decoding failures ----------------------------------------------------------
+
+decoding_failures :: TestTree
+decoding_failures = testGroup "decoding failures" [
+ testGroup "truncated payloads" [
+ testCase (lay_name lay) $ do
+ wire <- unhex (lay_type lay ++ concat (lay_fixed lay))
+ decode_message (BS.take (BS.length wire - 1) wire)
+ @?= Left DecodeInsufficientBytes
+ decode_message (BS.take 2 wire) @?= Left DecodeInsufficientBytes
+ | lay <- layouts ]
+ , testCase "a message without a type" $ do
+ decode_message "" @?= Left DecodeInsufficientBytes
+ decode_message "\x00" @?= Left DecodeInsufficientBytes
+ , testCase "message types BOLT #2 doesn't define" $ do
+ decode_message "\x00\x50" @?= Left (DecodeUnknownEvenType 80)
+ decode_message "\x00\x51" @?= Left (DecodeUnknownOddType 81)
+ decode_message "\x00\x4d" @?= Left (DecodeUnknownOddType 77)
+ decode_message "\x00\x7f" @?= Left (DecodeUnknownOddType 127)
+ decode_message "\x00\x10\x00\x00\x00\x00"
+ @?= Left (DecodeUnknownEvenType 16)
+ , testCase "an invalid point" $ do
+ let bad = "04" ++ rep 32 "11"
+ wire <- unhex (concat (open_channel_fields 11 bad))
+ decode_open_channel wire @?= Left DecodeInvalidPoint
+ wire' <- unhex (cid_h ++ secret_h ++ bad)
+ decode_revoke_and_ack wire' @?= Left DecodeInvalidPoint
+ , testCase "amounts above 21M BTC" $ do
+ -- funding_satoshis of 21M BTC, then one satoshi more
+ ok <- unhex (concat (open_channel_fields 2 "000775f05a074000"))
+ bad <- unhex (concat (open_channel_fields 2 "000775f05a074001"))
+ assertBool "21M BTC" (either (const False) (const True)
+ (decode_open_channel ok))
+ decode_open_channel bad @?= Left DecodeInvalidAmount
+ htlc <- unhex (cid_h ++ "0000000000000000" ++ "1d24b2dfac520001"
+ ++ phash_h ++ "000c3550" ++ onion_h)
+ decode_update_add_htlc htlc @?= Left DecodeInvalidAmount
+ out <- unhex (cid_h ++ "0000000000000004" ++ "ffffffffffffffff"
+ ++ "0000")
+ decode_tx_add_output out @?= Left DecodeInvalidAmount
+ , testCase "stfu initiator byte" $ do
+ off <- unhex (cid_h ++ "00")
+ fmap stfu_initiator (decode_stfu off) @?= Right False
+ bad <- unhex (cid_h ++ "02")
+ decode_stfu bad @?= Left DecodeInvalidInitiator
+ , testCase "a list longer than its payload" $ do
+ wire <- unhex (cid_h ++ sig1_h ++ "0003" ++ sig2_h ++ sig3_h)
+ decode_commitment_signed wire @?= Left DecodeInsufficientBytes
+ wire' <- unhex (cid_h ++ txid_h ++ "0001" ++ "0004" ++ "0101")
+ decode_tx_signatures wire' @?= Left DecodeInsufficientBytes
+ , testCase "a short onion_routing_packet" $ do
+ wire <- unhex (concat (take 5 (lay_fixed update_add_htlc_lay))
+ ++ drop 2 onion_h)
+ decode_update_add_htlc wire @?= Left DecodeInsufficientBytes
+ ]
+ where
+ -- open_channel's fixed fields with field i replaced
+ open_channel_fields :: Int -> String -> [String]
+ open_channel_fields i v =
+ let fs = lay_fixed open_channel_lay
+ in take i fs ++ [v] ++ drop (i + 1) fs
+
+-- encoding failures ----------------------------------------------------------
+
+encoding_failures :: TestTree
+encoding_failures = testGroup "encoding failures" [
+ testCase "u16 length prefixes" $ do
+ cid <- just "cid" f_cid
+ let big = BS.replicate 65536 0x00
+ max_ok = BS.replicate 65535 0x00
+ encode_tx_add_input (TxAddInput cid (SerialId 0) big 0 0 empty)
+ @?= Left EncodeLengthOverflow
+ assertBool "65535-byte prevtx" $ either (const False) (const True)
+ (encode_tx_add_input (TxAddInput cid (SerialId 0) max_ok 0 0 empty))
+ encode_tx_abort (TxAbort cid big empty) @?= Left EncodeLengthOverflow
+ encode_update_fail_htlc
+ (UpdateFailHtlc cid (HtlcId 0) big Nothing empty)
+ @?= Left EncodeLengthOverflow
+ , testCase "u16 counts" $ do
+ cid <- just "cid" f_cid
+ s <- just "sig" (f_sig sig1_h)
+ t <- just "txid" f_txid
+ w <- just "witness" (witness "\x00")
+ encode_commitment_signed
+ (CommitmentSigned cid s (replicate 65536 s) Nothing empty)
+ @?= Left EncodeLengthOverflow
+ encode_tx_signatures (TxSignatures cid t (replicate 65536 w) empty)
+ @?= Left EncodeLengthOverflow
+ , testCase "_tlvs fields can't hold known types" $ do
+ cid <- just "cid" f_cid
+ pcp <- just "point" (f_point p1_h)
+ s <- just "sig" (f_sig sig1_h)
+ spk <- just "script" (f_script p2wpkh_h)
+ fee <- just "fee" (sat 500)
+ one <- just "tlvs" (BOLT1.tlv_stream [TlvRecord 1 "\x00"])
+ two <- just "tlvs" (BOLT1.tlv_stream [TlvRecord 2 ""])
+ odd' <- just "tlvs" (BOLT1.tlv_stream [TlvRecord 43 ""])
+ encode_channel_ready (ChannelReady cid pcp Nothing one)
+ @?= Left EncodeInvalidTlvs
+ encode_closing_complete
+ (ClosingComplete cid spk spk fee 0 (Just s) Nothing Nothing two)
+ @?= Left EncodeInvalidTlvs
+ encode_tx_ack_rbf (TxAckRbf cid Nothing False two)
+ @?= Left EncodeInvalidTlvs
+ assertBool "unknown odd records encode" $
+ either (const False) (const True)
+ (encode_channel_ready (ChannelReady cid pcp Nothing odd'))
+ , testCase "the message size limit" $ do
+ cid <- just "cid" f_cid
+ -- a 65533-byte payload fits; one more byte doesn't
+ let at n = TxAbort cid (BS.replicate n 0x00) empty
+ fmap BS.length (encode_message (MsgTxAbort (at 65499)))
+ @?= Right 65535
+ encode_message (MsgTxAbort (at 65500)) @?= Left EncodeMessageTooLarge
+ fmap BS.length (encode_tx_abort (at 65500)) @?= Right 65534
]
--- Reestablish Tests -----------------------------------------------------------
-
-reestablish_tests :: TestTree
-reestablish_tests = testGroup "Channel Reestablish" [
- testCase "encode/decode roundtrip" $ do
- let sec = fromJust $ perCommitmentSecret (BS.replicate 32 0x22)
- msg = ChannelReestablish
- { channelReestablishChannelId = testChannelId
- , channelReestablishNextCommitNum = 5
- , channelReestablishNextRevocationNum = 4
- , channelReestablishYourLastCommitSecret = sec
- , channelReestablishMyCurrentCommitPoint = testPoint
- , channelReestablishTlvs = emptyTlvs
- }
- encoded = encodeChannelReestablish msg
- case decodeChannelReestablish encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- , testCase "roundtrip with zero counters" $ do
- let sec = fromJust $ perCommitmentSecret (BS.replicate 32 0x00)
- msg = ChannelReestablish
- { channelReestablishChannelId = testChannelId
- , channelReestablishNextCommitNum = 1
- , channelReestablishNextRevocationNum = 0
- , channelReestablishYourLastCommitSecret = sec
- , channelReestablishMyCurrentCommitPoint = testPoint
- , channelReestablishTlvs = emptyTlvs
- }
- encoded = encodeChannelReestablish msg
- case decodeChannelReestablish encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
+-- field types ----------------------------------------------------------------
+
+field_types :: TestTree
+field_types = testGroup "field types" [
+ testCase "script_pubkey" $ do
+ fmap un_script_pubkey (script_pubkey (BS.replicate 65535 0x51))
+ @?= Just (BS.replicate 65535 0x51)
+ script_pubkey (BS.replicate 65536 0x51) @?= Nothing
+ , testCase "witness" $ do
+ fmap un_witness (witness "") @?= Just ""
+ witness (BS.replicate 65536 0x00) @?= Nothing
+ , testCase "onion_routing_packet" $ do
+ let bs = BS.replicate 1366 0x00
+ fmap un_onion_routing_packet (onion_routing_packet bs) @?= Just bs
+ onion_routing_packet (BS.take 1365 bs) @?= Nothing
+ onion_routing_packet (BS.cons 0x00 bs) @?= Nothing
+ , testCase "onion_hash" $ do
+ fmap un_onion_hash (onion_hash (BS.replicate 32 0x01))
+ @?= Just (BS.replicate 32 0x01)
+ onion_hash (BS.replicate 33 0x01) @?= Nothing
+ , testCase "attribution_data" $ do
+ let bs = BS.replicate 920 0x00
+ fmap un_attribution_data (attribution_data bs) @?= Just bs
+ attribution_data (BS.take 919 bs) @?= Nothing
+ , testCase "message types" $ do
+ cid <- just "cid" f_cid
+ message_type (MsgStfu (Stfu cid False empty)) @?= 2
+ message_type (MsgUpdateFee (UpdateFee cid 0 empty)) @?= 134
]
--- Error Condition Tests -------------------------------------------------------
-
-error_tests :: TestTree
-error_tests = testGroup "Error Conditions" [
- testGroup "Insufficient Bytes" [
- testCase "decodeOpenChannel empty" $ do
- case decodeOpenChannel BS.empty of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- , testCase "decodeOpenChannel too short" $ do
- case decodeOpenChannel (BS.replicate 100 0x00) of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- , testCase "decodeAcceptChannel too short" $ do
- case decodeAcceptChannel (BS.replicate 10 0x00) of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- , testCase "decodeFundingCreated too short" $ do
- case decodeFundingCreated (BS.replicate 50 0x00) of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- , testCase "decodeFundingSigned too short" $ do
- case decodeFundingSigned (BS.replicate 30 0x00) of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- , testCase "decodeChannelReady too short" $ do
- case decodeChannelReady (BS.replicate 32 0x00) of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- , testCase "decodeStfu too short" $ do
- case decodeStfu (BS.replicate 31 0x00) of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- , testCase "decodeShutdown too short" $ do
- case decodeShutdown (BS.replicate 32 0x00) of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- , testCase "decodeStfu invalid initiator byte" $ do
- -- channel_id (32 bytes) + initiator (1 byte, value 2)
- let encoded = BS.replicate 32 0xab <> BS.singleton 0x02
- case decodeStfu encoded of
- Left DecodeInvalidInitiator -> pure ()
- other -> assertFailure $
- "expected invalid initiator: " ++ show other
- , testCase "decodeUpdateAddHtlc too short" $ do
- case decodeUpdateAddHtlc (BS.replicate 100 0x00) of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- , testCase "decodeCommitmentSigned too short" $ do
- case decodeCommitmentSigned (BS.replicate 90 0x00) of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- , testCase "decodeRevokeAndAck too short" $ do
- case decodeRevokeAndAck (BS.replicate 60 0x00) of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- , testCase "decodeTxSignatures too short" $ do
- case decodeTxSignatures (BS.replicate 60 0x00) of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- ]
- , testGroup "EncodeError - Length Overflow" [
- testCase "encodeShutdown with oversized script" $ do
- let script = scriptPubKey (BS.replicate 70000 0x00)
- msg = Shutdown
- { shutdownChannelId = testChannelId
- , shutdownScriptPubkey = script
- }
- case encodeShutdown msg of
- Left EncodeLengthOverflow -> pure ()
- other -> assertFailure $ "expected overflow: " ++ show other
- , testCase "encodeClosingComplete with oversized closer script" $ do
- let oversizedScript = scriptPubKey (BS.replicate 70000 0x00)
- normalScript = scriptPubKey (BS.replicate 22 0x00)
- msg = ClosingComplete
- { closingCompleteChannelId = testChannelId
- , closingCompleteCloserScript = oversizedScript
- , closingCompleteCloseeScript = normalScript
- , closingCompleteFeeSatoshi = Satoshi 500
- , closingCompleteLocktime = 0
- , closingCompleteTlvs = emptyTlvs
- }
- case encodeClosingComplete msg of
- Left EncodeLengthOverflow -> pure ()
- other -> assertFailure $ "expected overflow: " ++ show other
- , testCase "encodeClosingComplete with oversized closee script" $ do
- let normalScript = scriptPubKey (BS.replicate 22 0x00)
- oversizedScript = scriptPubKey (BS.replicate 70000 0x00)
- msg = ClosingComplete
- { closingCompleteChannelId = testChannelId
- , closingCompleteCloserScript = normalScript
- , closingCompleteCloseeScript = oversizedScript
- , closingCompleteFeeSatoshi = Satoshi 500
- , closingCompleteLocktime = 0
- , closingCompleteTlvs = emptyTlvs
- }
- case encodeClosingComplete msg of
- Left EncodeLengthOverflow -> pure ()
- other -> assertFailure $ "expected overflow: " ++ show other
- , testCase "encodeClosingSig with oversized script" $ do
- let oversizedScript = scriptPubKey (BS.replicate 70000 0x00)
- normalScript = scriptPubKey (BS.replicate 22 0x00)
- msg = ClosingSig
- { closingSigChannelId = testChannelId
- , closingSigCloserScript = oversizedScript
- , closingSigCloseeScript = normalScript
- , closingSigFeeSatoshi = Satoshi 500
- , closingSigLocktime = 0
- , closingSigTlvs = emptyTlvs
- }
- case encodeClosingSig msg of
- Left EncodeLengthOverflow -> pure ()
- other -> assertFailure $ "expected overflow: " ++ show other
- ]
- , testGroup "Invalid Field Length" [
- testCase "decodeShutdown with invalid script length" $ do
- -- channel_id (32 bytes) + script length (2 bytes) claiming more
- let encoded = BS.replicate 32 0xab <>
- BS.pack [0xff, 0xff] <> -- claims 65535 bytes
- BS.replicate 10 0x00 -- only 10 bytes
- case decodeShutdown encoded of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- , testCase "decodeTxAddInput with invalid prevTx length" $ do
- -- channel_id (32) + serial_id (8) + len (2) claiming more
- let encoded = BS.replicate 32 0xab <>
- BS.replicate 8 0x00 <>
- BS.pack [0xff, 0xff] <> -- claims 65535 bytes
- BS.replicate 10 0x00 -- only 10 bytes
- case decodeTxAddInput encoded of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- , testCase "decodeUpdateFailHtlc with invalid reason length" $ do
- -- channel_id (32) + htlc_id (8) + len (2) claiming more
- let encoded = BS.replicate 32 0xab <>
- BS.replicate 8 0x00 <>
- BS.pack [0xff, 0xff] <> -- claims 65535 bytes
- BS.replicate 10 0x00 -- only 10 bytes
- case decodeUpdateFailHtlc encoded of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- ]
+-- generators -----------------------------------------------------------------
+
+gen_bytes :: Int -> Gen BS.ByteString
+gen_bytes n = BS.pack <$> vectorOf n arbitrary
+
+gen_var_bytes :: Int -> Gen BS.ByteString
+gen_var_bytes hi = choose (0, hi) >>= gen_bytes
+
+gen_cid :: Gen BOLT1.ChannelId
+gen_cid = gen_bytes 32 `suchThatMap` BOLT1.channel_id
+
+gen_chain :: Gen BOLT1.ChainHash
+gen_chain = gen_bytes 32 `suchThatMap` BOLT1.chain_hash
+
+gen_point :: Gen BOLT1.Point
+gen_point = do
+ p <- elements [0x02, 0x03]
+ (BS.cons p <$> gen_bytes 32) `suchThatMap` BOLT1.point
+
+gen_sig :: Gen BOLT1.Signature
+gen_sig = gen_bytes 64 `suchThatMap` BOLT1.signature
+
+gen_txid :: Gen Tx.TxId
+gen_txid = gen_bytes 32 `suchThatMap` Tx.mkTxId
+
+gen_secret :: Gen BOLT1.PerCommitmentSecret
+gen_secret = gen_bytes 32 `suchThatMap` BOLT1.per_commitment_secret
+
+gen_sat :: Gen BOLT1.Satoshi
+gen_sat = choose (0, 2100000000000000) `suchThatMap` BOLT1.satoshi
+
+gen_msat :: Gen BOLT1.MilliSatoshi
+gen_msat = choose (0, 2100000000000000000) `suchThatMap` BOLT1.milli_satoshi
+
+gen_script :: Gen ScriptPubKey
+gen_script = gen_var_bytes 40 `suchThatMap` script_pubkey
+
+gen_fv :: Gen BOLT9.FeatureVector
+gen_fv = BOLT9.parse <$> gen_var_bytes 8
+
+gen_maybe :: Gen a -> Gen (Maybe a)
+gen_maybe g = oneof [pure Nothing, Just <$> g]
+
+-- unknown odd records, avoiding a message's known types
+gen_tlvs :: [Word64] -> Gen BOLT1.TlvStream
+gen_tlvs known = do
+ ts <- sublistOf (filter (`notElem` known) candidates)
+ rs <- traverse (\t -> TlvRecord t <$> gen_var_bytes 12) ts
+ pure (maybe empty id (BOLT1.tlv_stream rs))
+ where
+ candidates = [1, 3, 5, 7, 43, 201, 253, 65537, 4294967297]
+
+gen_open_channel :: Gen OpenChannel
+gen_open_channel = OpenChannel <$> gen_chain <*> gen_cid <*> gen_sat
+ <*> gen_msat <*> gen_sat <*> arbitrary <*> gen_sat <*> gen_msat
+ <*> arbitrary <*> arbitrary <*> arbitrary <*> gen_point <*> gen_point
+ <*> gen_point <*> gen_point <*> gen_point <*> gen_point <*> arbitrary
+ <*> gen_maybe gen_script <*> gen_maybe gen_fv <*> gen_tlvs [0, 1]
+
+gen_accept_channel :: Gen AcceptChannel
+gen_accept_channel = AcceptChannel <$> gen_cid <*> gen_sat <*> arbitrary
+ <*> gen_sat <*> gen_msat <*> arbitrary <*> arbitrary <*> arbitrary
+ <*> gen_point <*> gen_point <*> gen_point <*> gen_point <*> gen_point
+ <*> gen_point <*> gen_maybe gen_script <*> gen_maybe gen_fv
+ <*> gen_tlvs [0, 1]
+
+gen_funding_created :: Gen FundingCreated
+gen_funding_created = FundingCreated <$> gen_cid <*> gen_txid <*> arbitrary
+ <*> gen_sig <*> gen_tlvs []
+
+gen_funding_signed :: Gen FundingSigned
+gen_funding_signed = FundingSigned <$> gen_cid <*> gen_sig <*> gen_tlvs []
+
+gen_channel_ready :: Gen ChannelReady
+gen_channel_ready = ChannelReady <$> gen_cid <*> gen_point
+ <*> gen_maybe (BOLT1.ShortChannelId <$> arbitrary) <*> gen_tlvs [1]
+
+gen_open_channel2 :: Gen OpenChannel2
+gen_open_channel2 = OpenChannel2 <$> gen_chain <*> gen_cid <*> arbitrary
+ <*> arbitrary <*> gen_sat <*> gen_sat <*> arbitrary <*> gen_msat
+ <*> arbitrary <*> arbitrary <*> arbitrary <*> gen_point <*> gen_point
+ <*> gen_point <*> gen_point <*> gen_point <*> gen_point <*> gen_point
+ <*> arbitrary <*> gen_maybe gen_script <*> gen_maybe gen_fv
+ <*> arbitrary <*> gen_tlvs [0, 1, 2]
+
+gen_accept_channel2 :: Gen AcceptChannel2
+gen_accept_channel2 = AcceptChannel2 <$> gen_cid <*> gen_sat <*> gen_sat
+ <*> arbitrary <*> gen_msat <*> arbitrary <*> arbitrary <*> arbitrary
+ <*> gen_point <*> gen_point <*> gen_point <*> gen_point <*> gen_point
+ <*> gen_point <*> gen_point <*> gen_maybe gen_script
+ <*> gen_maybe gen_fv <*> arbitrary <*> gen_tlvs [0, 1, 2]
+
+gen_tx_add_input :: Gen TxAddInput
+gen_tx_add_input = TxAddInput <$> gen_cid <*> (SerialId <$> arbitrary)
+ <*> gen_var_bytes 64 <*> arbitrary <*> arbitrary <*> gen_tlvs []
+
+gen_tx_add_output :: Gen TxAddOutput
+gen_tx_add_output = TxAddOutput <$> gen_cid <*> (SerialId <$> arbitrary)
+ <*> gen_sat <*> gen_script <*> gen_tlvs []
+
+gen_tx_remove_input :: Gen TxRemoveInput
+gen_tx_remove_input = TxRemoveInput <$> gen_cid <*> (SerialId <$> arbitrary)
+ <*> gen_tlvs []
+
+gen_tx_remove_output :: Gen TxRemoveOutput
+gen_tx_remove_output = TxRemoveOutput <$> gen_cid
+ <*> (SerialId <$> arbitrary) <*> gen_tlvs []
+
+gen_tx_complete :: Gen TxComplete
+gen_tx_complete = TxComplete <$> gen_cid <*> gen_tlvs []
+
+gen_tx_signatures :: Gen TxSignatures
+gen_tx_signatures = TxSignatures <$> gen_cid <*> gen_txid
+ <*> listOf (gen_var_bytes 32 `suchThatMap` witness) <*> gen_tlvs []
+
+gen_tx_init_rbf :: Gen TxInitRbf
+gen_tx_init_rbf = TxInitRbf <$> gen_cid <*> arbitrary <*> arbitrary
+ <*> gen_maybe (arbitrary :: Gen Int64) <*> arbitrary <*> gen_tlvs [0, 2]
+
+gen_tx_ack_rbf :: Gen TxAckRbf
+gen_tx_ack_rbf = TxAckRbf <$> gen_cid <*> gen_maybe arbitrary <*> arbitrary
+ <*> gen_tlvs [0, 2]
+
+gen_tx_abort :: Gen TxAbort
+gen_tx_abort = TxAbort <$> gen_cid <*> gen_var_bytes 64 <*> gen_tlvs []
+
+gen_stfu :: Gen Stfu
+gen_stfu = Stfu <$> gen_cid <*> arbitrary <*> gen_tlvs []
+
+gen_shutdown :: Gen Shutdown
+gen_shutdown = Shutdown <$> gen_cid <*> gen_script <*> gen_tlvs []
+
+gen_closing_complete :: Gen ClosingComplete
+gen_closing_complete = ClosingComplete <$> gen_cid <*> gen_script
+ <*> gen_script <*> gen_sat <*> arbitrary <*> gen_maybe gen_sig
+ <*> gen_maybe gen_sig <*> gen_maybe gen_sig <*> gen_tlvs [1, 2, 3]
+
+gen_closing_sig :: Gen ClosingSig
+gen_closing_sig = ClosingSig <$> gen_cid <*> gen_script <*> gen_script
+ <*> gen_sat <*> arbitrary <*> gen_maybe gen_sig <*> gen_maybe gen_sig
+ <*> gen_maybe gen_sig <*> gen_tlvs [1, 2, 3]
+
+gen_closing_signed :: Gen ClosingSigned
+gen_closing_signed = ClosingSigned <$> gen_cid <*> gen_sat <*> gen_sig
+ <*> gen_maybe (FeeRange <$> gen_sat <*> gen_sat) <*> gen_tlvs [1]
+
+gen_update_add_htlc :: Gen UpdateAddHtlc
+gen_update_add_htlc = UpdateAddHtlc <$> gen_cid <*> (HtlcId <$> arbitrary)
+ <*> gen_msat
+ <*> (gen_bytes 32 `suchThatMap` BOLT1.payment_hash)
+ <*> arbitrary
+ <*> (gen_bytes 1366 `suchThatMap` onion_routing_packet)
+ <*> gen_maybe gen_point <*> gen_tlvs [0]
+
+gen_update_fulfill_htlc :: Gen UpdateFulfillHtlc
+gen_update_fulfill_htlc = UpdateFulfillHtlc <$> gen_cid
+ <*> (HtlcId <$> arbitrary)
+ <*> (gen_bytes 32 `suchThatMap` BOLT1.payment_preimage)
+ <*> gen_maybe (gen_bytes 920 `suchThatMap` attribution_data)
+ <*> gen_maybe (gen_var_bytes 64) <*> gen_tlvs [1, 3]
+
+gen_update_fail_htlc :: Gen UpdateFailHtlc
+gen_update_fail_htlc = UpdateFailHtlc <$> gen_cid <*> (HtlcId <$> arbitrary)
+ <*> gen_var_bytes 300
+ <*> gen_maybe (gen_bytes 920 `suchThatMap` attribution_data)
+ <*> gen_tlvs [1]
+
+gen_update_fail_malformed_htlc :: Gen UpdateFailMalformedHtlc
+gen_update_fail_malformed_htlc = UpdateFailMalformedHtlc <$> gen_cid
+ <*> (HtlcId <$> arbitrary)
+ <*> (gen_bytes 32 `suchThatMap` onion_hash)
+ <*> arbitrary <*> gen_tlvs []
+
+gen_commitment_signed :: Gen CommitmentSigned
+gen_commitment_signed = CommitmentSigned <$> gen_cid <*> gen_sig
+ <*> listOf gen_sig <*> gen_maybe gen_txid <*> gen_tlvs [1]
+
+gen_revoke_and_ack :: Gen RevokeAndAck
+gen_revoke_and_ack = RevokeAndAck <$> gen_cid <*> gen_secret <*> gen_point
+ <*> gen_tlvs []
+
+gen_update_fee :: Gen UpdateFee
+gen_update_fee = UpdateFee <$> gen_cid <*> arbitrary <*> gen_tlvs []
+
+gen_channel_reestablish :: Gen ChannelReestablish
+gen_channel_reestablish = ChannelReestablish <$> gen_cid <*> arbitrary
+ <*> arbitrary <*> gen_secret <*> gen_point
+ <*> gen_maybe (NextFunding <$> gen_txid <*> arbitrary) <*> gen_tlvs [1]
+
+gen_message :: Gen Message
+gen_message = oneof [
+ MsgOpenChannel <$> gen_open_channel
+ , MsgAcceptChannel <$> gen_accept_channel
+ , MsgFundingCreated <$> gen_funding_created
+ , MsgFundingSigned <$> gen_funding_signed
+ , MsgChannelReady <$> gen_channel_ready
+ , MsgOpenChannel2 <$> gen_open_channel2
+ , MsgAcceptChannel2 <$> gen_accept_channel2
+ , MsgTxAddInput <$> gen_tx_add_input
+ , MsgTxAddOutput <$> gen_tx_add_output
+ , MsgTxRemoveInput <$> gen_tx_remove_input
+ , MsgTxRemoveOutput <$> gen_tx_remove_output
+ , MsgTxComplete <$> gen_tx_complete
+ , MsgTxSignatures <$> gen_tx_signatures
+ , MsgTxInitRbf <$> gen_tx_init_rbf
+ , MsgTxAckRbf <$> gen_tx_ack_rbf
+ , MsgTxAbort <$> gen_tx_abort
+ , MsgStfu <$> gen_stfu
+ , MsgShutdown <$> gen_shutdown
+ , MsgClosingComplete <$> gen_closing_complete
+ , MsgClosingSig <$> gen_closing_sig
+ , MsgClosingSigned <$> gen_closing_signed
+ , MsgUpdateAddHtlc <$> gen_update_add_htlc
+ , MsgUpdateFulfillHtlc <$> gen_update_fulfill_htlc
+ , MsgUpdateFailHtlc <$> gen_update_fail_htlc
+ , MsgUpdateFailMalformedHtlc <$> gen_update_fail_malformed_htlc
+ , MsgCommitmentSigned <$> gen_commitment_signed
+ , MsgRevokeAndAck <$> gen_revoke_and_ack
+ , MsgUpdateFee <$> gen_update_fee
+ , MsgChannelReestablish <$> gen_channel_reestablish
]
--- Property Tests --------------------------------------------------------------
-
-property_tests :: TestTree
-property_tests = testGroup "Properties" [
- testProperty "OpenChannel roundtrip" propOpenChannelRoundtrip
- , testProperty "AcceptChannel roundtrip" propAcceptChannelRoundtrip
- , testProperty "FundingCreated roundtrip" propFundingCreatedRoundtrip
- , testProperty "FundingSigned roundtrip" propFundingSignedRoundtrip
- , testProperty "ChannelReady roundtrip" propChannelReadyRoundtrip
- , testProperty "OpenChannel2 roundtrip" propOpenChannel2Roundtrip
- , testProperty "AcceptChannel2 roundtrip" propAcceptChannel2Roundtrip
- , testProperty "TxAddInput roundtrip" propTxAddInputRoundtrip
- , testProperty "TxAddOutput roundtrip" propTxAddOutputRoundtrip
- , testProperty "TxRemoveInput roundtrip" propTxRemoveInputRoundtrip
- , testProperty "TxRemoveOutput roundtrip" propTxRemoveOutputRoundtrip
- , testProperty "TxComplete roundtrip" propTxCompleteRoundtrip
- , testProperty "TxSignatures roundtrip" propTxSignaturesRoundtrip
- , testProperty "TxInitRbf roundtrip" propTxInitRbfRoundtrip
- , testProperty "TxAckRbf roundtrip" propTxAckRbfRoundtrip
- , testProperty "TxAbort roundtrip" propTxAbortRoundtrip
- , testProperty "Stfu roundtrip" propStfuRoundtrip
- , testProperty "Shutdown roundtrip" propShutdownRoundtrip
- , testProperty "ClosingSigned roundtrip" propClosingSignedRoundtrip
- , testProperty "ClosingComplete roundtrip" propClosingCompleteRoundtrip
- , testProperty "ClosingSig roundtrip" propClosingSigRoundtrip
- , testProperty "UpdateAddHtlc roundtrip" propUpdateAddHtlcRoundtrip
- , testProperty "UpdateFulfillHtlc roundtrip" propUpdateFulfillHtlcRoundtrip
- , testProperty "UpdateFailHtlc roundtrip" propUpdateFailHtlcRoundtrip
- , testProperty "UpdateFailMalformedHtlc roundtrip"
- propUpdateFailMalformedHtlcRoundtrip
- , testProperty "CommitmentSigned roundtrip" propCommitmentSignedRoundtrip
- , testProperty "RevokeAndAck roundtrip" propRevokeAndAckRoundtrip
- , testProperty "UpdateFee roundtrip" propUpdateFeeRoundtrip
- , testProperty "ChannelReestablish roundtrip" propChannelReestablishRoundtrip
- , testProperty "HtlcId wrap/unwrap" propHtlcIdRoundtrip
- , testProperty "SerialId wrap/unwrap" propSerialIdRoundtrip
- , testProperty "OnionPacket validates length" propOnionPacketLength
- , testProperty "TxId validates length" propTxIdLength
+-- properties -----------------------------------------------------------------
+
+-- decoding an encoded payload gives back the value
+roundtrip
+ :: (Eq a, Show a)
+ => String
+ -> Gen a
+ -> (a -> Either EncodeError BS.ByteString)
+ -> (BS.ByteString -> Either DecodeError a)
+ -> TestTree
+roundtrip name gen enc dec = testProperty name $ forAll gen $ \m ->
+ case enc m of
+ Left e -> counterexample ("encode failed: " ++ show e) False
+ Right w -> dec w === Right m
+
+-- byte strings derived from a valid encoding
+data Edit = Replace !Int !Word8 | Truncate !Int | Append !BS.ByteString
+ deriving Show
+
+gen_edit :: Gen Edit
+gen_edit = oneof [
+ Replace <$> arbitrary <*> arbitrary
+ , Truncate <$> arbitrary
+ , Append <$> gen_var_bytes 8
]
--- Property: OpenChannel roundtrip
-propOpenChannelRoundtrip :: Property
-propOpenChannelRoundtrip = property $ do
- let msg = OpenChannel
- { openChannelChainHash = testChainHash
- , openChannelTempChannelId = testChannelId
- , openChannelFundingSatoshi = Satoshi 1000000
- , openChannelPushMsat = MilliSatoshi 500000
- , openChannelDustLimitSatoshi = Satoshi 546
- , openChannelMaxHtlcValueInFlight = MilliSatoshi 100000000
- , openChannelChannelReserveSat = Satoshi 10000
- , openChannelHtlcMinimumMsat = MilliSatoshi 1000
- , openChannelFeeratePerKw = 2500
- , openChannelToSelfDelay = 144
- , openChannelMaxAcceptedHtlcs = 483
- , openChannelFundingPubkey = testPoint
- , openChannelRevocationBasepoint = testPoint
- , openChannelPaymentBasepoint = testPoint
- , openChannelDelayedPaymentBase = testPoint
- , openChannelHtlcBasepoint = testPoint
- , openChannelFirstPerCommitPoint = testPoint
- , openChannelChannelFlags = 0x01
- , openChannelTlvs = emptyTlvs
- }
- encoded = encodeOpenChannel msg
- case decodeOpenChannel encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: AcceptChannel roundtrip
-propAcceptChannelRoundtrip :: Property
-propAcceptChannelRoundtrip = property $ do
- let msg = AcceptChannel
- { acceptChannelTempChannelId = testChannelId
- , acceptChannelDustLimitSatoshi = Satoshi 546
- , acceptChannelMaxHtlcValueInFlight = MilliSatoshi 100000000
- , acceptChannelChannelReserveSat = Satoshi 10000
- , acceptChannelHtlcMinimumMsat = MilliSatoshi 1000
- , acceptChannelMinimumDepth = 3
- , acceptChannelToSelfDelay = 144
- , acceptChannelMaxAcceptedHtlcs = 483
- , acceptChannelFundingPubkey = testPoint
- , acceptChannelRevocationBasepoint = testPoint
- , acceptChannelPaymentBasepoint = testPoint
- , acceptChannelDelayedPaymentBase = testPoint
- , acceptChannelHtlcBasepoint = testPoint
- , acceptChannelFirstPerCommitPoint = testPoint
- , acceptChannelTlvs = emptyTlvs
- }
- encoded = encodeAcceptChannel msg
- case decodeAcceptChannel encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: FundingCreated roundtrip
-propFundingCreatedRoundtrip :: Word16 -> Property
-propFundingCreatedRoundtrip outIdx = property $ do
- let msg = FundingCreated
- { fundingCreatedTempChannelId = testChannelId
- , fundingCreatedFundingTxid = testTxId
- , fundingCreatedFundingOutIdx = outIdx
- , fundingCreatedSignature = testSignature
- }
- encoded = encodeFundingCreated msg
- case decodeFundingCreated encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: FundingSigned roundtrip
-propFundingSignedRoundtrip :: Property
-propFundingSignedRoundtrip = property $ do
- let msg = FundingSigned
- { fundingSignedChannelId = testChannelId
- , fundingSignedSignature = testSignature
- }
- encoded = encodeFundingSigned msg
- case decodeFundingSigned encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: ChannelReady roundtrip
-propChannelReadyRoundtrip :: Property
-propChannelReadyRoundtrip = property $ do
- let msg = ChannelReady
- { channelReadyChannelId = testChannelId
- , channelReadySecondPerCommitPoint = testPoint
- , channelReadyTlvs = emptyTlvs
- }
- encoded = encodeChannelReady msg
- case decodeChannelReady encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: OpenChannel2 roundtrip
-propOpenChannel2Roundtrip :: Property
-propOpenChannel2Roundtrip = property $ do
- let msg = OpenChannel2
- { openChannel2ChainHash = testChainHash
- , openChannel2TempChannelId = testChannelId
- , openChannel2FundingFeeratePerkw = 2500
- , openChannel2CommitFeeratePerkw = 2000
- , openChannel2FundingSatoshi = Satoshi 1000000
- , openChannel2DustLimitSatoshi = Satoshi 546
- , openChannel2MaxHtlcValueInFlight = MilliSatoshi 100000000
- , openChannel2HtlcMinimumMsat = MilliSatoshi 1000
- , openChannel2ToSelfDelay = 144
- , openChannel2MaxAcceptedHtlcs = 483
- , openChannel2Locktime = 0
- , openChannel2FundingPubkey = testPoint
- , openChannel2RevocationBasepoint = testPoint
- , openChannel2PaymentBasepoint = testPoint
- , openChannel2DelayedPaymentBase = testPoint
- , openChannel2HtlcBasepoint = testPoint
- , openChannel2FirstPerCommitPoint = testPoint
- , openChannel2SecondPerCommitPoint = testPoint2
- , openChannel2ChannelFlags = 0x00
- , openChannel2Tlvs = emptyTlvs
- }
- encoded = encodeOpenChannel2 msg
- case decodeOpenChannel2 encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: AcceptChannel2 roundtrip
-propAcceptChannel2Roundtrip :: Property
-propAcceptChannel2Roundtrip = property $ do
- let msg = AcceptChannel2
- { acceptChannel2TempChannelId = testChannelId
- , acceptChannel2FundingSatoshi = Satoshi 500000
- , acceptChannel2DustLimitSatoshi = Satoshi 546
- , acceptChannel2MaxHtlcValueInFlight = MilliSatoshi 100000000
- , acceptChannel2HtlcMinimumMsat = MilliSatoshi 1000
- , acceptChannel2MinimumDepth = 3
- , acceptChannel2ToSelfDelay = 144
- , acceptChannel2MaxAcceptedHtlcs = 483
- , acceptChannel2FundingPubkey = testPoint
- , acceptChannel2RevocationBasepoint = testPoint
- , acceptChannel2PaymentBasepoint = testPoint
- , acceptChannel2DelayedPaymentBase = testPoint
- , acceptChannel2HtlcBasepoint = testPoint
- , acceptChannel2FirstPerCommitPoint = testPoint
- , acceptChannel2SecondPerCommitPoint = testPoint2
- , acceptChannel2Tlvs = emptyTlvs
- }
- encoded = encodeAcceptChannel2 msg
- case decodeAcceptChannel2 encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: TxAddInput roundtrip with varying data
-propTxAddInputRoundtrip :: [Word8] -> Word32 -> Word32 -> Property
-propTxAddInputRoundtrip prevTxBytes vout seqNum = property $ do
- let prevTx = BS.pack (take 1000 prevTxBytes) -- limit size
- msg = TxAddInput
- { txAddInputChannelId = testChannelId
- , txAddInputSerialId = serialId 12345
- , txAddInputPrevTx = prevTx
- , txAddInputPrevVout = vout
- , txAddInputSequence = seqNum
- }
- 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
-propTxAddOutputRoundtrip sats scriptBytes = property $ do
- let script = scriptPubKey (BS.pack (take 100 scriptBytes))
- msg = TxAddOutput
- { txAddOutputChannelId = testChannelId
- , txAddOutputSerialId = serialId 54321
- , txAddOutputSats = Satoshi sats
- , txAddOutputScript = script
- }
- case encodeTxAddOutput msg of
- Left _ -> False
- Right encoded -> case decodeTxAddOutput encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: TxRemoveInput roundtrip
-propTxRemoveInputRoundtrip :: Word64 -> Property
-propTxRemoveInputRoundtrip sid = property $ do
- let msg = TxRemoveInput
- { txRemoveInputChannelId = testChannelId
- , txRemoveInputSerialId = serialId sid
- }
- encoded = encodeTxRemoveInput msg
- case decodeTxRemoveInput encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: TxRemoveOutput roundtrip
-propTxRemoveOutputRoundtrip :: Word64 -> Property
-propTxRemoveOutputRoundtrip sid = property $ do
- let msg = TxRemoveOutput
- { txRemoveOutputChannelId = testChannelId
- , txRemoveOutputSerialId = serialId sid
- }
- encoded = encodeTxRemoveOutput msg
- case decodeTxRemoveOutput encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: TxComplete roundtrip
-propTxCompleteRoundtrip :: Property
-propTxCompleteRoundtrip = property $ do
- let msg = TxComplete { txCompleteChannelId = testChannelId }
- encoded = encodeTxComplete msg
- case decodeTxComplete encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: TxSignatures roundtrip with varying witnesses
-propTxSignaturesRoundtrip :: [[Word8]] -> Property
-propTxSignaturesRoundtrip witnessList = property $ do
- let wits = map (Witness . BS.pack . take 200) (take 10 witnessList)
- msg = TxSignatures
- { txSignaturesChannelId = testChannelId
- , txSignaturesTxid = testTxId
- , txSignaturesWitnesses = wits
- }
- 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
-propTxInitRbfRoundtrip locktime feerate = property $ do
- let msg = TxInitRbf
- { txInitRbfChannelId = testChannelId
- , txInitRbfLocktime = locktime
- , txInitRbfFeerate = feerate
- , txInitRbfTlvs = emptyTlvs
- }
- encoded = encodeTxInitRbf msg
- case decodeTxInitRbf encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: TxAckRbf roundtrip
-propTxAckRbfRoundtrip :: Property
-propTxAckRbfRoundtrip = property $ do
- let msg = TxAckRbf
- { txAckRbfChannelId = testChannelId
- , txAckRbfTlvs = emptyTlvs
- }
- encoded = encodeTxAckRbf msg
- case decodeTxAckRbf encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: TxAbort roundtrip
-propTxAbortRoundtrip :: [Word8] -> Property
-propTxAbortRoundtrip dataBytes = property $ do
- let abortData = BS.pack (take 1000 dataBytes)
- msg = TxAbort
- { txAbortChannelId = testChannelId
- , txAbortData = abortData
- }
- case encodeTxAbort msg of
- Left _ -> False
- Right encoded -> case decodeTxAbort encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: Stfu roundtrip
-propStfuRoundtrip :: Bool -> Property
-propStfuRoundtrip isInit = property $ do
- let ini = if isInit then IsInitiator else NotInitiator
- msg = Stfu
- { stfuChannelId = testChannelId
- , stfuInitiator = ini
- }
- encoded = encodeStfu msg
- case decodeStfu encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: Shutdown roundtrip
-propShutdownRoundtrip :: [Word8] -> Property
-propShutdownRoundtrip scriptBytes = property $ do
- let script = scriptPubKey (BS.pack (take 100 scriptBytes))
- msg = Shutdown
- { shutdownChannelId = testChannelId
- , shutdownScriptPubkey = script
- }
- case encodeShutdown msg of
- Left _ -> False
- Right encoded -> case decodeShutdown encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: ClosingSigned roundtrip
-propClosingSignedRoundtrip :: Word64 -> Property
-propClosingSignedRoundtrip feeSats = property $ do
- let msg = ClosingSigned
- { closingSignedChannelId = testChannelId
- , closingSignedFeeSatoshi = Satoshi feeSats
- , closingSignedSignature = testSignature
- , closingSignedTlvs = emptyTlvs
- }
- encoded = encodeClosingSigned msg
- case decodeClosingSigned encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: ClosingComplete roundtrip
-propClosingCompleteRoundtrip :: Word64 -> Word32 -> Property
-propClosingCompleteRoundtrip feeSats locktime = property $ do
- let closerScript = scriptPubKey (BS.pack [0x00, 0x14] <>
- BS.replicate 20 0xcc)
- closeeScript = scriptPubKey (BS.pack [0x00, 0x14] <>
- BS.replicate 20 0xdd)
- msg = ClosingComplete
- { closingCompleteChannelId = testChannelId
- , closingCompleteCloserScript = closerScript
- , closingCompleteCloseeScript = closeeScript
- , closingCompleteFeeSatoshi = Satoshi feeSats
- , closingCompleteLocktime = locktime
- , closingCompleteTlvs = emptyTlvs
- }
- case encodeClosingComplete msg of
- Left _ -> False
- Right encoded -> case decodeClosingComplete encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: ClosingSig roundtrip
-propClosingSigRoundtrip :: Word64 -> Word32 -> Property
-propClosingSigRoundtrip feeSats locktime = property $ do
- let closerScript = scriptPubKey (BS.pack [0x00, 0x14] <>
- BS.replicate 20 0xee)
- closeeScript = scriptPubKey (BS.pack [0x00, 0x14] <>
- BS.replicate 20 0xff)
- msg = ClosingSig
- { closingSigChannelId = testChannelId
- , closingSigCloserScript = closerScript
- , closingSigCloseeScript = closeeScript
- , closingSigFeeSatoshi = Satoshi feeSats
- , closingSigLocktime = locktime
- , closingSigTlvs = emptyTlvs
- }
- case encodeClosingSig msg of
- Left _ -> False
- Right encoded -> case decodeClosingSig encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: UpdateAddHtlc roundtrip
-propUpdateAddHtlcRoundtrip :: Word64 -> Word64 -> Word32 -> Property
-propUpdateAddHtlcRoundtrip hid amountMsat cltvExpiry = property $ do
- let msg = UpdateAddHtlc
- { updateAddHtlcChannelId = testChannelId
- , updateAddHtlcId = htlcId hid
- , updateAddHtlcAmountMsat = MilliSatoshi amountMsat
- , updateAddHtlcPaymentHash = testPaymentHash
- , updateAddHtlcCltvExpiry = cltvExpiry
- , updateAddHtlcOnionPacket = testOnionPacket
- , updateAddHtlcTlvs = emptyTlvs
- }
- encoded = encodeUpdateAddHtlc msg
- case decodeUpdateAddHtlc encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: UpdateFulfillHtlc roundtrip
-propUpdateFulfillHtlcRoundtrip :: Word64 -> Property
-propUpdateFulfillHtlcRoundtrip hid = property $ do
- let msg = UpdateFulfillHtlc
- { updateFulfillHtlcChannelId = testChannelId
- , updateFulfillHtlcId = htlcId hid
- , updateFulfillHtlcPaymentPreimage = testPaymentPreimage
- , updateFulfillHtlcTlvs = emptyTlvs
- }
- encoded = encodeUpdateFulfillHtlc msg
- case decodeUpdateFulfillHtlc encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: UpdateFailHtlc roundtrip
-propUpdateFailHtlcRoundtrip :: Word64 -> [Word8] -> Property
-propUpdateFailHtlcRoundtrip hid reasonBytes = property $ do
- let failReason = BS.pack (take 1000 reasonBytes)
- msg = UpdateFailHtlc
- { updateFailHtlcChannelId = testChannelId
- , updateFailHtlcId = htlcId hid
- , updateFailHtlcReason = failReason
- , updateFailHtlcTlvs = emptyTlvs
- }
- 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
-propUpdateFailMalformedHtlcRoundtrip hid failCode = property $ do
- let msg = UpdateFailMalformedHtlc
- { updateFailMalformedHtlcChannelId = testChannelId
- , updateFailMalformedHtlcId = htlcId hid
- , updateFailMalformedHtlcSha256Onion = testPaymentHash
- , updateFailMalformedHtlcFailureCode = failCode
- }
- encoded = encodeUpdateFailMalformedHtlc msg
- case decodeUpdateFailMalformedHtlc encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: CommitmentSigned roundtrip with varying HTLC count
-propCommitmentSignedRoundtrip :: NonNegative Int -> Property
-propCommitmentSignedRoundtrip (NonNegative n) = property $ do
- let numHtlcs = n `mod` 10 -- limit to 10 HTLCs for test speed
- htlcSigs = replicate numHtlcs testSignature
- msg = CommitmentSigned
- { commitmentSignedChannelId = testChannelId
- , commitmentSignedSignature = testSignature
- , commitmentSignedHtlcSignatures = htlcSigs
- }
- 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 = testSecret
- , revokeAndAckNextPerCommitPoint = testPoint
- }
- encoded = encodeRevokeAndAck msg
- case decodeRevokeAndAck encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: UpdateFee roundtrip
-propUpdateFeeRoundtrip :: Word32 -> Property
-propUpdateFeeRoundtrip feerate = property $ do
- let msg = UpdateFee
- { updateFeeChannelId = testChannelId
- , updateFeeFeeratePerKw = feerate
- }
- encoded = encodeUpdateFee msg
- case decodeUpdateFee encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: ChannelReestablish roundtrip
-propChannelReestablishRoundtrip :: Word64 -> Word64 -> Property
-propChannelReestablishRoundtrip nextCommit nextRevoke = property $ do
- let sec = fromJust $ perCommitmentSecret (BS.replicate 32 0x22)
- msg = ChannelReestablish
- { channelReestablishChannelId = testChannelId
- , channelReestablishNextCommitNum = nextCommit
- , channelReestablishNextRevocationNum = nextRevoke
- , channelReestablishYourLastCommitSecret = sec
- , channelReestablishMyCurrentCommitPoint = testPoint
- , channelReestablishTlvs = emptyTlvs
- }
- encoded = encodeChannelReestablish msg
- case decodeChannelReestablish encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: HtlcId wrap/unwrap
-propHtlcIdRoundtrip :: Word64 -> Property
-propHtlcIdRoundtrip w = property $ unHtlcId (htlcId w) == w
-
--- Property: SerialId wrap/unwrap
-propSerialIdRoundtrip :: Word64 -> Property
-propSerialIdRoundtrip w = property $ unSerialId (serialId w) == w
-
--- Property: OnionPacket validates length (1366 only)
-propOnionPacketLength :: NonNegative Int -> Property
-propOnionPacketLength (NonNegative n) = property $
- let len = n `mod` 2000
- bs = BS.replicate len 0x00
- in case onionPacket bs of
- Just _ -> len == onionPacketLen
- Nothing -> len /= onionPacketLen
-
--- Property: TxId validates length (32 only)
-propTxIdLength :: NonNegative Int -> Property
-propTxIdLength (NonNegative n) = property $
- let len = n `mod` 100
- bs = BS.replicate len 0x00
- in case mkTxId bs of
- Just _ -> len == 32
- Nothing -> len /= 32
-
--- Helpers ---------------------------------------------------------------------
-
--- | Decode hex string. Returns Nothing on invalid hex.
-unhex :: BS.ByteString -> Maybe BS.ByteString
-unhex = B16.decode
+apply_edit :: Edit -> BS.ByteString -> BS.ByteString
+apply_edit e bs = case e of
+ Replace i b
+ | BS.null bs -> bs
+ | otherwise ->
+ let j = i `mod` BS.length bs
+ in BS.take j bs <> BS.singleton b <> BS.drop (j + 1) bs
+ Truncate i
+ | BS.null bs -> bs
+ | otherwise -> BS.take (i `mod` BS.length bs) bs
+ Append x -> bs <> x
+
+properties :: TestTree
+properties = testGroup "properties" [
+ testGroup "payloads round-trip" [
+ roundtrip "open_channel" gen_open_channel
+ encode_open_channel decode_open_channel
+ , roundtrip "accept_channel" gen_accept_channel
+ encode_accept_channel decode_accept_channel
+ , roundtrip "funding_created" gen_funding_created
+ (Right . encode_funding_created) decode_funding_created
+ , roundtrip "funding_signed" gen_funding_signed
+ (Right . encode_funding_signed) decode_funding_signed
+ , roundtrip "channel_ready" gen_channel_ready
+ encode_channel_ready decode_channel_ready
+ , roundtrip "open_channel2" gen_open_channel2
+ encode_open_channel2 decode_open_channel2
+ , roundtrip "accept_channel2" gen_accept_channel2
+ encode_accept_channel2 decode_accept_channel2
+ , roundtrip "tx_add_input" gen_tx_add_input
+ encode_tx_add_input decode_tx_add_input
+ , roundtrip "tx_add_output" gen_tx_add_output
+ (Right . encode_tx_add_output) decode_tx_add_output
+ , roundtrip "tx_remove_input" gen_tx_remove_input
+ (Right . encode_tx_remove_input) decode_tx_remove_input
+ , roundtrip "tx_remove_output" gen_tx_remove_output
+ (Right . encode_tx_remove_output) decode_tx_remove_output
+ , roundtrip "tx_complete" gen_tx_complete
+ (Right . encode_tx_complete) decode_tx_complete
+ , roundtrip "tx_signatures" gen_tx_signatures
+ encode_tx_signatures decode_tx_signatures
+ , roundtrip "tx_init_rbf" gen_tx_init_rbf
+ encode_tx_init_rbf decode_tx_init_rbf
+ , roundtrip "tx_ack_rbf" gen_tx_ack_rbf
+ encode_tx_ack_rbf decode_tx_ack_rbf
+ , roundtrip "tx_abort" gen_tx_abort encode_tx_abort decode_tx_abort
+ , roundtrip "stfu" gen_stfu (Right . encode_stfu) decode_stfu
+ , roundtrip "shutdown" gen_shutdown
+ (Right . encode_shutdown) decode_shutdown
+ , roundtrip "closing_complete" gen_closing_complete
+ encode_closing_complete decode_closing_complete
+ , roundtrip "closing_sig" gen_closing_sig
+ encode_closing_sig decode_closing_sig
+ , roundtrip "closing_signed" gen_closing_signed
+ encode_closing_signed decode_closing_signed
+ , roundtrip "update_add_htlc" gen_update_add_htlc
+ encode_update_add_htlc decode_update_add_htlc
+ , roundtrip "update_fulfill_htlc" gen_update_fulfill_htlc
+ encode_update_fulfill_htlc decode_update_fulfill_htlc
+ , roundtrip "update_fail_htlc" gen_update_fail_htlc
+ encode_update_fail_htlc decode_update_fail_htlc
+ , roundtrip "update_fail_malformed_htlc" gen_update_fail_malformed_htlc
+ (Right . encode_update_fail_malformed_htlc)
+ decode_update_fail_malformed_htlc
+ , roundtrip "commitment_signed" gen_commitment_signed
+ encode_commitment_signed decode_commitment_signed
+ , roundtrip "revoke_and_ack" gen_revoke_and_ack
+ (Right . encode_revoke_and_ack) decode_revoke_and_ack
+ , roundtrip "update_fee" gen_update_fee
+ (Right . encode_update_fee) decode_update_fee
+ , roundtrip "channel_reestablish" gen_channel_reestablish
+ encode_channel_reestablish decode_channel_reestablish
+ ]
+ , roundtrip "messages round-trip" gen_message encode_message decode_message
+ , testProperty "decoded messages re-encode exactly" $
+ withMaxSuccess 2000 $
+ forAll gen_message $ \m -> forAll gen_edit $ \e ->
+ case encode_message m of
+ Left err -> counterexample ("encode failed: " ++ show err) False
+ Right w ->
+ let w' = apply_edit e w
+ in case decode_message w' of
+ Left _ -> property True
+ Right m' -> encode_message m' === Right w'
+ ]
